github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-05-03 06:39:40 +00:00
Code Issues Projects Releases Wiki Activity

Remove a few more dependencies on Tedit internals

Browse Source
This commit is contained in:
rmkaplan
2025-02-15 17:39:40 -08:00
parent f56033fca0
commit c0e0aea80a
6 changed files with 185 additions and 193 deletions
Download Patch File Download Diff File Expand all files Collapse all files

195
library/lafite/LAFITE-COMMANDS
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-COMMANDS.;2 164484 (FILECREATED "15-Feb-2025 13:05:52" {WMEDLEY}<library>lafite>LAFITE-COMMANDS.;3 164570
:EDIT-BY rmk :EDIT-BY rmk
:CHANGES-TO (VARS LAFITE-COMMANDSCOMS) :CHANGES-TO (FNS LAFITE.SET.LOOKS LAFITE.SUBSTITUTE.VP.EOL)
:PREVIOUS-DATE "23-Feb-2024 21:58:18" {WMEDLEY}<library>lafite>LAFITE-COMMANDS.;1) :PREVIOUS-DATE "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-COMMANDS.;2)
(PRETTYCOMPRINT LAFITE-COMMANDSCOMS) (PRETTYCOMPRINT LAFITE-COMMANDSCOMS)
@@ -560,7 +560,7 @@
(LAFITE.SET.LOOKS TEXTSTREAM LAFITEFIXEDWIDTHFONT]) (LAFITE.SET.LOOKS TEXTSTREAM LAFITEFIXEDWIDTHFONT])
(LAFITE.SET.LOOKS (LAFITE.SET.LOOKS
[LAMBDA (TEXTSTREAM NEWLOOKS PARALOOKS OMITHEADER USERFN) [LAMBDA (TEXTSTREAM NEWLOOKS PARALOOKS OMITHEADER USERFN) (* ; "Edited 15-Feb-2025 13:02 by rmk")
(* ; "Edited 3-Nov-89 14:50 by bvm") (* ; "Edited 3-Nov-89 14:50 by bvm")
(* ;; "Called from Looks (sub)commands of Lafite display window. Change the looks of the current selection (if there is an interesting one) or the whole message to be NEWLOOKS. If NEWLOOKS is T, we use TEdit's menu interface. PARALOOKS is for paragraph formatting. USERFN is arbitrary function called with arg textstream & selection set appropriately. Any of NEWLOOKS, PARALOOKS, USERFN can be NIL. If OMITHEADER is true, the header is left out of the modification if user has not selected a region of text already.") (* ;; "Called from Looks (sub)commands of Lafite display window. Change the looks of the current selection (if there is an interesting one) or the whole message to be NEWLOOKS. If NEWLOOKS is T, we use TEdit's menu interface. PARALOOKS is for paragraph formatting. USERFN is arbitrary function called with arg textstream & selection set appropriately. Any of NEWLOOKS, PARALOOKS, USERFN can be NIL. If OMITHEADER is true, the header is left out of the modification if user has not selected a region of text already.")
@@ -571,57 +571,56 @@
(LET ((SEL (TEDIT.GETSEL TEXTSTREAM)) (LET ((SEL (TEDIT.GETSEL TEXTSTREAM))
START LEN WIDTH FIXEDLOOKS) START LEN WIDTH FIXEDLOOKS)
[if (AND (NOT PARALOOKS) [if (AND (NOT PARALOOKS)
(FONTP NEWLOOKS) (FONTP NEWLOOKS)
(EQ (SETQ WIDTH (CHARWIDTH (CHARCODE "i") (EQ (SETQ WIDTH (CHARWIDTH (CHARCODE "i")
NEWLOOKS)) NEWLOOKS))
(CHARWIDTH (CHARCODE "W") (CHARWIDTH (CHARCODE "W")
NEWLOOKS))) NEWLOOKS)))
then (* ; "If font is fixed-width, let's make the tab the right width. Might be nice to restore default tab if it's not fixed-width, but TEdit apparently doesn't support that.") then (* ; "If font is fixed-width, let's make the tab the right width. Might be nice to restore default tab if it's not fixed-width, but TEdit apparently doesn't support that.")
(SETQ FIXEDLOOKS (SETQ PARALOOKS `(TABS (,(TIMES WIDTH 8] (SETQ FIXEDLOOKS (SETQ PARALOOKS `(TABS (,(TIMES WIDTH 8]
(if (> (SETQ LEN (fetch (SELECTION DCH) of SEL)) (if (> (SETQ LEN (TEDIT.SELPROP SEL 'LENGTH))
1) 1)
then (* ; "User has already selected something. Assume any selection greater than a single character is not accidental.") then (* ; "User has already selected something. Assume any selection greater than a single character is not accidental.")
(if (AND FIXEDLOOKS (NEQ (SETQ FIXEDLOOKS (TEXTPROP TEXTSTREAM (if (AND FIXEDLOOKS (NEQ (SETQ FIXEDLOOKS (TEXTPROP TEXTSTREAM
'LAFITEFIXEDLOOKS)) 'LAFITEFIXEDLOOKS))
T)) T))
then then
(* ;; "Record the portions we have so marked, so hardcopy can work right--T means everything. If FIXEDLOOKS is false, might want to unset, but that's tedious, unlikely to be worth the hairy code")
(* ;; "Record the portions we have so marked, so hardcopy can work right--T means everything. If FIXEDLOOKS is false, might want to unset, but that's tedious, unlikely to be worth the hairy code") (TEXTPROP TEXTSTREAM 'LAFITEFIXEDLOOKS
(CONS (CONS (TEDIT.SELPROP SEL 'CH#)
(TEXTPROP TEXTSTREAM 'LAFITEFIXEDLOOKS LEN)
(CONS (CONS (fetch (SELECTION CH#) of SEL) FIXEDLOOKS)))
LEN)
FIXEDLOOKS)))
else (SETQ START (if OMITHEADER else (SETQ START (if OMITHEADER
then (* ; then (* ;
 "Start after the blank line following the header")  "Start after the blank line following the header")
(\LAFITE.HEADER.EOF TEXTSTREAM) (\LAFITE.HEADER.EOF TEXTSTREAM)
else 0)) else 0))
(SETQ LEN (- (GETEOFPTR TEXTSTREAM) (SETQ LEN (- (GETEOFPTR TEXTSTREAM)
(if LAFITEENDOFMESSAGESTR (if LAFITEENDOFMESSAGESTR
then (NCHARS LAFITEENDOFMESSAGESTR) then (NCHARS LAFITEENDOFMESSAGESTR)
else 0) else 0)
START)) START))
(TEDIT.SETSEL TEXTSTREAM (ADD1 START) (TEDIT.SETSEL TEXTSTREAM (ADD1 START)
LEN LEN
'RIGHT) 'RIGHT)
(if FIXEDLOOKS (if FIXEDLOOKS
then (* ; "The whole thing is fixed now") then (* ; "The whole thing is fixed now")
(TEXTPROP TEXTSTREAM 'LAFITEFIXEDLOOKS T))) (TEXTPROP TEXTSTREAM 'LAFITEFIXEDLOOKS T)))
(* ;; "Now do the modification") (* ;; "Now do the modification")
(if (EQ NEWLOOKS T) (if (EQ NEWLOOKS T)
then (* ; "Use menu") then (* ; "Use menu")
(\TEDIT.LOOKS (TEXTOBJ TEXTSTREAM)) (\TEDIT.LOOKS (TEXTOBJ TEXTSTREAM))
elseif NEWLOOKS elseif NEWLOOKS
then (TEDIT.LOOKS TEXTSTREAM NEWLOOKS)) then (TEDIT.LOOKS TEXTSTREAM NEWLOOKS))
(if PARALOOKS (if PARALOOKS
then (* ; "Paragraph looks") then (* ; "Paragraph looks")
(TEDIT.PARALOOKS TEXTSTREAM PARALOOKS)) (TEDIT.PARALOOKS TEXTSTREAM PARALOOKS))
(if USERFN (if USERFN
then (* ; "Arbitrary user manipulation.") then (* ; "Arbitrary user manipulation.")
(CL:FUNCALL USERFN TEXTSTREAM)) (CL:FUNCALL USERFN TEXTSTREAM))
(* ;; "Finally, set selection back to where it was.") (* ;; "Finally, set selection back to where it was.")
@@ -657,31 +656,31 @@
STR]) STR])
(LAFITE.SUBSTITUTE.VP.EOL (LAFITE.SUBSTITUTE.VP.EOL
[LAMBDA (TEXTSTREAM) (* ; "Edited 4-Aug-89 16:55 by bvm") [LAMBDA (TEXTSTREAM) (* ; "Edited 15-Feb-2025 13:03 by rmk")
(* ; "Edited 4-Aug-89 16:55 by bvm")
(* ;; (* ;; "Called from Looks (sub)commands of Lafite display window. Replace VP eol (29) with ours.")
 "Called from Looks (sub)commands of Lafite display window. Replace VP eol (29) with ours.")
(RESETLST (RESETLST
(RESETSAVE NIL (LIST 'TEXTPROP TEXTSTREAM 'READONLY T)) (RESETSAVE NIL (LIST 'TEXTPROP TEXTSTREAM 'READONLY T))
(TEXTPROP TEXTSTREAM 'READONLY NIL) (TEXTPROP TEXTSTREAM 'READONLY NIL)
(LET* ((SEL (TEDIT.GETSEL TEXTSTREAM)) (LET ((SEL (TEDIT.GETSEL TEXTSTREAM))
(LEN (fetch (SELECTION DCH) of SEL)) POS)
POS) (if (<= (TEDIT.SELPROP SEL 'LENGTH)
(if (<= LEN 1) 1)
then (* ; then (* ;
 "If user has already selected something (more than a single character), assume is not accidental.")  "If user has already selected something (more than a single character), assume is not accidental.")
(SETQ POS (CADAR (LAFITE.PARSE.HEADER TEXTSTREAM NIL NIL NIL NIL T))) (SETQ POS (CADAR (LAFITE.PARSE.HEADER TEXTSTREAM NIL NIL NIL NIL T)))
(TEDIT.SETSEL TEXTSTREAM POS (- (GETEOFPTR TEXTSTREAM) (TEDIT.SETSEL TEXTSTREAM POS (- (GETEOFPTR TEXTSTREAM)
(if LAFITEENDOFMESSAGESTR (if LAFITEENDOFMESSAGESTR
then (NCHARS LAFITEENDOFMESSAGESTR) then (NCHARS LAFITEENDOFMESSAGESTR)
else 0) else 0)
POS))) POS)))
(TEDIT.SUBSTITUTE TEXTSTREAM (ALLOCSTRING 1 29) (TEDIT.SUBSTITUTE TEXTSTREAM (ALLOCSTRING 1 29)
(ALLOCSTRING 1 (CHARCODE EOL))) (ALLOCSTRING 1 (CHARCODE EOL)))
(if POS (if POS
then (* ; "Undo the selection") then (* ; "Undo the selection")
(TEDIT.SETSEL TEXTSTREAM 1 0))))]) (TEDIT.SETSEL TEXTSTREAM 1 0))))])
) )
(RPAQ? \LAFITE.DISPLAY.COMMANDS NIL) (RPAQ? \LAFITE.DISPLAY.COMMANDS NIL)
@@ -2546,37 +2545,37 @@
(ADDTOVAR LAMA LAFITE.HARDCOPY.MESSAGES) (ADDTOVAR LAMA LAFITE.HARDCOPY.MESSAGES)
) )
(DECLARE%: DONTCOPY (DECLARE%: DONTCOPY
(FILEMAP (NIL (7743 27547 (\LAFITE.DISPLAY 7753 . 9458) (\LAFITE.DO.DISPLAY 9460 . 13625) ( (FILEMAP (NIL (7764 27568 (\LAFITE.DISPLAY 7774 . 9479) (\LAFITE.DO.DISPLAY 9481 . 13646) (
SELECTMESSAGETODISPLAY 13627 . 15995) (MESSAGEDISPLAYER 15997 . 23549) (LA.COPY.MESSAGE.TEXT 23551 . SELECTMESSAGETODISPLAY 13648 . 16016) (MESSAGEDISPLAYER 16018 . 23570) (LA.COPY.MESSAGE.TEXT 23572 .
24305) (\LAFITE.CLOSE.DISPLAYWINDOWS 24307 . 25901) (\LAFITE.CLOSE.DISPLAYER 25903 . 27545)) (27548 24326) (\LAFITE.CLOSE.DISPLAYWINDOWS 24328 . 25922) (\LAFITE.CLOSE.DISPLAYER 25924 . 27566)) (27569
36140 (\LAFITE.UNHIDE.HEADERS 27558 . 28648) (\LAFITE.HIDE.HEADERS 28650 . 29303) ( 36161 (\LAFITE.UNHIDE.HEADERS 27579 . 28669) (\LAFITE.HIDE.HEADERS 28671 . 29324) (
\LAFITE.REHIDE.HEADERS 29305 . 30341) (LAFITE.EAT.UNDESIRABLE.FIELD 30343 . 31102) (LAFITE.EAT.GVGV \LAFITE.REHIDE.HEADERS 29326 . 30362) (LAFITE.EAT.UNDESIRABLE.FIELD 30364 . 31123) (LAFITE.EAT.GVGV
31104 . 32265) (\LAFITE.HARDCOPY.FROM.DISPLAY 32267 . 35786) (LAFITE.HARDCOPY.TAB.WIDTH 35788 . 36138) 31125 . 32286) (\LAFITE.HARDCOPY.FROM.DISPLAY 32288 . 35807) (LAFITE.HARDCOPY.TAB.WIDTH 35809 . 36159)
) (36141 44444 (\LAFITE.SET.LOOKS.FROM.MENU 36151 . 36328) (\LAFITE.SET.DEFAULT.LOOKS 36330 . 36521) ( ) (36162 44530 (\LAFITE.SET.LOOKS.FROM.MENU 36172 . 36349) (\LAFITE.SET.DEFAULT.LOOKS 36351 . 36542) (
\LAFITE.SET.FIXED.LOOKS 36523 . 36715) (LAFITE.SET.LOOKS 36717 . 41174) (LAFITE.SET.TAB.LOOKS 41176 . \LAFITE.SET.FIXED.LOOKS 36544 . 36736) (LAFITE.SET.LOOKS 36738 . 41179) (LAFITE.SET.TAB.LOOKS 41181 .
41887) (LAFITE.SET.PARA.SEPARATION 41889 . 42097) (LAFITE.SET.LOWER.CASE 42099 . 42950) ( 41892) (LAFITE.SET.PARA.SEPARATION 41894 . 42102) (LAFITE.SET.LOWER.CASE 42104 . 42955) (
LAFITE.SUBSTITUTE.VP.EOL 42952 . 44442)) (46361 54689 (LAFITE.DELETE.MESSAGES 46371 . 47421) ( LAFITE.SUBSTITUTE.VP.EOL 42957 . 44528)) (46447 54775 (LAFITE.DELETE.MESSAGES 46457 . 47507) (
\LAFITE.DELETE 47423 . 48610) (DISPLAYAFTERDELETE 48612 . 53338) (\LAFITE.SELECT.NEXT 53340 . 53978) ( \LAFITE.DELETE 47509 . 48696) (DISPLAYAFTERDELETE 48698 . 53424) (\LAFITE.SELECT.NEXT 53426 . 54064) (
\LAFITE.UNDELETE 53980 . 54687)) (54711 69206 (LAFITE.MOVE.MESSAGES 54721 . 55368) (\COERCE.TO.MSGLST \LAFITE.UNDELETE 54066 . 54773)) (54797 69292 (LAFITE.MOVE.MESSAGES 54807 . 55454) (\COERCE.TO.MSGLST
55370 . 56128) (\LAFITE.MOVETO 56130 . 60074) (\LAFITE.COPYTO 60076 . 60492) (\LAFITE.MOVETO.PROC 55456 . 56214) (\LAFITE.MOVETO 56216 . 60160) (\LAFITE.COPYTO 60162 . 60578) (\LAFITE.MOVETO.PROC
60494 . 61764) (\LAFITE.MOVE.MESSAGES.INTERNAL 61766 . 69204)) (69232 77784 (\LAFITE.ENABLE.MOVE.MENU 60580 . 61850) (\LAFITE.MOVE.MESSAGES.INTERNAL 61852 . 69290)) (69318 77870 (\LAFITE.ENABLE.MOVE.MENU
69242 . 70284) (\LAFITE.ADD.TO.MOVE.MENU 70286 . 71302) (\LAFITE.UPDATE.MOVE.MENU 71304 . 75944) ( 69328 . 70370) (\LAFITE.ADD.TO.MOVE.MENU 70372 . 71388) (\LAFITE.UPDATE.MOVE.MENU 71390 . 76030) (
\LAFITE.RESTORE.MOVE.MENU 75946 . 76622) (\LAFITE.HANDLE.AUTO.MOVE 76624 . 77782)) (78640 96124 ( \LAFITE.RESTORE.MOVE.MENU 76032 . 76708) (\LAFITE.HANDLE.AUTO.MOVE 76710 . 77868)) (78726 96210 (
\LAFITE.UPDATE 78650 . 84283) (\LAFITE.EXPUNGE.PROC 84285 . 85090) (\LAFITE.UPDATE.PROC 85092 . 86175) \LAFITE.UPDATE 78736 . 84369) (\LAFITE.EXPUNGE.PROC 84371 . 85176) (\LAFITE.UPDATE.PROC 85178 . 86261)
(\LAFITE.HARDCOPYONLY.PROC 86177 . 86619) (LAB.CHOOSE.UPDATE.MENU 86621 . 87402) ( (\LAFITE.HARDCOPYONLY.PROC 86263 . 86705) (LAB.CHOOSE.UPDATE.MENU 86707 . 87488) (
LAB.CREATE.UPDATE.MENU 87404 . 89303) (LAB.UPDATE.NEEDED? 89305 . 90875) (\LAFITE.START.UPDATE 90877 LAB.CREATE.UPDATE.MENU 87490 . 89389) (LAB.UPDATE.NEEDED? 89391 . 90961) (\LAFITE.START.UPDATE 90963
. 91909) (LAB.START.COMMAND 91911 . 92761) (\LAFITE.FINISH.UPDATE 92763 . 95016) ( . 91995) (LAB.START.COMMAND 91997 . 92847) (\LAFITE.FINISH.UPDATE 92849 . 95102) (
\LAFITE.CLOSE.OTHER.FOLDERS 95018 . 96122)) (96125 130919 (LAB.FLUSHWINDOW 96135 . 97814) ( \LAFITE.CLOSE.OTHER.FOLDERS 95104 . 96208)) (96211 131005 (LAB.FLUSHWINDOW 96221 . 97900) (
LAB.APPENDMESSAGES 97816 . 100978) (\LAFITE.COMPACT.FOLDER 100980 . 105144) (\LAFITE.COMPACT.FOLDER1 LAB.APPENDMESSAGES 97902 . 101064) (\LAFITE.COMPACT.FOLDER 101066 . 105230) (\LAFITE.COMPACT.FOLDER1
105146 . 121185) (\LAFITE.COMPACT.FOLDER2 121187 . 125901) (\LAFITE.COMPACT.EXTRA 125903 . 128218) ( 105232 . 121271) (\LAFITE.COMPACT.FOLDER2 121273 . 125987) (\LAFITE.COMPACT.EXTRA 125989 . 128304) (
\LAFITE.INVALIDATE.TOC 128220 . 128913) (\LAFITE.RENAMEFILE 128915 . 129385) (SMART-RENAMEFILEP 129387 \LAFITE.INVALIDATE.TOC 128306 . 128999) (\LAFITE.RENAMEFILE 129001 . 129471) (SMART-RENAMEFILEP 129473
. 129947) (LA.OPENTEMPFILE 129949 . 130917)) (130920 144262 (\LAFITE.UPDATE.FOLDER 130930 . 132907) ( . 130033) (LA.OPENTEMPFILE 130035 . 131003)) (131006 144348 (\LAFITE.UPDATE.FOLDER 131016 . 132993) (
\LAFITE.UPDATE.CONTENTS 132909 . 133626) (\LAFITE.UPDATE.CONTENTS1 133628 . 138482) (WRITETOCENTRY \LAFITE.UPDATE.CONTENTS 132995 . 133712) (\LAFITE.UPDATE.CONTENTS1 133714 . 138568) (WRITETOCENTRY
138484 . 141602) (WRITETOCMARKBYTES 141604 . 141846) (WRITEFOLDERMARKBYTES 141848 . 144260)) (144288 138570 . 141688) (WRITETOCMARKBYTES 141690 . 141932) (WRITEFOLDERMARKBYTES 141934 . 144346)) (144374
163263 (LAFITE.HARDCOPY.MESSAGES 144298 . 144758) (\LAFITE.HARDCOPY 144760 . 145095) ( 163349 (LAFITE.HARDCOPY.MESSAGES 144384 . 144844) (\LAFITE.HARDCOPY 144846 . 145181) (
\LAFITE.HARDCOPY.PROC 145097 . 148575) (\LAFITE.HARDCOPY.HEADERS 148577 . 153906) ( \LAFITE.HARDCOPY.PROC 145183 . 148661) (\LAFITE.HARDCOPY.HEADERS 148663 . 153992) (
\LAFITE.MARK.HARDCOPIED 153908 . 155618) (\LAFITE.TRANSMIT.HARDCOPY 155620 . 157210) ( \LAFITE.MARK.HARDCOPIED 153994 . 155704) (\LAFITE.TRANSMIT.HARDCOPY 155706 . 157296) (
\LAFITE.HARDCOPY.BODIES 157212 . 158454) (\LAFITE.APPEND.MESSAGE.BODY 158456 . 160564) ( \LAFITE.HARDCOPY.BODIES 157298 . 158540) (\LAFITE.APPEND.MESSAGE.BODY 158542 . 160650) (
\LAFITE.DO.PENDING.HARDCOPY 160566 . 161641) (\LAFITE.CANCEL.HARDCOPY 161643 . 162359) ( \LAFITE.DO.PENDING.HARDCOPY 160652 . 161727) (\LAFITE.CANCEL.HARDCOPY 161729 . 162445) (
\LAFITE.CLEAR.HARDCOPY.STATE 162361 . 163261))))) \LAFITE.CLEAR.HARDCOPY.STATE 162447 . 163347)))))
STOP STOP

BIN
library/lafite/LAFITE-COMMANDS.LCOM
View File

Binary file not shown.

161
library/lafite/LAFITE-SEND
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-SEND.;2 100561 (FILECREATED "15-Feb-2025 13:05:38" {WMEDLEY}<library>lafite>LAFITE-SEND.;4 100003
:EDIT-BY rmk :EDIT-BY rmk
:CHANGES-TO (VARS LAFITE-SENDCOMS) :CHANGES-TO (FNS \SENDMSG.CHANGE.MODE)
:PREVIOUS-DATE "23-Feb-2024 22:03:43" {WMEDLEY}<library>lafite>LAFITE-SEND.;1) :PREVIOUS-DATE "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-SEND.;2)
(PRETTYCOMPRINT LAFITE-SENDCOMS) (PRETTYCOMPRINT LAFITE-SENDCOMS)
@@ -222,14 +222,14 @@
(ERROR!]) (ERROR!])
(\SENDMSG.CHANGE.MODE (\SENDMSG.CHANGE.MODE
[LAMBDA (WINDOW TEXTSTREAM MENU ITEM) (* ; "Edited 5-Jan-90 18:06 by bvm") [LAMBDA (WINDOW TEXTSTREAM MENU ITEM) (* ; "Edited 15-Feb-2025 13:05 by rmk")
(* ; "Edited 5-Jan-90 18:06 by bvm")
(LET* (LET*
[(OLDMODE (TEXTPROP TEXTSTREAM 'LAFITEMODE)) [(OLDMODE (TEXTPROP TEXTSTREAM 'LAFITEMODE))
(OTHERMODES (for MODE in LAFITEMODELST unless (OR (EQ (fetch (LAFITEOPS (OTHERMODES (for MODE in LAFITEMODELST unless (OR (EQ (fetch (LAFITEOPS LAFITEMODE)
LAFITEMODE) of MODE)
of MODE) OLDMODE)
OLDMODE) (NLISTP (CDR MODE)))
(NLISTP (CDR MODE)))
collect (fetch (LAFITEOPS LAFITEMODE) of MODE))) collect (fetch (LAFITEOPS LAFITEMODE) of MODE)))
(NEWMODE (if (NULL OTHERMODES) (NEWMODE (if (NULL OTHERMODES)
then (\SENDMESSAGE.PROMPT WINDOW "There are no other modes") then (\SENDMESSAGE.PROMPT WINDOW "There are no other modes")
@@ -244,58 +244,51 @@
N N2) N N2)
(if (NULL NEWMODEDATA) (if (NULL NEWMODEDATA)
then (\SENDMESSAGE.PROMPT WINDOW (CL:FORMAT NIL then (\SENDMESSAGE.PROMPT WINDOW (CL:FORMAT NIL
"Can't authenticate user in ~A mode" "Can't authenticate user in ~A mode"
NEWMODE)) NEWMODE))
else (LET ((OLDNAME (fetch (LAFITEMODEDATA FULLUSERNAME) of OLDMODEDATA) else (LET ((OLDNAME (fetch (LAFITEMODEDATA FULLUSERNAME) of OLDMODEDATA))
) (END (TEDIT.FIND TEXTSTREAM "
(END (TEDIT.FIND TEXTSTREAM "
" 1)) " 1))
START N LEN NEW OLDSEL) START N LEN NEW OLDSEL)
(if END (if END
then (add END 1)) (* ; then (add END 1)) (* ;
 "Don't search past end of header. END now points at second cr.")  "Don't search past end of header. END now points at second cr.")
[for FIELD in '("cc" "Reply-to") [for FIELD in '("cc" "Reply-to")
when [AND (SETQ N (\SENDMSG.FIND.FIELD TEXTSTREAM FIELD END when [AND (SETQ N (\SENDMSG.FIND.FIELD TEXTSTREAM FIELD END))
)) (PROGN (SETQ LEN (CADR N))
(PROGN (SETQ LEN (CADR N)) (SETQ N (CAR N))
(SETQ N (CAR N)) (SETQ START (STRPOS OLDNAME (SETQ OLDSEL
(SETQ START (TEDIT.SEL.AS.STRING
(STRPOS OLDNAME TEXTSTREAM N LEN))
(SETQ OLDSEL NIL NIL NIL NIL UPPERCASEARRAY]
(TEDIT.SEL.AS.STRING TEXTSTREAM do (* ; "Change field containing old user name to new. This is much more complicated than it needs to be because TEDIT.FIND is case sensitive.")
(create SELECTION (TEDIT.DELETE TEXTSTREAM N LEN)
CH# _ N (TEDIT.INSERT TEXTSTREAM (SETQ NEW
DCH _ LEN))) (CONCAT (OR (SUBSTRING OLDSEL 1
NIL NIL NIL NIL UPPERCASEARRAY] (SUB1 START))
do (* ; "Change field containing old user name to new. This is much more complicated than it needs to be because TEDIT.FIND is case sensitive.") "")
(TEDIT.DELETE TEXTSTREAM N LEN) (fetch (LAFITEMODEDATA FULLUSERNAME
(TEDIT.INSERT TEXTSTREAM ) of NEWMODEDATA)
(SETQ NEW (CONCAT (OR (SUBSTRING OLDSEL 1 (SUB1 START) (OR (SUBSTRING OLDSEL
) (+ START (NCHARS OLDNAME
"") )))
(fetch (LAFITEMODEDATA "")))
FULLUSERNAME) N)
of NEWMODEDATA) (AND END (add END (- (NCHARS NEW)
(OR (SUBSTRING OLDSEL LEN]
(+ START (NCHARS OLDNAME)) (if (SETQ N (\SENDMSG.FIND.FIELD TEXTSTREAM "To" END))
) then (* ;
"")))  "Leave the To field selected for address modification")
N) (TEDIT.SETSEL TEXTSTREAM (CAR N)
(AND END (add END (- (NCHARS NEW) (CADR N)
LEN] 'RIGHT T))
(if (SETQ N (\SENDMSG.FIND.FIELD TEXTSTREAM "To" END)) (TEXTPROP TEXTSTREAM 'LAFITEMODE NEWMODE)
then (* ; (if (SETQ N (STRPOS (CONCAT "(" OLDMODE ")")
 "Leave the To field selected for address modification") TITLE))
(TEDIT.SETSEL TEXTSTREAM (CAR N) then (WINDOWPROP WINDOW 'TITLE (CONCAT (SUBSTRING TITLE 1 N)
(CADR N) NEWMODE ")")))
'RIGHT T)) (\SENDMESSAGE.PROMPT WINDOW "Message mode is now " NEWMODE]
(TEXTPROP TEXTSTREAM 'LAFITEMODE NEWMODE)
(if (SETQ N (STRPOS (CONCAT "(" OLDMODE ")")
TITLE))
then (WINDOWPROP WINDOW 'TITLE (CONCAT (SUBSTRING TITLE 1 N)
NEWMODE ")")))
(\SENDMESSAGE.PROMPT WINDOW "Message mode is now " NEWMODE]
(* ;; "Exit with error so that the window is restored to previous state") (* ;; "Exit with error so that the window is restored to previous state")
@@ -1761,29 +1754,29 @@ cc: ~A
) )
) )
(DECLARE%: DONTCOPY (DECLARE%: DONTCOPY
(FILEMAP (NIL (5214 28191 (DOLAFITESENDINGCOMMAND 5224 . 5714) (\SENDMESSAGE.INITIATE 5716 . 7655) ( (FILEMAP (NIL (5218 27633 (DOLAFITESENDINGCOMMAND 5228 . 5718) (\SENDMESSAGE.INITIATE 5720 . 7659) (
\SENDMSG.DELIVER 7657 . 8265) (\SENDMSG.EXIT.TEDIT 8267 . 8638) (\SENDMSG.SAVE.FORM 8640 . 10627) ( \SENDMSG.DELIVER 7661 . 8269) (\SENDMSG.EXIT.TEDIT 8271 . 8642) (\SENDMSG.SAVE.FORM 8644 . 10631) (
\LAFITE.HEADER.EOF 10629 . 10922) (\LAFITE.INSERT.REPLYTO 10924 . 11532) (\SENDMSG.REPLYTO 11534 . \LAFITE.HEADER.EOF 10633 . 10926) (\LAFITE.INSERT.REPLYTO 10928 . 11536) (\SENDMSG.REPLYTO 11538 .
12093) (\SENDMSG.CHANGE.MODE 12095 . 17671) (\SENDMSG.FIND.FIELD 17673 . 18183) (\SENDMESSAGE.PARSE 12097) (\SENDMSG.CHANGE.MODE 12099 . 17113) (\SENDMSG.FIND.FIELD 17115 . 17625) (\SENDMESSAGE.PARSE
18185 . 18981) (\LAFITE.PREPARE.SEND 18983 . 21816) (\LAFITE.PREPARE.ERROR 21818 . 23000) ( 17627 . 18423) (\LAFITE.PREPARE.SEND 18425 . 21258) (\LAFITE.PREPARE.ERROR 21260 . 22442) (
\LAFITE.CHOOSE.MSG.FORMAT 23002 . 25643) (LAFITE.MAKE.PLAIN.TEXTSTREAM 25645 . 26570) ( \LAFITE.CHOOSE.MSG.FORMAT 22444 . 25085) (LAFITE.MAKE.PLAIN.TEXTSTREAM 25087 . 26012) (
\SENDMESSAGE.MENUPROMPT 26572 . 27435) (\SENDMESSAGE.PROMPT 27437 . 27973) (\SENDMESSAGEFAIL 27975 . \SENDMESSAGE.MENUPROMPT 26014 . 26877) (\SENDMESSAGE.PROMPT 26879 . 27415) (\SENDMESSAGEFAIL 27417 .
28189)) (28192 52854 (\SENDMESSAGE 28202 . 29554) (\SENDMESSAGE.RESTARTABLE 29556 . 34757) ( 27631)) (27634 52296 (\SENDMESSAGE 27644 . 28996) (\SENDMESSAGE.RESTARTABLE 28998 . 34199) (
\SENDMESSAGE.CLEANUP 34759 . 34975) (\SENDMESSAGE.MAKEWINDOW 34977 . 41150) (MAKELAFITEDELIVERMENU \SENDMESSAGE.CLEANUP 34201 . 34417) (\SENDMESSAGE.MAKEWINDOW 34419 . 40592) (MAKELAFITEDELIVERMENU
41152 . 41459) (\LAFITE.CLOSEMSG? 41461 . 42411) (\LAFITE.AFTER.DELIVER 42413 . 45732) ( 40594 . 40901) (\LAFITE.CLOSEMSG? 40903 . 41853) (\LAFITE.AFTER.DELIVER 41855 . 45174) (
\LAFITE.UNSENT.ICON 45734 . 46044) (\LAFITE.FETCH.SUBJECT 46046 . 46846) (LAFITE.SENDMESSAGE 46848 . \LAFITE.UNSENT.ICON 45176 . 45486) (\LAFITE.FETCH.SUBJECT 45488 . 46288) (LAFITE.SENDMESSAGE 46290 .
47741) (\SENDMESSAGE0 47743 . 50607) (LA.ASSURE.PROMPT.WINDOW 50609 . 51506) (\LAFITE.SEND.FAIL 51508 47183) (\SENDMESSAGE0 47185 . 50049) (LA.ASSURE.PROMPT.WINDOW 50051 . 50948) (\LAFITE.SEND.FAIL 50950
. 51979) (\LAFITE.INVALID.RECIPIENTS 51981 . 52439) (\SENDMESSAGE.ABORT 52441 . 52852)) (52886 62799 . 51421) (\LAFITE.INVALID.RECIPIENTS 51423 . 51881) (\SENDMESSAGE.ABORT 51883 . 52294)) (52328 62241
(\OUTBOX.CREATE 52896 . 54359) (\OUTBOX.RESET 54361 . 54854) (\OUTBOX.CLOSEFN 54856 . 54996) ( (\OUTBOX.CREATE 52338 . 53801) (\OUTBOX.RESET 53803 . 54296) (\OUTBOX.CLOSEFN 54298 . 54438) (
\OUTBOX.REPAINTFN 54998 . 55661) (\OUTBOX.RESHAPEFN 55663 . 56946) (\OUTBOX.SHADEITEM 56948 . 57621) ( \OUTBOX.REPAINTFN 54440 . 55103) (\OUTBOX.RESHAPEFN 55105 . 56388) (\OUTBOX.SHADEITEM 56390 . 57063) (
\OUTBOX.BUTTONFN 57623 . 60471) (\OUTBOX.DISPLAYLINE 60473 . 60967) (\OUTBOX.ADD.ITEM 60969 . 62797)) \OUTBOX.BUTTONFN 57065 . 59913) (\OUTBOX.DISPLAYLINE 59915 . 60409) (\OUTBOX.ADD.ITEM 60411 . 62239))
(63095 79503 (\LAFITE.MESSAGEFORM 63105 . 67448) (MAKELAFITESUPPORTFORM 67450 . 67639) ( (62537 78945 (\LAFITE.MESSAGEFORM 62547 . 66890) (MAKELAFITESUPPORTFORM 66892 . 67081) (
MAKELISPSUPPORTFORM 67641 . 67807) (MAKEXXXSUPPORTFORM 67809 . 71858) (MAKENEWMESSAGEFORM 71860 . MAKELISPSUPPORTFORM 67083 . 67249) (MAKEXXXSUPPORTFORM 67251 . 71300) (MAKENEWMESSAGEFORM 71302 .
72816) (MAKELAFITEPRIVATEFORMSITEMS 72818 . 73246) (\LAFITE.UNCACHE.MESSAGEFORM 73248 . 73701) ( 72258) (MAKELAFITEPRIVATEFORMSITEMS 72260 . 72688) (\LAFITE.UNCACHE.MESSAGEFORM 72690 . 73143) (
\LAFITE.DELETE.MESSAGEFORM 73703 . 74304) (\LAFITE.SELECT.FORM 74306 . 74661) ( \LAFITE.DELETE.MESSAGEFORM 73145 . 73746) (\LAFITE.SELECT.FORM 73748 . 74103) (
\LAFITE.DELETE.FORM.INTERNAL 74663 . 75807) (\LAFITE.READ.FORM 75809 . 78546) (\LAFITE.FIND.TEMPLATE \LAFITE.DELETE.FORM.INTERNAL 74105 . 75249) (\LAFITE.READ.FORM 75251 . 77988) (\LAFITE.FIND.TEMPLATE
78548 . 79501)) (79527 87258 (\LAFITE.ANSWER 79537 . 79942) (\LAFITE.ANSWER.PROC 79944 . 81838) ( 77990 . 78943)) (78969 86700 (\LAFITE.ANSWER 78979 . 79384) (\LAFITE.ANSWER.PROC 79386 . 81280) (
MAKEANSWERFORM 81840 . 84370) (LA.PRINT.COMMA.LIST 84372 . 84858) (LAFITE.FILL.IN.ANSWER.FORM 84860 . MAKEANSWERFORM 81282 . 83812) (LA.PRINT.COMMA.LIST 83814 . 84300) (LAFITE.FILL.IN.ANSWER.FORM 84302 .
87256)) (87283 93479 (\LAFITE.FORWARD 87293 . 87701) (\LAFITE.FORWARD.PROC 87703 . 89692) ( 86698)) (86725 92921 (\LAFITE.FORWARD 86735 . 87143) (\LAFITE.FORWARD.PROC 87145 . 89134) (
MAKEFORWARDFORM 89694 . 93477))))) MAKEFORWARDFORM 89136 . 92919)))))
STOP STOP

BIN
library/lafite/LAFITE-SEND.LCOM
View File

Binary file not shown.

22
library/lafite/LAFITE-TEDIT
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-TEDIT.;2 6592 (FILECREATED "15-Feb-2025 14:03:21" {WMEDLEY}<library>lafite>LAFITE-TEDIT.;4 6618
:EDIT-BY rmk :EDIT-BY rmk
:CHANGES-TO (VARS LAFITE-TEDITCOMS) :CHANGES-TO (FNS TEDIT.ASSURE.NO.BACKING.FILE)
:PREVIOUS-DATE "23-Feb-2024 22:09:24" {WMEDLEY}<library>lafite>LAFITE-TEDIT.;1) :PREVIOUS-DATE "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-TEDIT.;2)
(PRETTYCOMPRINT LAFITE-TEDITCOMS) (PRETTYCOMPRINT LAFITE-TEDITCOMS)
@@ -74,7 +74,8 @@
(TEXTPROP TEXTSTREAM '\WINDOW NIL]) (TEXTPROP TEXTSTREAM '\WINDOW NIL])
(TEDIT.ASSURE.NO.BACKING.FILE (TEDIT.ASSURE.NO.BACKING.FILE
[LAMBDA (TEXTSTREAM) (* ; "Edited 13-Jan-2024 18:08 by rmk") [LAMBDA (TEXTSTREAM) (* ; "Edited 15-Feb-2025 14:03 by rmk")
(* ; "Edited 13-Jan-2024 18:08 by rmk")
(* ; "Edited 18-Jun-2023 09:31 by rmk") (* ; "Edited 18-Jun-2023 09:31 by rmk")
(* ; "Edited 29-Oct-2022 22:34 by rmk") (* ; "Edited 29-Oct-2022 22:34 by rmk")
(* ; "Edited 20-May-92 11:25 by rmk:") (* ; "Edited 20-May-92 11:25 by rmk:")
@@ -82,18 +83,17 @@
(* ;; "This puts the contents of TEXTSTREAM to a nodircore file (if it isn't already on nodircore), and then sets it up for continuing in the current editing session. Essentially eliminates the file-system backing store.") (* ;; "This puts the contents of TEXTSTREAM to a nodircore file (if it isn't already on nodircore), and then sets it up for continuing in the current editing session. Essentially eliminates the file-system backing store.")
(LET* ((TEXTOBJ (TEXTOBJ TEXTSTREAM)) (LET* ((TEXTOBJ (TEXTOBJ TEXTSTREAM))
(OFILE (GETTOBJ TEXTOBJ TXTFILE)) (OFILE (GETTEXTPROP TEXTSTREAM 'FILESTREAM))
NEWFILE) NEWFILE)
(CL:WHEN [AND (TYPE? STREAM OFILE) (CL:WHEN [AND OFILE (NEQ 'NODIRCORE (FILENAMEFIELD (TRUEFILENAME OFILE)
(NEQ 'NODIRCORE (FETCH (FDEV DEVICENAME) OF (FETCH (STREAM DEVICE) 'HOST]
OF (TRUEFILENAME OFILE]
(SETQ NEWFILE (OPENSTREAM '{NODIRCORE} 'BOTH)) (SETQ NEWFILE (OPENSTREAM '{NODIRCORE} 'BOTH))
(* ;; "\TEDIT.PUT.PCTB will save the current text and looks in NEWFILE, leaving it open. It returns the sequence of new looks for continued editing, where all the file pieces point to their position in NEWFILE. But the file PCONTENTS do not yet point to the new stream. ") (* ;; "\TEDIT.PUT.PCTB will save the current text and looks in NEWFILE, leaving it open. It returns the sequence of new looks for continued editing, where all the file pieces point to their position in NEWFILE. But the file PCONTENTS do not yet point to the new stream. ")
(CLOSEF? OFILE) (CLOSEF? OFILE)
(\TEDIT.INSERT.NEWPIECES NEWFILE TEXTOBJ (\TEDIT.PUT.PCTB TEXTOBJ NEWFILE NIL T)) (\TEDIT.INSERT.NEWPIECES NEWFILE TEXTOBJ (\TEDIT.PUT.PCTB TEXTOBJ NEWFILE NIL T))
(FSETTOBJ TEXTOBJ TXTFILE NIL) (PUTTEXTPROP TEXTOBJ 'TXTFILE NIL)
(PUTTEXTPROP TEXTOBJ 'CACHE NEWFILE) (PUTTEXTPROP TEXTOBJ 'CACHE NEWFILE)
TEXTSTREAM)]) TEXTSTREAM)])
@@ -118,6 +118,6 @@
) )
) )
(DECLARE%: DONTCOPY (DECLARE%: DONTCOPY
(FILEMAP (NIL (987 6361 (LA.ADJUST.FORMATTING 997 . 4043) (LA.DETACH.TEDIT 4045 . 4411) ( (FILEMAP (NIL (998 6387 (LA.ADJUST.FORMATTING 1008 . 4054) (LA.DETACH.TEDIT 4056 . 4422) (
TEDIT.ASSURE.NO.BACKING.FILE 4413 . 6079) (LA.WINDOW.FROM.TEXTSTREAM 6081 . 6359))))) TEDIT.ASSURE.NO.BACKING.FILE 4424 . 6105) (LA.WINDOW.FROM.TEXTSTREAM 6107 . 6385)))))
STOP STOP

BIN
library/lafite/LAFITE-TEDIT.LCOM
View File

Binary file not shown.