github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-02-27 01:19:42 +00:00
Code Issues Projects Releases Wiki Activity

Merge branch 'master' into fix-wholine-package

Browse Source
This commit is contained in:
Matt Heffron
2024-03-18 17:04:40 -07:00
committed by GitHub
parent a86c5ad145 5ad5083c6d
commit d0edc69cd7
77 changed files with 3631 additions and 1504 deletions
Download Patch File Download Diff File Expand all files Collapse all files

50
doctools/IMINDEX
View File

@@ -1,21 +1,20 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "12-Feb-92 12:28:48" {DSK}<users>sybalsky>PUBS>IMINDEX.;2 37264
changes to%: (FNS IM.CHAP.DISPLAYFN)
(FILECREATED " 6-Mar-2024 21:19:25" {WMEDLEY}<doctools>IMINDEX.;2 36416
previous date%: " 8-Dec-91 15:46:22" {DSK}<users>sybalsky>PUBS>IMINDEX.;1)
:EDIT-BY rmk
:CHANGES-TO (VARS IMINDEXCOMS)
:PREVIOUS-DATE "12-Feb-92 12:28:48" {WMEDLEY}<doctools>IMINDEX.;1)
(* ; "
Copyright (c) 1986, 1987, 1988, 1991, 1992 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT IMINDEXCOMS)
(RPAQQ IMINDEXCOMS
(
(* ;;
 "this file contains the functions used for creating and manipulating index image objects")
 "this file contains the functions used for creating and manipulating index image objects")
(FNS IM.INDEX.CLOSEF IM.INDEX.COPYFN IM.INDEX.CREATEOBJ IM.INDEX.DISPLAY.STRING
IM.INDEX.DISPLAYFN IM.INDEX.EDIT IM.INDEX.LIST.FROM.STRING IM.INDEX.SIZEFN
@@ -32,12 +31,7 @@ Copyright (c) 1986, 1987, 1988, 1991, 1992 by Xerox Corporation. All rights res
(COMS (* ; "An image object to set the chapter number, on the TEXTOBJ's proplist, on the INDEXING-CHAPTER property.")
(FNS IM.CHAP.COPYFN IM.CHAP.CREATEOBJ IM.CHAP.DISPLAYFN IM.CHAP.SIZEFN IM.CHAP.PUTFN
IM.CHAP.GETFN IM.CHAP.BUTTONEVENTFN))
(P (ADVISE 'TEDIT.FORMAT.HARDCOPY 'AROUND '(RESETLST
(RESETSAVE NIL (LIST (FUNCTION IM.INDEX.CLOSEF
)
STREAM))
*))
(IM.INDEX.INIT))))
(P (IM.INDEX.INIT))))
@@ -494,9 +488,9 @@ Copyright (c) 1986, 1987, 1988, 1991, 1992 by Xerox Corporation. All rights res
(DECLARE%: EVAL@COMPILE
(RECORD IM.INDEX.DATA (NAME TYPE SAV INFO SUBSEC PAGE# . PROPLIST)
SUBSEC _ IM.INDEX.DEFAULT.SUBSEC (TYPE? (AND (LISTP DATUM)
(IGEQ (LENGTH DATUM)
6))))
SUBSEC _ IM.INDEX.DEFAULT.SUBSEC (TYPE? (AND (LISTP DATUM)
(IGEQ (LENGTH DATUM)
6))))
)
(RPAQQ IM.INDEX.OBJ.FREEMENU.SPECS
@@ -638,21 +632,15 @@ Copyright (c) 1986, 1987, 1988, 1991, 1992 by Xerox Corporation. All rights res
T])
)
(ADVISE 'TEDIT.FORMAT.HARDCOPY 'AROUND '(RESETLST
(RESETSAVE NIL (LIST (FUNCTION IM.INDEX.CLOSEF)
STREAM))
*))
(IM.INDEX.INIT)
(PUTPROPS IMINDEX COPYRIGHT ("Xerox Corporation" 1986 1987 1988 1991 1992))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2160 15212 (IM.INDEX.CLOSEF 2170 . 2785) (IM.INDEX.COPYFN 2787 . 2972) (
IM.INDEX.CREATEOBJ 2974 . 4320) (IM.INDEX.DISPLAY.STRING 4322 . 4743) (IM.INDEX.DISPLAYFN 4745 . 8588)
(IM.INDEX.EDIT 8590 . 12058) (IM.INDEX.LIST.FROM.STRING 12060 . 13094) (IM.INDEX.SIZEFN 13096 . 13856
) (IM.INDEX.STRING.FROM.LIST 13858 . 14103) (IM.INDEX.PUTFN 14105 . 14294) (IM.INDEX.GETFN 14296 .
14451) (IM.INDEX.BUTTONEVENTFN 14453 . 15210)) (15213 17283 (IM.INDEX.INIT 15223 . 17281)) (17284
29200 (IM.INDEX.MENU 17294 . 18982) (IM.INDEX.MENU.WHENSELECTEDFN 18984 . 25739) (
IM.INDEX.OBJ.FREEMENU.SELECTEDFN 25741 . 29198)) (31736 36879 (IM.CHAP.COPYFN 31746 . 31926) (
IM.CHAP.CREATEOBJ 31928 . 33354) (IM.CHAP.DISPLAYFN 33356 . 35316) (IM.CHAP.SIZEFN 35318 . 36320) (
IM.CHAP.PUTFN 36322 . 36506) (IM.CHAP.GETFN 36508 . 36669) (IM.CHAP.BUTTONEVENTFN 36671 . 36877)))))
(FILEMAP (NIL (1673 14725 (IM.INDEX.CLOSEF 1683 . 2298) (IM.INDEX.COPYFN 2300 . 2485) (
IM.INDEX.CREATEOBJ 2487 . 3833) (IM.INDEX.DISPLAY.STRING 3835 . 4256) (IM.INDEX.DISPLAYFN 4258 . 8101)
(IM.INDEX.EDIT 8103 . 11571) (IM.INDEX.LIST.FROM.STRING 11573 . 12607) (IM.INDEX.SIZEFN 12609 . 13369
) (IM.INDEX.STRING.FROM.LIST 13371 . 13616) (IM.INDEX.PUTFN 13618 . 13807) (IM.INDEX.GETFN 13809 .
13964) (IM.INDEX.BUTTONEVENTFN 13966 . 14723)) (14726 16796 (IM.INDEX.INIT 14736 . 16794)) (16797
28713 (IM.INDEX.MENU 16807 . 18495) (IM.INDEX.MENU.WHENSELECTEDFN 18497 . 25252) (
IM.INDEX.OBJ.FREEMENU.SELECTEDFN 25254 . 28711)) (31229 36372 (IM.CHAP.COPYFN 31239 . 31419) (
IM.CHAP.CREATEOBJ 31421 . 32847) (IM.CHAP.DISPLAYFN 32849 . 34809) (IM.CHAP.SIZEFN 34811 . 35813) (
IM.CHAP.PUTFN 35815 . 35999) (IM.CHAP.GETFN 36001 . 36162) (IM.CHAP.BUTTONEVENTFN 36164 . 36370)))))
STOP

BIN
doctools/IMINDEX.LCOM
View File

Binary file not shown.

268
doctools/IMTEDIT
View File

@@ -1,17 +1,13 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "20-Jul-2022 15:10:53" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>doctools>IMTEDIT.;2 117347
(FILECREATED " 6-Mar-2024 21:18:02" {WMEDLEY}<doctools>IMTEDIT.;4 116622
:CHANGES-TO (FNS MAKE.IM.DOCUMENT)
:EDIT-BY rmk
:PREVIOUS-DATE " 8-Dec-91 15:41:54"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>doctools>IMTEDIT.;1)
:CHANGES-TO (FNS TRANSLATE.DUMPOUT MAKE.IM.DOCUMENT)
:PREVIOUS-DATE "20-Jul-2022 15:10:53" {WMEDLEY}<doctools>IMTEDIT.;2)
(* ; "
Copyright (c) 1983-1986, 1991 by Xerox Corporation.
")
(PRETTYCOMPRINT IMTEDITCOMS)
@@ -493,27 +489,26 @@ Copyright (c) 1983-1986, 1991 by Xerox Corporation.
(DUMPOUT FONT LISP DUMP.CHARS SAV])
(MAKE.IM.DOCUMENT
[LAMBDA (FORM OUTFILE.FLG PAGE.LAYOUT OUTPUT.MESSAGE DEFAULT.PARALOOKS PTRFILENAME)
(* ; "Edited 20-Jul-2022 15:10 by rmk")
[LAMBDA (FORM OUTFILE.FLG PAGE.LAYOUT OUTPUT.MESSAGE DEFAULT.PARALOOKS PTRFILENAME)
(* ;; "Edited 6-Mar-2024 21:17 by rmk: Fixed backquote commas. Also put IM.INDEX.CLOSEF calls in TEXTPROPs so advice in IMINDEX can be eliminated.")
(* ;; "Edited 20-Jul-2022 15:10 by rmk")
(* mjs " 4-Aug-86 10:52")
(* * this function creates an IM output file, in XPS-compatible format.
 If sets up all of the special variables needed by DUMP, evaluates FORM, and sets
 all of the para and font looks)
(* ;;; "this function creates an IM output file, in XPS-compatible format. If sets up all of the special variables needed by DUMP, evaluates FORM, and sets all of the para and font looks")
(* * If OUTFILE.FLG is NIL, the output file is just sent to the default printer.
 If OUTFILE.FLG is T, the outfile textstream is simply returned.
 If OUTFILE.FLG = anything else, it is taken as a file name to put the press file
 which is created <but not printed>.)
(* ;;; "If OUTFILE.FLG is NIL, the output file is just sent to the default printer. If OUTFILE.FLG is T, the outfile textstream is simply returned. If OUTFILE.FLG = anything else, it is taken as a file name to put the press file which is created <but not printed>.")
(* * if PAGE.LAYOUT is non-NIL, it should be the compound page layout to be used.)
(* ;;; "if PAGE.LAYOUT is non-NIL, it should be the compound page layout to be used.")
(* * if OUTPUT.MESSAGE is non-NIL, it is printed on the hardcopy output)
(* ;;; "if OUTPUT.MESSAGE is non-NIL, it is printed on the hardcopy output")
(* * PTRFILENAME is the name to be used if an index pointer file is generated
 during hardcopy <by printing index objects>)
(* ;;; "PTRFILENAME is the name to be used if an index pointer file is generated during hardcopy <by printing index objects>")
(PROG ((IM.OUTFILE (OPENTEXTSTREAM NIL NIL NIL NIL (LIST 'IM.INDEX.PTRFILENAME PTRFILENAME)))
(PROG ([IM.OUTFILE (OPENTEXTSTREAM NIL NIL NIL NIL `(IM.INDEX.PTRFILENAME ,PTRFILENAME
AFTERHARDCOPYFN (FUNCTION
IM.INDEX.INIT]
(FONT.STACK (CONS))
(IM.TEDIT.LAST.PARA.BEGIN 1)
(IM.TEDIT.LAST.FONT.BEGIN 1)
@@ -532,7 +527,7 @@ Copyright (c) 1983-1986, 1991 by Xerox Corporation.
(DUMP.HEADERS.FOOTERS " " " ")
(DUMPOUT CR CR START.PARA PARALOOKS
`(TYPE PAGEHEADING SUBTYPE DRAFTMESSAGE QUAD LEFT 1STLEFTMARGIN 0 LEFTMARGIN 0
RIGHTMARGIN %, IM.TEXT.RIGHTMARGIN)
RIGHTMARGIN ,IM.TEXT.RIGHTMARGIN)
DUMP.CHARS
(COND
(IM.DRAFT.FLG (CONCAT "***DRAFT*** " (DATE)
@@ -543,73 +538,65 @@ Copyright (c) 1983-1986, 1991 by Xerox Corporation.
(COND
(IM.EVEN.FLG
(* if you must quarantee that you have an even number of pages for two-sided
 copying, dump out a blank page no matter what --
 it can always be discarded)
(* ;; "if you must quarantee that you have an even number of pages for two-sided copying, dump out a blank page no matter what -- it can always be discarded")
(DUMPOUT CR CR START.PARA PARALOOKS
`(NEWPAGEBEFORE T QUAD LEFT 1STLEFTMARGIN 0 LEFTMARGIN 0 RIGHTMARGIN %,
IM.TEXT.RIGHTMARGIN SPECIALX %, IM.BLANKPAGE.SPECIALX SPECIALY %,
IM.BLANKPAGE.SPECIALY)
`(NEWPAGEBEFORE T QUAD LEFT 1STLEFTMARGIN 0 LEFTMARGIN 0 RIGHTMARGIN
,IM.TEXT.RIGHTMARGIN SPECIALX ,IM.BLANKPAGE.SPECIALX SPECIALY
,IM.BLANKPAGE.SPECIALY)
DUMP.CHARS "[This page intentionally left blank]" CR CR)))
(* after converting document, make sure that last para is formatted correctly by
 changing font, ending current para, and starting new para)
(* ;; "after converting document, make sure that last para is formatted correctly by changing font, ending current para, and starting new para")
(DUMPOUT CR CR FONT NIL)
(DUMP '(START.PARA))
(* * set page format)
(* ;;; "set page format")
[TEDIT.PAGEFORMAT IM.OUTFILE
(COND
(PAGE.LAYOUT)
(T (TEDIT.COMPOUND.PAGEFORMAT [TEDIT.SINGLE.PAGEFORMAT NIL NIL NIL NIL NIL
IM.PAGE.LEFTMARGIN IM.PAGE.RIGHTMARGIN
IM.PAGE.FIRST.TOPMARGIN IM.PAGE.BOTTOMMARGIN
1 NIL NIL
`((RECTOFOOT %, IM.PAGE.LEFTMARGIN %,
IM.FOOTER.Y)
(RECTOFOOTRULE %, IM.PAGE.LEFTMARGIN %,
IM.FOOTER.RULE.Y)
(DRAFTMESSAGE %, IM.DRAFT.MESSAGE.X %,
IM.DRAFT.MESSAGE.BOTTOM.Y]
(T (TEDIT.COMPOUND.PAGEFORMAT [TEDIT.SINGLE.PAGEFORMAT
NIL NIL NIL NIL NIL IM.PAGE.LEFTMARGIN
IM.PAGE.RIGHTMARGIN IM.PAGE.FIRST.TOPMARGIN
IM.PAGE.BOTTOMMARGIN 1 NIL NIL
`((RECTOFOOT ,IM.PAGE.LEFTMARGIN ,IM.FOOTER.Y)
(RECTOFOOTRULE ,IM.PAGE.LEFTMARGIN
,IM.FOOTER.RULE.Y)
(DRAFTMESSAGE ,IM.DRAFT.MESSAGE.X
,IM.DRAFT.MESSAGE.BOTTOM.Y]
[TEDIT.SINGLE.PAGEFORMAT NIL NIL NIL NIL NIL IM.PAGE.LEFTMARGIN
IM.PAGE.RIGHTMARGIN IM.PAGE.TOPMARGIN IM.PAGE.BOTTOMMARGIN 1 NIL
NIL `((DRAFTMESSAGE %, IM.DRAFT.MESSAGE.X %,
IM.DRAFT.MESSAGE.TOP.Y)
(VERSOHEAD %, IM.PAGE.LEFTMARGIN %, IM.HEADER.Y)
(VERSOHEADRULE %, IM.PAGE.LEFTMARGIN %, IM.HEADER.RULE.Y)
(VERSOFOOT %, IM.PAGE.LEFTMARGIN %, IM.FOOTER.Y)
(VERSOFOOTRULE %, IM.PAGE.LEFTMARGIN %, IM.FOOTER.RULE.Y)
(DRAFTMESSAGE %, IM.DRAFT.MESSAGE.X %,
IM.DRAFT.MESSAGE.BOTTOM.Y]
NIL `((DRAFTMESSAGE ,IM.DRAFT.MESSAGE.X ,IM.DRAFT.MESSAGE.TOP.Y)
(VERSOHEAD ,IM.PAGE.LEFTMARGIN ,IM.HEADER.Y)
(VERSOHEADRULE ,IM.PAGE.LEFTMARGIN ,IM.HEADER.RULE.Y)
(VERSOFOOT ,IM.PAGE.LEFTMARGIN ,IM.FOOTER.Y)
(VERSOFOOTRULE ,IM.PAGE.LEFTMARGIN ,IM.FOOTER.RULE.Y)
(DRAFTMESSAGE ,IM.DRAFT.MESSAGE.X
,IM.DRAFT.MESSAGE.BOTTOM.Y]
(TEDIT.SINGLE.PAGEFORMAT NIL NIL NIL NIL NIL IM.PAGE.LEFTMARGIN
IM.PAGE.RIGHTMARGIN IM.PAGE.TOPMARGIN IM.PAGE.BOTTOMMARGIN 1 NIL
NIL `((DRAFTMESSAGE %, IM.DRAFT.MESSAGE.X %,
IM.DRAFT.MESSAGE.TOP.Y)
(RECTOHEAD %, IM.PAGE.LEFTMARGIN %, IM.HEADER.Y)
(RECTOHEADRULE %, IM.PAGE.LEFTMARGIN %, IM.HEADER.RULE.Y)
(RECTOFOOT %, IM.PAGE.LEFTMARGIN %, IM.FOOTER.Y)
(RECTOFOOTRULE %, IM.PAGE.LEFTMARGIN %, IM.FOOTER.RULE.Y)
(DRAFTMESSAGE %, IM.DRAFT.MESSAGE.X %,
IM.DRAFT.MESSAGE.BOTTOM.Y]
NIL `((DRAFTMESSAGE ,IM.DRAFT.MESSAGE.X ,IM.DRAFT.MESSAGE.TOP.Y)
(RECTOHEAD ,IM.PAGE.LEFTMARGIN ,IM.HEADER.Y)
(RECTOHEADRULE ,IM.PAGE.LEFTMARGIN ,IM.HEADER.RULE.Y)
(RECTOFOOT ,IM.PAGE.LEFTMARGIN ,IM.FOOTER.Y)
(RECTOFOOTRULE ,IM.PAGE.LEFTMARGIN ,IM.FOOTER.RULE.Y)
(DRAFTMESSAGE ,IM.DRAFT.MESSAGE.X
,IM.DRAFT.MESSAGE.BOTTOM.Y]
(* * dump default char and para looks for whole document --
 and looks that should be different should be specified in the fns)
(* ;;; "dump default char and para looks for whole document -- and looks that should be different should be specified in the fns")
(TEDIT.LOOKS IM.OUTFILE IM.TEXT.FONT 1 (GETFILEINFO IM.OUTFILE 'LENGTH))
(TEDIT.PARALOOKS IM.OUTFILE
[COND
(DEFAULT.PARALOOKS)
(T `(QUAD JUSTIFIED 1STLEFTMARGIN %, IM.TEXT.LEFTMARGIN LEFTMARGIN %,
IM.TEXT.LEFTMARGIN RIGHTMARGIN %, IM.TEXT.RIGHTMARGIN LINELEADING 0
PARALEADING 5 POSTPARALEADING 0]
(TEDIT.PARALOOKS IM.OUTFILE [COND
(DEFAULT.PARALOOKS)
(T `(QUAD JUSTIFIED 1STLEFTMARGIN ,IM.TEXT.LEFTMARGIN
LEFTMARGIN ,IM.TEXT.LEFTMARGIN RIGHTMARGIN
,IM.TEXT.RIGHTMARGIN LINELEADING 0 PARALEADING 5
POSTPARALEADING 0]
1
(GETFILEINFO IM.OUTFILE 'LENGTH))
(* must reverse list because the order of some char and paragraph looks is
 significant << earlier looks are overridden by later ones >>)
(* ;; "must reverse list because the order of some char and paragraph looks is significant << earlier looks are overridden by later ones >>")
(SETQ IM.CHARLOOKS (DREVERSE IM.CHARLOOKS))
(SETQ IM.PARALOOKS (DREVERSE IM.PARALOOKS))
@@ -2309,83 +2296,75 @@ page edge.)
(DEFINEQ
(TRANSLATE.DUMPOUT
[LAMBDA (DUMPOUT.ARGS) (* mjs "18-Sep-85 16:17")
[LAMBDA (DUMPOUT.ARGS) (* mjs "18-Sep-85 16:17")
(* * this function translates the DUMPOUT macro form into a PROGN form that
 calls a series of functions, such as DUMP.)
(* * this function translates the DUMPOUT macro form into a PROGN form that calls
 a series of functions, such as DUMP.)
(* * the indentation code has been commented out ---
 will try indenting everything to same, unless specified otherwise with
 PARALOOKS)
 will try indenting everything to same, unless specified otherwise with PARALOOKS)
(PROG ((DUMPOUT.FORMS NIL)
(DUMPOUT.UNDO NIL)
COMM COMM.ARG)
[while DUMPOUT.ARGS do (SELECTQ (SETQ COMM (pop DUMPOUT.ARGS))
(NIL)
((CR TAB START.PARA DUMP.FOOTNOTES START.SUPER START.SUB
END.SUPER END.SUB)
(* just pass these atoms as commands
 to DUMP)
(push DUMPOUT.FORMS (LIST 'DUMP.FORMAT
(KWOTE COMM))))
((FLUSH.ARG TRIVIAL.ARG DUMP.ARG)
(push DUMPOUT.FORMS (LIST COMM)))
(INDENT
(NIL)
((CR TAB START.PARA DUMP.FOOTNOTES START.SUPER START.SUB
END.SUPER END.SUB) (* just pass these atoms as commands
 to DUMP)
(push DUMPOUT.FORMS (LIST 'DUMP.FORMAT (KWOTE COMM))))
((FLUSH.ARG TRIVIAL.ARG DUMP.ARG)
(push DUMPOUT.FORMS (LIST COMM)))
(INDENT
(* * SELECTQ (SETQ COMM.ARG (pop DUMPOUT.ARGS))
 (INIT (push DUMPOUT.FORMS (QUOTE (PUT.MY.PROP
 (QUOTE INDENT) INITIAL.INDENT))) (push DUMPOUT.FORMS
 (QUOTE (PUT.MY.PROP (QUOTE WIDTH) INITIAL.WIDTH)))
 (push DUMPOUT.FORMS (QUOTE (DUMP.FORMAT
 (QUOTE INDENT) INITIAL.INDENT)))) (NONE
 (push DUMPOUT.FORMS (QUOTE (PUT.MY.PROP
 (QUOTE INDENT) (QUOTE NONE)))) (push DUMPOUT.FORMS
 (QUOTE (PUT.MY.PROP (QUOTE WIDTH) (ANC.WIDTH))))
 (push DUMPOUT.FORMS (QUOTE (DUMP.FORMAT
 (QUOTE INDENT) (QUOTE NONE))))) (push DUMPOUT.FORMS
 (LIST (QUOTE (LAMBDA (I) (PUT.MY.PROP (QUOTE INDENT)
 (IPLUS (ANC.INDENT) I)) (PUT.MY.PROP (QUOTE WIDTH)
 (IDIFFERENCE (ANC.WIDTH) I)) (DUMP.FORMAT
 (QUOTE INDENT) (IPLUS (ANC.INDENT) I)))) COMM.ARG)))
 (INIT (push DUMPOUT.FORMS (QUOTE (PUT.MY.PROP
 (QUOTE INDENT) INITIAL.INDENT))) (push DUMPOUT.FORMS
 (QUOTE (PUT.MY.PROP (QUOTE WIDTH) INITIAL.WIDTH)))
 (push DUMPOUT.FORMS (QUOTE (DUMP.FORMAT (QUOTE INDENT) INITIAL.INDENT))))
 (NONE (push DUMPOUT.FORMS (QUOTE (PUT.MY.PROP
 (QUOTE INDENT) (QUOTE NONE)))) (push DUMPOUT.FORMS
 (QUOTE (PUT.MY.PROP (QUOTE WIDTH) (ANC.WIDTH))))
 (push DUMPOUT.FORMS (QUOTE (DUMP.FORMAT (QUOTE INDENT)
 (QUOTE NONE))))) (push DUMPOUT.FORMS (LIST
 (QUOTE (LAMBDA (I) (PUT.MY.PROP (QUOTE INDENT)
 (IPLUS (ANC.INDENT) I)) (PUT.MY.PROP (QUOTE WIDTH)
 (IDIFFERENCE (ANC.WIDTH) I)) (DUMP.FORMAT
 (QUOTE INDENT) (IPLUS (ANC.INDENT) I)))) COMM.ARG)))
(* * push DUMPOUT.UNDO (QUOTE INDENT))
(SETQ COMM.ARG (pop DUMPOUT.ARGS)))
(WIDTH (push DUMPOUT.FORMS
(LIST 'PUT.MY.PROP (KWOTE 'WIDTH)
(pop DUMPOUT.ARGS))))
(FONT (SETQ COMM.ARG (pop DUMPOUT.ARGS))
[push DUMPOUT.FORMS
(LIST 'DUMP.FORMAT (KWOTE 'FONT)
(COND
((LISTGET IM.TEDIT.FONT.DEFS
COMM.ARG)
(KWOTE COMM.ARG))
(T COMM.ARG]
(push DUMPOUT.UNDO 'FONT))
(PARALOOKS (push DUMPOUT.FORMS
(LIST 'DUMP.FORMAT (KWOTE 'PARALOOKS)
(pop DUMPOUT.ARGS))))
(DUMP.CHARS (push DUMPOUT.FORMS
(LIST (FUNCTION IM.DUMP.CHARS)
(SETQ COMM.ARG (pop DUMPOUT.ARGS)))
(WIDTH (push DUMPOUT.FORMS (LIST 'PUT.MY.PROP
(KWOTE 'WIDTH)
(pop DUMPOUT.ARGS))))
(push DUMPOUT.FORMS (LIST 'DUMP.FORMAT
(KWOTE 'TEXT)
(LIST 'MAKE.SAVE COMM]
[for X in DUMPOUT.UNDO do (push DUMPOUT.FORMS (LIST 'DUMP.FORMAT
(KWOTE 'UNDO)
(KWOTE X]
(FONT (SETQ COMM.ARG (pop DUMPOUT.ARGS))
[push DUMPOUT.FORMS (LIST 'DUMP.FORMAT (KWOTE 'FONT)
(COND
((LISTGET IM.TEDIT.FONT.DEFS
COMM.ARG)
(KWOTE COMM.ARG))
(T COMM.ARG]
(push DUMPOUT.UNDO 'FONT))
(PARALOOKS (push DUMPOUT.FORMS (LIST 'DUMP.FORMAT
(KWOTE 'PARALOOKS)
(pop DUMPOUT.ARGS))))
(DUMP.CHARS (push DUMPOUT.FORMS (LIST (FUNCTION IM.DUMP.CHARS)
(pop DUMPOUT.ARGS))))
(push DUMPOUT.FORMS (LIST 'DUMP.FORMAT (KWOTE 'TEXT)
(LIST 'MAKE.SAVE COMM]
[for X in DUMPOUT.UNDO do (push DUMPOUT.FORMS (LIST 'DUMP.FORMAT (KWOTE 'UNDO)
(KWOTE X]
(* * push DUMPOUT.FORMS (QUOTE (PUT.MY.PROP
 (QUOTE INDENT) DUMPOUT.SAVE.INDENT)))
 (QUOTE INDENT) DUMPOUT.SAVE.INDENT)))
(* * push DUMPOUT.FORMS (QUOTE (PUT.MY.PROP
 (QUOTE WIDTH) DUMPOUT.SAVE.WIDTH)))
 (QUOTE WIDTH) DUMPOUT.SAVE.WIDTH)))
(* * RETURN (APPEND (QUOTE (PROG ((DUMPOUT.SAVE.INDENT
 (GET.MY.PROP (QUOTE INDENT))) (DUMPOUT.SAVE.WIDTH
 (GET.MY.PROP (QUOTE WIDTH)))))) (DREVERSE DUMPOUT.FORMS)))
 (GET.MY.PROP (QUOTE INDENT))) (DUMPOUT.SAVE.WIDTH
 (GET.MY.PROP (QUOTE WIDTH)))))) (DREVERSE DUMPOUT.FORMS)))
(RETURN (CONS 'PROGN (DREVERSE DUMPOUT.FORMS])
@@ -2408,25 +2387,24 @@ page edge.)
(PUTPROPS SAVE.DUMPOUT MACRO (X (TRANSLATE.SAVE.DUMPOUT X)))
)
(PUTPROPS IMTEDIT COPYRIGHT ("Xerox Corporation" 1983 1984 1985 1986 1991))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (10773 38278 (IM.TEDIT 10783 . 12464) (DUMP 12466 . 14761) (DUMP.HEADERS.FOOTERS 14763
. 17129) (DUMP.HRULE 17131 . 18282) (CHANGE.FONT 18284 . 19478) (IM.BOUT.IMAGEOBJ 19480 . 19803) (
IM.TEDIT.DUMP.COMMANDS 19805 . 23358) (IM.TEDIT.DUMP.FOOTNOTES 23360 . 23801) (IM.TEDIT.DUMP.PARA
23803 . 24577) (INDEXX.PARSE.TYPE 24579 . 25874) (FORMAT.DEF 25876 . 28007) (FORMAT.LISPWORD 28009 .
28160) (MAKE.IM.DOCUMENT 28162 . 37133) (PRINT.NOTE 37135 . 37349) (SEND.INFO 37351 . 38276)) (38387
42405 (IM.VRULE.DISPLAYFN 38397 . 38721) (CREATE.VRULE.OBJECT 38723 . 40503) (PRINT.VRULES.ON.PAGE
40505 . 42403)) (42563 47318 (IM.FOLIO.DISPLAYFN 42573 . 43251) (IM.FOLIO.SIZEFN 43253 . 44102) (
CREATE.FOLIO.OBJECT 44104 . 45650) (GET.FOLIO.STRING 45652 . 47316)) (47450 93690 (ARG#TOPROG 47460 .
47599) (BIGLISPCODE#TOPROG 47601 . 48837) (BRACKET#TOPROG 48839 . 49003) (CHAPTER#TOPROG 49005 . 51686
) (COMMENT#TOPROG 51688 . 52240) (DEF#TOPROG 52242 . 55577) (FIGURE#TOPROG 55579 . 56923) (FN#TOPROG
56925 . 57322) (FNDEF#TOPROG 57324 . 61216) (FOOT#TOPROG 61218 . 61759) (INCLUDE#TOPROG 61761 . 62076)
(INDEX#TOPROG 62078 . 63168) (INDEXX#TOPROG 63170 . 65251) (IT#TOPROG 65253 . 65394) (LBRACKET#TOPROG
65396 . 65550) (LISP#TOPROG 65552 . 65693) (LISPCODE#TOPROG 65695 . 66814) (LISPWORD#TOPROG 66816 .
67556) (LIST#TOPROG 67558 . 71980) (MACDEF#TOPROG 71982 . 73160) (NOTE#TOPROG 73162 . 73842) (
PRINT.SPECIAL.CHARS#TOPROG 73844 . 74821) (PROPDEF#TOPROG 74823 . 75100) (RBRACKET#TOPROG 75102 .
75256) (REF#TOPROG 75258 . 83097) (RM#TOPROG 83099 . 83237) (SUB#TOPROG 83239 . 83387) (SUBSEC#TOPROG
83389 . 87892) (SUPER#TOPROG 87894 . 88048) (TABLE#TOPROG 88050 . 92002) (TAG#TOPROG 92004 . 92271) (
TERM#TOPROG 92273 . 92586) (VAR#TOPROG 92588 . 92991) (VARDEF#TOPROG 92993 . 93688)) (111336 116764 (
TRANSLATE.DUMPOUT 111346 . 116363) (TRANSLATE.SAVE.DUMPOUT 116365 . 116762)))))
(FILEMAP (NIL (10668 38115 (IM.TEDIT 10678 . 12359) (DUMP 12361 . 14656) (DUMP.HEADERS.FOOTERS 14658
. 17024) (DUMP.HRULE 17026 . 18177) (CHANGE.FONT 18179 . 19373) (IM.BOUT.IMAGEOBJ 19375 . 19698) (
IM.TEDIT.DUMP.COMMANDS 19700 . 23253) (IM.TEDIT.DUMP.FOOTNOTES 23255 . 23696) (IM.TEDIT.DUMP.PARA
23698 . 24472) (INDEXX.PARSE.TYPE 24474 . 25769) (FORMAT.DEF 25771 . 27902) (FORMAT.LISPWORD 27904 .
28055) (MAKE.IM.DOCUMENT 28057 . 36970) (PRINT.NOTE 36972 . 37186) (SEND.INFO 37188 . 38113)) (38224
42242 (IM.VRULE.DISPLAYFN 38234 . 38558) (CREATE.VRULE.OBJECT 38560 . 40340) (PRINT.VRULES.ON.PAGE
40342 . 42240)) (42400 47155 (IM.FOLIO.DISPLAYFN 42410 . 43088) (IM.FOLIO.SIZEFN 43090 . 43939) (
CREATE.FOLIO.OBJECT 43941 . 45487) (GET.FOLIO.STRING 45489 . 47153)) (47287 93527 (ARG#TOPROG 47297 .
47436) (BIGLISPCODE#TOPROG 47438 . 48674) (BRACKET#TOPROG 48676 . 48840) (CHAPTER#TOPROG 48842 . 51523
) (COMMENT#TOPROG 51525 . 52077) (DEF#TOPROG 52079 . 55414) (FIGURE#TOPROG 55416 . 56760) (FN#TOPROG
56762 . 57159) (FNDEF#TOPROG 57161 . 61053) (FOOT#TOPROG 61055 . 61596) (INCLUDE#TOPROG 61598 . 61913)
(INDEX#TOPROG 61915 . 63005) (INDEXX#TOPROG 63007 . 65088) (IT#TOPROG 65090 . 65231) (LBRACKET#TOPROG
65233 . 65387) (LISP#TOPROG 65389 . 65530) (LISPCODE#TOPROG 65532 . 66651) (LISPWORD#TOPROG 66653 .
67393) (LIST#TOPROG 67395 . 71817) (MACDEF#TOPROG 71819 . 72997) (NOTE#TOPROG 72999 . 73679) (
PRINT.SPECIAL.CHARS#TOPROG 73681 . 74658) (PROPDEF#TOPROG 74660 . 74937) (RBRACKET#TOPROG 74939 .
75093) (REF#TOPROG 75095 . 82934) (RM#TOPROG 82936 . 83074) (SUB#TOPROG 83076 . 83224) (SUBSEC#TOPROG
83226 . 87729) (SUPER#TOPROG 87731 . 87885) (TABLE#TOPROG 87887 . 91839) (TAG#TOPROG 91841 . 92108) (
TERM#TOPROG 92110 . 92423) (VAR#TOPROG 92425 . 92828) (VARDEF#TOPROG 92830 . 93525)) (111173 116115 (
TRANSLATE.DUMPOUT 111183 . 115714) (TRANSLATE.SAVE.DUMPOUT 115716 . 116113)))))
STOP

BIN
doctools/IMTEDIT.LCOM
View File

Binary file not shown.

17
internal/loadups/LOADUP-LISP
View File

@@ -1,11 +1,13 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED "31-Jul-2023 18:22:53" |{DSK}<home>frank>il>medley>gmedley>sources>LOADUP-LISP.;2| 5235
(FILECREATED "14-Mar-2024 12:16:33" |{DSK}<home>larry>il>medley>internal>loadups>LOADUP-LISP.;2| 5426
:EDIT-BY "lmm"
:CHANGES-TO (FNS LOADUP-LISP)
:PREVIOUS-DATE "27-Feb-2023 17:15:53"
|{DSK}<home>frank>il>medley>gmedley>sources>LOADUP-LISP.;1|)
:PREVIOUS-DATE "31-Jul-2023 18:22:53"
|{DSK}<home>larry>il>medley>internal>loadups>LOADUP-LISP.;1|)
(PRETTYCOMPRINT LOADUP-LISPCOMS)
@@ -18,7 +20,8 @@
(DEFINEQ
(LOADUP-LISP
(LAMBDA (DRIBBLEFILE) (* \; "Edited 26-Feb-2023 12:17 by lmm")
(LAMBDA (DRIBBLEFILE) (* \; "Edited 14-Mar-2024 12:16 by lmm")
(* \; "Edited 26-Feb-2023 12:17 by lmm")
(* \; "Edited 13-Jul-2022 14:09 by rmk")
(* \; "Edited 4-Mar-2022 19:13 by larry")
(* \; "Edited 29-Apr-2021 22:30 by rmk:")
@@ -107,6 +110,10 @@
(PACKAGE-ENABLE)
(* |;;| " Added late")
(LOADUP '(XCL-LOOP))
(* |;;| " networking code -- should make it optional but too many cross dependencies")
(LOADUP '(PUP 10MBDRIVER LEAF LLETHER DPUPFTP LOCALFILE DSKDISPLAY COURIER LLNS TRSERVER SPP
@@ -123,5 +130,5 @@
(GLOBALVARS MAKESYSFILENAME MEDLEY-INIT-VARS MEDLEYDIR SYSTEMINITVARS USERRECLST)
)
(DECLARE\: DONTCOPY
(FILEMAP (NIL (649 5029 (LOADUP-LISP 659 . 5027)))))
(FILEMAP (NIL (673 5220 (LOADUP-LISP 683 . 5218)))))
STOP

BIN
internal/loadups/LOADUP-LISP.LCOM
View File

Binary file not shown.

293
library/lafite/LAFITE
View File

@@ -1,16 +1,13 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "30-Sep-2021 22:59:08" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITE.;5 71956
changes to%: (FILES LAFITEDECLS)
(FILECREATED "26-Feb-2024 20:10:22" {WMEDLEY}<library>lafite>LAFITE.;19 72156
previous date%: "24-Jun-2021 19:17:01"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITE.;4)
:EDIT-BY rmk
:CHANGES-TO (VARS LAFITECOMS LAFITEFILES)
:PREVIOUS-DATE "24-Feb-2024 11:56:21" {WMEDLEY}<library>lafite>LAFITE.;18)
(* ; "
Copyright (c) 1982-1989, 1993-1994, 2021 by Xerox Corporation and Bolt Beranek and Newman Inc..
")
(PRETTYCOMPRINT LAFITECOMS)
@@ -86,29 +83,29 @@ Copyright (c) 1982-1989, 1993-1994, 2021 by Xerox Corporation and Bolt Beranek a
\LAFITE.CLOSE.FOLDER)
(FNS \LAFITE.DESCRIBE.FOLDER))
(COMS (* ;
 "Make is easy to load new versions of Lafite")
 "Make is easy to load new versions of Lafite")
(FNS LOAD-LAFITE)
(VARS LAFITEFILES))
[DECLARE%: DOEVAL@COMPILE DONTCOPY (FILES (SOURCE)
LAFITEDECLS)
LAFITE-DECLS)
(LOCALVARS . T)
(GLOBALVARS TEDIT.DEFAULT.MENU LAFITEFILES *COMPILED-EXTENSIONS*)
(P (CL:PROCLAIM '(CL:SPECIAL *LAFITE-LOGGING-IN*]
(INITRECORDS MAILFOLDER LAFITEMSG)
(SYSRECORDS MAILFOLDER LAFITEMSG)
[COMS (FNS \LAFITE.GLOBAL.INIT)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(FILES LAFITEBROWSE LAFITECOMMANDS LAFITEFOLDERS LAFITESEND LAFITEMAIL
LAFITESORT TEDIT LAFITETEDIT LAFITEFIND ATTACHEDWINDOW MAILSCAVENGE)
(DECLARE%: DONTEVAL@LOAD DOCOPY (FILES TEDIT ATTACHEDWINDOW)
(FILES LAFITE-BROWSE LAFITE-COMMANDS LAFITE-FOLDERS LAFITE-SEND LAFITE-MAIL
LAFITE-SORT LAFITE-TEDIT LAFITE-FIND LAFITE-MAILSCAVENGE)
(P * (PROGN LAFITE.PROCLAMATIONS))
(* ;
 "Proclaim user interface variables. Value is on LAFITEDECLS")
 "Proclaim user interface variables. Value is on LAFITE-DECLS")
(P (\LAFITE.GLOBAL.INIT)
(COND ((EQ MAKESYSNAME :LYRIC)
(FILESLOAD (SYSLOAD)
NSCHARPATCH)
(* ;
 "Patch to horrid Lyric NS chars bug")
 "Patch to horrid Lyric NS chars bug")
(MOVD? 'PROMPTFORWORD 'TTYINPROMPTFORWORD NIL T]
(DECLARE%: DOEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
@@ -116,7 +113,7 @@ Copyright (c) 1982-1989, 1993-1994, 2021 by Xerox Corporation and Bolt Beranek a
(RPAQQ LAFITEVERSION# 10)
(RPAQQ LAFITESYSTEMDATE "30-Sep-2021 22:59:08")
(RPAQQ LAFITESYSTEMDATE "26-Feb-2024 20:10:22")
(DEFINEQ
(LAFITE
@@ -277,7 +274,7 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
(CHARWIDTH (CHARCODE "W")
DEFAULTFONT))
(* ;
 "Yes, user has not changed default to a variable width font")
 "Yes, user has not changed default to a variable width font")
DEFAULTFONT)
(T (FONTCREATE '(GACHA 10]
(LAFITEHARDCOPYFONT LAFITEDISPLAYFONT)
@@ -317,7 +314,7 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
(CHARWIDTH (CHARCODE "W")
DEFAULTFONT))
(* ;
 "Yes, user has not changed default to a variable width font")
 "Yes, user has not changed default to a variable width font")
DEFAULTFONT)
(T (FONTCREATE '(GACHA 10])
@@ -354,9 +351,9 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
(RPAQ? LAFITE.USE.ALL.MODES T)
(RPAQQ LAFITERANDOMGLOBALS ((UNSUPPLIEDFIELDSTR "---")
(LAFITEBUSYWAITTIME 1000)
(LAFITEITEMBUSYSHADE 43605)
(LAFITEEOL "
(LAFITEBUSYWAITTIME 1000)
(LAFITEITEMBUSYSHADE 43605)
(LAFITEEOL "
")))
(RPAQ? UNSUPPLIEDFIELDSTR "---")
@@ -394,13 +391,13 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
(RPAQ HEARDMARK (CHARCODE @))
(RPAQQ LAFITECOMMANDMENUITEMS (("Browse" '\LAFITE.BROWSE
"Browse a mail file; MIDDLE for subcommands")
("Send Mail" '\LAFITE.MESSAGEFORM
(RPAQQ LAFITECOMMANDMENUITEMS (("Browse" '\LAFITE.BROWSE "Browse a mail file; MIDDLE for subcommands"
)
("Send Mail" '\LAFITE.MESSAGEFORM
"Open a message composition window; MIDDLE for choice of forms"
)
("Quit" '\LAFITE.QUIT
"Update and close all mail files and stop Lafite")))
)
("Quit" '\LAFITE.QUIT
"Update and close all mail files and stop Lafite")))
(RPAQQ LAFITEUPDATEMENUITEMS
(("Do Hardcopy Only" '\LAFITE.HARDCOPYONLY.PROC
@@ -435,7 +432,7 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
("Server trace" 'LAFITE.TOGGLE.SERVER.TRACE "Change setting of *NSMAIL-TRACE-SERVERS*")))
(RPAQQ ANOTHERFOLDERMENUITEM ("** Other Folder **" '%##ANOTHERFILE##
"You will be asked to specify another mail filename"))
"You will be asked to specify another mail filename"))
(RPAQ? LAFITESTATUSWINDOW )
@@ -622,17 +619,40 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
(DEFINEQ
(LOAD-LAFITE
(LAMBDA (DIR SOURCEP) (* ; "Edited 3-May-89 18:39 by bvm") (* ;; "Load Lafite from a specified directory (or the dir where we find the first file). If SOURCEP true we load the sources PROP, else the compiled files SYSLOAD. When loading compiled, we only load files that are noted as already loaded, since those are the only ones that won't be automatically loaded by the FILES command in file LAFITE (which must have been loaded if this function is defined).") (SETQ DIR (MKLIST DIR)) (for FILE in (if SOURCEP then LAFITEFILES else (REMOVE (QUOTE LAFITEDECLS) LAFITEFILES)) bind F when (OR SOURCEP (GET FILE (QUOTE FILEDATES))) collect (if (SETQ F (if SOURCEP then (FINDFILE FILE T DIR) else (FINDFILE-WITH-EXTENSIONS FILE DIR *COMPILED-EXTENSIONS*))) then (SETQ F (LOAD F (COND ((NOT SOURCEP) (QUOTE SYSLOAD)) ((EQ F (QUOTE LAFITEDECLS)) T) (T (QUOTE PROP))))) (if (NULL DIR) then (* ; "Fix dir for subsequent loading") (SETQ DIR (LIST (PACKFILENAME.STRING (QUOTE NAME) NIL (QUOTE EXTENSION) NIL (QUOTE VERSION) NIL (QUOTE BODY) F)))) F else (CONCAT FILE " not found"))))
)
[LAMBDA (DIR SOURCEP) (* ; "Edited 23-Feb-2024 23:02 by rmk")
(* ; "Edited 3-May-89 18:39 by bvm")
(* ;; "Load Lafite from a specified directory (or the dir where we find the first file). If SOURCEP true we load the sources PROP, else the compiled files SYSLOAD. When loading compiled, we only load files that are noted as already loaded, since those are the only ones that won't be automatically loaded by the FILES command in file LAFITE (which must have been loaded if this function is defined).")
(SETQ DIR (MKLIST DIR))
(for FILE in (if SOURCEP
then LAFITEFILES
else (REMOVE 'LAFITE-DECLS LAFITEFILES)) bind F
when (OR SOURCEP (GET FILE 'FILEDATES))
collect (if (SETQ F (if SOURCEP
then (FINDFILE FILE T DIR)
else (FINDFILE-WITH-EXTENSIONS FILE DIR *COMPILED-EXTENSIONS*)))
then [SETQ F (LOAD F (COND
((NOT SOURCEP)
'SYSLOAD)
((EQ F 'LAFITE-DECLS)
T)
(T 'PROP]
[if (NULL DIR)
then (* ; "Fix dir for subsequent loading")
(SETQ DIR (LIST (PACKFILENAME.STRING 'NAME NIL 'EXTENSION NIL
'VERSION NIL 'BODY F]
F
else (CONCAT FILE " not found"])
)
(RPAQQ LAFITEFILES (LAFITEDECLS LAFITEBROWSE LAFITECOMMANDS LAFITEFOLDERS LAFITEMAIL LAFITESEND
LAFITESORT LAFITETEDIT NSMAIL OLDNSMAIL NEWNSMAIL LAFITEFIND
MAILSCAVENGE LAFITE))
(RPAQQ LAFITEFILES (LAFITE-DECLS LAFITE-BROWSE LAFITE-COMMANDS LAFITE-FOLDERS LAFITE-MAIL LAFITE-SEND
LAFITE-SORT LAFITE-TEDIT LAFITE-NSMAIL OLDNSMAIL LAFITE-NEWNSMAIL
LAFITE-FIND LAFITE-MAILSCAVENGE LAFITE))
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(FILESLOAD (SOURCE)
LAFITEDECLS)
LAFITE-DECLS)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
@@ -743,81 +763,81 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
(ADDTOVAR SYSTEMRECLST
(DATATYPE MAILFOLDER ((BROWSERPROMPTDIRTY FLAG)
(BROWSERPROMPTGREW FLAG)
(FOLDERNEEDSUPDATE FLAG)
(FOLDERNEEDSEXPUNGE FLAG)
(FOLDERBEINGUPDATED FLAG)
(BROWSERSTATUS BITS 3)
(FULLFOLDERNAME POINTER)
(FOLDEROKTOSHRINK FLAG)
(FOLDERGETSMAIL FLAG)
(FOLDEROUTOFORDER FLAG)
(NIL 5 FLAG)
(VERSIONLESSFOLDERNAME POINTER)
(SHORTFOLDERNAME POINTER)
(FOLDERSTREAM POINTER)
(MESSAGEDESCRIPTORS POINTER)
(FOLDERLOCK POINTER)
(%#OFMESSAGES WORD)
(TOCLASTMESSAGE# WORD)
(BROWSERFONTHEIGHT WORD)
(BROWSERFONTASCENT WORD)
(BROWSERFONTDESCENT WORD)
(BROWSERMAXXPOS WORD)
(ORDINALXPOS WORD)
(DATEXPOS WORD)
(FROMXPOS WORD)
(FROMMAXXPOS WORD)
(SUBJECTXPOS WORD)
(BROWSERDIGITWIDTH WORD)
(FIRSTSELECTEDMESSAGE WORD)
(LASTSELECTEDMESSAGE WORD)
(FIRSTCHANGEDMESSAGE WORD)
(CURRENTPROMPTLINE WORD)
(CURRENTDISPLAYEDSTREAM POINTER)
(BROWSEREXTENT POINTER)
(BROWSERORIGIN POINTER)
(FOLDERDISPLAYREGION POINTER)
(BROWSERWINDOW POINTER)
(BROWSERMENU POINTER)
(BROWSERMENUWINDOW POINTER)
(BROWSERPROMPTWINDOW POINTER)
(ORIGINALBROWSERTITLE POINTER)
(FOLDERDISPLAYWINDOWS POINTER)
(FOLDEREOFPTR POINTER)
(DEFAULTMOVETOFILE POINTER)
(CURRENTDISPLAYEDMESSAGE POINTER)
(BROWSERUPDATEFROMHERE POINTER)
(BROWSERLAYOUT POINTER)
(FOLDERCREATIONDATE POINTER)
(HARDCOPYMESSAGES POINTER)
(HARDCOPYSTREAM POINTER)))
(BROWSERPROMPTGREW FLAG)
(FOLDERNEEDSUPDATE FLAG)
(FOLDERNEEDSEXPUNGE FLAG)
(FOLDERBEINGUPDATED FLAG)
(BROWSERSTATUS BITS 3)
(FULLFOLDERNAME POINTER)
(FOLDEROKTOSHRINK FLAG)
(FOLDERGETSMAIL FLAG)
(FOLDEROUTOFORDER FLAG)
(NIL 5 FLAG)
(VERSIONLESSFOLDERNAME POINTER)
(SHORTFOLDERNAME POINTER)
(FOLDERSTREAM POINTER)
(MESSAGEDESCRIPTORS POINTER)
(FOLDERLOCK POINTER)
(%#OFMESSAGES WORD)
(TOCLASTMESSAGE# WORD)
(BROWSERFONTHEIGHT WORD)
(BROWSERFONTASCENT WORD)
(BROWSERFONTDESCENT WORD)
(BROWSERMAXXPOS WORD)
(ORDINALXPOS WORD)
(DATEXPOS WORD)
(FROMXPOS WORD)
(FROMMAXXPOS WORD)
(SUBJECTXPOS WORD)
(BROWSERDIGITWIDTH WORD)
(FIRSTSELECTEDMESSAGE WORD)
(LASTSELECTEDMESSAGE WORD)
(FIRSTCHANGEDMESSAGE WORD)
(CURRENTPROMPTLINE WORD)
(CURRENTDISPLAYEDSTREAM POINTER)
(BROWSEREXTENT POINTER)
(BROWSERORIGIN POINTER)
(FOLDERDISPLAYREGION POINTER)
(BROWSERWINDOW POINTER)
(BROWSERMENU POINTER)
(BROWSERMENUWINDOW POINTER)
(BROWSERPROMPTWINDOW POINTER)
(ORIGINALBROWSERTITLE POINTER)
(FOLDERDISPLAYWINDOWS POINTER)
(FOLDEREOFPTR POINTER)
(DEFAULTMOVETOFILE POINTER)
(CURRENTDISPLAYEDMESSAGE POINTER)
(BROWSERUPDATEFROMHERE POINTER)
(BROWSERLAYOUT POINTER)
(FOLDERCREATIONDATE POINTER)
(HARDCOPYMESSAGES POINTER)
(HARDCOPYSTREAM POINTER)))
(DATATYPE LAFITEMSG ((PARSED? FLAG)
(DELETED? FLAG)
(SEEN? FLAG)
(DATEKNOWN? FLAG)
(DATEFETCHED? FLAG)
(MODEBITS BITS 3)
(MARKCHAR BYTE)
(%# WORD)
(BEGIN POINTER)
(MESSAGELENGTH POINTER)
(STAMPLENGTH WORD)
(TOCLENGTH WORD)
(MESSAGELENGTHCHANGED? FLAG)
(SELECTED? FLAG)
(MSGFROMMECHECKED? FLAG)
(MSGFROMMETRUTH FLAG)
(DATE POINTER)
(NIL FLAG)
(MARKSCHANGEDINFILE? FLAG)
(MARKSCHANGEDINTOC? FLAG)
(NIL FLAG)
(FROM POINTER)
(SUBJECT POINTER)
(TO POINTER)
(IDATE FIXP)))
(DELETED? FLAG)
(SEEN? FLAG)
(DATEKNOWN? FLAG)
(DATEFETCHED? FLAG)
(MODEBITS BITS 3)
(MARKCHAR BYTE)
(%# WORD)
(BEGIN POINTER)
(MESSAGELENGTH POINTER)
(STAMPLENGTH WORD)
(TOCLENGTH WORD)
(MESSAGELENGTHCHANGED? FLAG)
(SELECTED? FLAG)
(MSGFROMMECHECKED? FLAG)
(MSGFROMMETRUTH FLAG)
(DATE POINTER)
(NIL FLAG)
(MARKSCHANGEDINFILE? FLAG)
(MARKSCHANGEDINTOC? FLAG)
(NIL FLAG)
(FROM POINTER)
(SUBJECT POINTER)
(TO POINTER)
(IDATE FIXP)))
)
(DEFINEQ
@@ -827,8 +847,11 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(FILESLOAD LAFITEBROWSE LAFITECOMMANDS LAFITEFOLDERS LAFITESEND LAFITEMAIL LAFITESORT TEDIT
LAFITETEDIT LAFITEFIND ATTACHEDWINDOW MAILSCAVENGE)
(FILESLOAD TEDIT ATTACHEDWINDOW)
(FILESLOAD LAFITE-BROWSE LAFITE-COMMANDS LAFITE-FOLDERS LAFITE-SEND LAFITE-MAIL LAFITE-SORT
LAFITE-TEDIT LAFITE-FIND LAFITE-MAILSCAVENGE)
(CL:PROCLAIM '(GLOBAL ANSWERMARK BROWSERMARKXPOSITION DEFAULTMAILFOLDERNAME
@@ -864,7 +887,7 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
((EQ MAKESYSNAME :LYRIC)
(FILESLOAD (SYSLOAD)
NSCHARPATCH) (* ;
 "Patch to horrid Lyric NS chars bug")
 "Patch to horrid Lyric NS chars bug")
(MOVD? 'PROMPTFORWORD 'TTYINPROMPTFORWORD NIL T)))
)
(DECLARE%: DOEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
@@ -875,31 +898,29 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
(ADDTOVAR LAMA LAFITE)
)
(PUTPROPS LAFITE COPYRIGHT ("Xerox Corporation and Bolt Beranek and Newman Inc." 1982 1983 1984 1985
1986 1987 1988 1989 1993 1994 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (7104 22150 (LAFITE 7114 . 8425) (LAFITE.ON.FROM.BACKGROUND 8427 . 8798) (\LAFITE.OFF
8800 . 9184) (\LAFITE.START.PROC 9186 . 10962) (LAFITE.COMPUTE.CACHED.VARS 10964 . 13666) (
\LAFITE.PROCESS 13668 . 14034) (\LAFITE.START.ABORT 14036 . 14228) (\LAFITE.QUIT 14230 . 14472) (
\LAFITE.RESTART 14474 . 14607) (\LAFITE.SUBQUIT 14609 . 15907) (\LAFITE.QUIT.PROC 15909 . 18645) (
\LAFITEDEFAULTHOST&DIR 18647 . 19457) (LAFITEDEFAULTHOST&DIR 19459 . 19629) (MAKELAFITECOMMANDWINDOW
19631 . 21270) (EXTRACTMENUCOMMAND 21272 . 21520) (DOMAINLAFITECOMMAND 21522 . 21671) (
LAFITE.TOGGLE.SERVER.TRACE 21673 . 22148)) (22225 25193 (LAFITEMODE 22235 . 22715) (\LAFITE.INFER.MODE
22717 . 23070) (\LAFITE.SHOW.MODE 23072 . 23309) (\LAFITE.MODE.TITLE 23311 . 23596) (
LAFITE.SHOW.MODE.P 23598 . 23839) (LAFITE.ALL.MODES.P 23841 . 24184) (SET.LAFITE.MODE.INTERACTIVELY
24186 . 24768) (\LAFITE.COMPUTE.MODE.COMMANDS 24770 . 25191)) (26043 27799 (\LAFITE.LOGIN 26053 .
26435) (\LAFITE.LOGIN.NORESTART 26437 . 26543) (LAFITE.PROMPT.FOR.LOGIN 26545 . 27564) (
\LAFITE.REAUTHENTICATE 27566 . 27797)) (35310 38752 (LAFITE.AROUNDEXIT 35320 . 35858) (
\LAFITE.MARK.FOLDERS.OBSOLETE 35860 . 36776) (\LAFITE.CHECK.FOLDERS 36778 . 37177) (
\LAFITE.ASSURE.FOLDER.READY 37179 . 37589) (\LAFITE.AFTERLOGIN 37591 . 38750)) (38784 41722 (
LA.RESETSHADE 38794 . 39172) (LA.MENU.ITEM 39174 . 39592) (NTHMESSAGE 39594 . 39677) (
\LAFITE.MAKE.MSGARRAY 39679 . 40109) (\LAFITE.ADDMESSAGES.TO.ARRAY 40111 . 40692) (
\MAILFOLDER.DEFPRINT 40694 . 40941) (\LAFITEMSG.DEFPRINT 40943 . 41105) (LA.POSITION.FROM.REGION 41107
. 41584) (MAILFOLDERBUSY 41586 . 41720)) (41900 58288 (TOCFILENAME 41910 . 42341) (DELETEMAILFOLDER
42343 . 42863) (\LAFITE.OPEN.FOLDER 42865 . 47480) (\LAFITE.REPORT.FILE.WONT.OPEN 47482 . 48206) (
\LAFITE.FOLDER.CHANGED 48208 . 50612) (\LAFITE.REBROWSE.FOLDER 50614 . 53579) (
\LAFITE.FOLDER.CHANGED.MENU 53581 . 54504) (\LAFITE.SET.FOLDER.STREAM 54506 . 55200) (
\LAFITE.OPENSTREAM 55202 . 55741) (\LAFITE.CREATE.MENU 55743 . 56096) (\LAFITE.EOF 56098 . 57440) (
\LAFITE.CLOSE.FOLDER 57442 . 58286)) (58289 58873 (\LAFITE.DESCRIBE.FOLDER 58299 . 58871)) (58934
60040 (LOAD-LAFITE 58944 . 60038)) (67751 69028 (\LAFITE.GLOBAL.INIT 67761 . 69026)))))
(FILEMAP (NIL (6983 22029 (LAFITE 6993 . 8304) (LAFITE.ON.FROM.BACKGROUND 8306 . 8677) (\LAFITE.OFF
8679 . 9063) (\LAFITE.START.PROC 9065 . 10841) (LAFITE.COMPUTE.CACHED.VARS 10843 . 13545) (
\LAFITE.PROCESS 13547 . 13913) (\LAFITE.START.ABORT 13915 . 14107) (\LAFITE.QUIT 14109 . 14351) (
\LAFITE.RESTART 14353 . 14486) (\LAFITE.SUBQUIT 14488 . 15786) (\LAFITE.QUIT.PROC 15788 . 18524) (
\LAFITEDEFAULTHOST&DIR 18526 . 19336) (LAFITEDEFAULTHOST&DIR 19338 . 19508) (MAKELAFITECOMMANDWINDOW
19510 . 21149) (EXTRACTMENUCOMMAND 21151 . 21399) (DOMAINLAFITECOMMAND 21401 . 21550) (
LAFITE.TOGGLE.SERVER.TRACE 21552 . 22027)) (22104 25072 (LAFITEMODE 22114 . 22594) (\LAFITE.INFER.MODE
22596 . 22949) (\LAFITE.SHOW.MODE 22951 . 23188) (\LAFITE.MODE.TITLE 23190 . 23475) (
LAFITE.SHOW.MODE.P 23477 . 23718) (LAFITE.ALL.MODES.P 23720 . 24063) (SET.LAFITE.MODE.INTERACTIVELY
24065 . 24647) (\LAFITE.COMPUTE.MODE.COMMANDS 24649 . 25070)) (25922 27678 (\LAFITE.LOGIN 25932 .
26314) (\LAFITE.LOGIN.NORESTART 26316 . 26422) (LAFITE.PROMPT.FOR.LOGIN 26424 . 27443) (
\LAFITE.REAUTHENTICATE 27445 . 27676)) (35157 38599 (LAFITE.AROUNDEXIT 35167 . 35705) (
\LAFITE.MARK.FOLDERS.OBSOLETE 35707 . 36623) (\LAFITE.CHECK.FOLDERS 36625 . 37024) (
\LAFITE.ASSURE.FOLDER.READY 37026 . 37436) (\LAFITE.AFTERLOGIN 37438 . 38597)) (38631 41569 (
LA.RESETSHADE 38641 . 39019) (LA.MENU.ITEM 39021 . 39439) (NTHMESSAGE 39441 . 39524) (
\LAFITE.MAKE.MSGARRAY 39526 . 39956) (\LAFITE.ADDMESSAGES.TO.ARRAY 39958 . 40539) (
\MAILFOLDER.DEFPRINT 40541 . 40788) (\LAFITEMSG.DEFPRINT 40790 . 40952) (LA.POSITION.FROM.REGION 40954
. 41431) (MAILFOLDERBUSY 41433 . 41567)) (41747 58135 (TOCFILENAME 41757 . 42188) (DELETEMAILFOLDER
42190 . 42710) (\LAFITE.OPEN.FOLDER 42712 . 47327) (\LAFITE.REPORT.FILE.WONT.OPEN 47329 . 48053) (
\LAFITE.FOLDER.CHANGED 48055 . 50459) (\LAFITE.REBROWSE.FOLDER 50461 . 53426) (
\LAFITE.FOLDER.CHANGED.MENU 53428 . 54351) (\LAFITE.SET.FOLDER.STREAM 54353 . 55047) (
\LAFITE.OPENSTREAM 55049 . 55588) (\LAFITE.CREATE.MENU 55590 . 55943) (\LAFITE.EOF 55945 . 57287) (
\LAFITE.CLOSE.FOLDER 57289 . 58133)) (58136 58720 (\LAFITE.DESCRIBE.FOLDER 58146 . 58718)) (58781
60618 (LOAD-LAFITE 58791 . 60616)) (68059 69336 (\LAFITE.GLOBAL.INIT 68069 . 69334)))))
STOP

67
library/lafite/LAFITEABBREV → library/lafite/LAFITE-ABBREV
View File

@@ -1,30 +1,47 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "11-Nov-88 19:37:06" |{NEWTON:EUROPARC:RX}<LOVSTRAND>LISP>MEDLEY>LAFITEABBREV.;1| 5987
changes to%: (VARS LAFITEABBREVCOMS)
(FILECREATED "23-Feb-2024 23:14:08" {WMEDLEY}<library>lafite>LAFITE-ABBREV.;1 6164
previous date%: "22-Sep-88 13:06:40" |{NEWTON:EUROPARC:RX}<LOVSTRAND>LISP>LYRIC>LAFITEABBREV.;7|
)
:EDIT-BY rmk
:PREVIOUS-DATE "11-Nov-88 19:37:06" {WMEDLEY}<library>lafite>LAFITEABBREV.;1)
(* "
Copyright (c) 1988, 1901 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT LAFITE-ABBREVCOMS)
(PRETTYCOMPRINT LAFITEABBREVCOMS)
(RPAQQ LAFITE-ABBREVCOMS
((APPENDVARS (LAFITE.ABBREVS ("*@*:*" "*@*:*" :OUT)
("*@*" "%"*%%*%":GV:Xerox" :IN)
("*@*" "*%%*:GV:Xerox")
("*@*.*" "*%%*:*:Xerox" :IN)
("*.pa" "*:PA:Xerox")))
(INITVARS (LAFITE.ABBREV.DIRECTIONS :BOTH)
(LAFITE.ABBREV.MOVE.GAZE.RIGHT T)
(LAFITE.ABBREV.TRACE))
(FUNCTIONS SAFEUPPERCHARCODE)
(FNS LAFITE.ABBREV LAFITE.ABBREV.MATCH)
(ADVISE (NSNAME.TO.STRING :IN \NSMAIL.PRINT.NAMES)
(PARSE.NSNAME :IN \NSMAIL.PARSE1))
(GLOBALVARS LAFITE.ABBREVS LAFITE.ABBREV.DIRECTIONS LAFITE.ABBREV.MOVE.GAZE.RIGHT
LAFITE.ABBREV.TRACE)))
(RPAQQ LAFITEABBREVCOMS ((APPENDVARS (LAFITE.ABBREVS ("*@*:*" "*@*:*" :OUT) ("*@*" "%"*%%*%":GV:Xerox" :IN) ("*@*" "*%%*:GV:Xerox") ("*@*.*" "*%%*:*:Xerox" :IN) ("*.pa" "*:PA:Xerox"))) (INITVARS (LAFITE.ABBREV.DIRECTIONS :BOTH) (LAFITE.ABBREV.MOVE.GAZE.RIGHT T) (LAFITE.ABBREV.TRACE)) (FUNCTIONS SAFEUPPERCHARCODE) (FNS LAFITE.ABBREV LAFITE.ABBREV.MATCH) (ADVISE (NSNAME.TO.STRING :IN \NSMAIL.PRINT.NAMES) (PARSE.NSNAME :IN \NSMAIL.PARSE1)) (GLOBALVARS LAFITE.ABBREVS LAFITE.ABBREV.DIRECTIONS LAFITE.ABBREV.MOVE.GAZE.RIGHT LAFITE.ABBREV.TRACE)))
(APPENDTOVAR LAFITE.ABBREVS ("*@*:*" "*@*:*" :OUT)
("*@*" "%"*%%*%":GV:Xerox" :IN)
("*@*" "*%%*:GV:Xerox")
("*@*.*" "*%%*:*:Xerox" :IN)
("*.pa" "*:PA:Xerox"))
(APPENDTOVAR LAFITE.ABBREVS ("*@*:*" "*@*:*" :OUT) ("*@*" "%"*%%*%":GV:Xerox" :IN) ("*@*" "*%%*:GV:Xerox")
("*@*.*" "*%%*:*:Xerox" :IN) ("*.pa" "*:PA:Xerox"))
(RPAQ? LAFITE.ABBREV.DIRECTIONS :BOTH)
(RPAQ? LAFITE.ABBREV.DIRECTIONS :BOTH)
(RPAQ? LAFITE.ABBREV.MOVE.GAZE.RIGHT T)
(RPAQ? LAFITE.ABBREV.MOVE.GAZE.RIGHT T)
(RPAQ? LAFITE.ABBREV.TRACE )
(RPAQ? LAFITE.ABBREV.TRACE)
(DEFMACRO SAFEUPPERCHARCODE (CODE) (BQUOTE (if (AND (NUMBERP (\, CODE)) (LEQ (\, CODE) 255)) THEN (GETCASEARRAY UPPERCASEARRAY (\, CODE)) ELSE (\, CODE))))
(DEFMACRO SAFEUPPERCHARCODE (CODE)
`(if (AND (NUMBERP ,CODE)
(LEQ ,CODE 255))
THEN (GETCASEARRAY UPPERCASEARRAY ,CODE)
ELSE ,CODE))
(DEFINEQ
(LAFITE.ABBREV
@@ -36,16 +53,22 @@ Copyright (c) 1988, 1901 by Xerox Corporation. All rights reserved.
)
)
(XCL:REINSTALL-ADVICE (QUOTE (NSNAME.TO.STRING :IN \NSMAIL.PRINT.NAMES)) :AFTER (QUOTE ((:LAST (SETQ !VALUE (LAFITE.ABBREV !VALUE :IN))))))
[XCL:REINSTALL-ADVICE '(NSNAME.TO.STRING :IN \NSMAIL.PRINT.NAMES)
:AFTER
'((:LAST (SETQ !VALUE (LAFITE.ABBREV !VALUE :IN]
(XCL:REINSTALL-ADVICE (QUOTE (PARSE.NSNAME :IN \NSMAIL.PARSE1)) :BEFORE (QUOTE ((:LAST (SETQ NAME (LAFITE.ABBREV NAME :OUT))))))
[XCL:REINSTALL-ADVICE '(PARSE.NSNAME :IN \NSMAIL.PARSE1)
:BEFORE
'((:LAST (SETQ NAME (LAFITE.ABBREV NAME :OUT]
(READVISE (NSNAME.TO.STRING :IN \NSMAIL.PRINT.NAMES) (PARSE.NSNAME :IN \NSMAIL.PARSE1))
(READVISE (NSNAME.TO.STRING :IN \NSMAIL.PRINT.NAMES)
(PARSE.NSNAME :IN \NSMAIL.PARSE1))
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS LAFITE.ABBREVS LAFITE.ABBREV.DIRECTIONS LAFITE.ABBREV.MOVE.GAZE.RIGHT LAFITE.ABBREV.TRACE)
(GLOBALVARS LAFITE.ABBREVS LAFITE.ABBREV.DIRECTIONS LAFITE.ABBREV.MOVE.GAZE.RIGHT LAFITE.ABBREV.TRACE
)
)
(PUTPROPS LAFITEABBREV COPYRIGHT ("Xerox Corporation" 1988 1901))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1425 5397 (LAFITE.ABBREV 1435 . 3321) (LAFITE.ABBREV.MATCH 3323 . 5395)))))
(FILEMAP (NIL (1475 1652 (SAFEUPPERCHARCODE 1475 . 1652)) (1653 5625 (LAFITE.ABBREV 1663 . 3549) (
LAFITE.ABBREV.MATCH 3551 . 5623)))))
STOP

0
library/lafite/LAFITEABBREV.TEDIT → library/lafite/LAFITE-ABBREV.TEDIT
View File

120
library/lafite/LAFITEBROWSE → library/lafite/LAFITE-BROWSE
View File

@@ -1,18 +1,17 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "30-Sep-2021 22:58:57" 
{DSK}<USERS>KAPLAN>LOCAL>MEDLEY3.5>GIT-MEDLEY>LIBRARY>LAFITE>LAFITEBROWSE.;1 141883
previous date%: "19-Feb-2001 09:26:50"
{DSK}<USERS>KAPLAN>LOCAL>MEDLEY3.5>GIT-MEDLEY>LIBRARY>LAFITE>LAFITEBROWSE.;1)
(FILECREATED "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-BROWSE.;2 141738
:EDIT-BY rmk
:CHANGES-TO (VARS LAFITE-BROWSECOMS)
:PREVIOUS-DATE "23-Feb-2024 21:54:27" {WMEDLEY}<library>lafite>LAFITE-BROWSE.;1)
(* ; "
Copyright (c) 1984-1989, 1999, 2001, 2021 by Xerox Corporation.
")
(PRETTYCOMPRINT LAFITE-BROWSECOMS)
(PRETTYCOMPRINT LAFITEBROWSECOMS)
(RPAQQ LAFITEBROWSECOMS
(RPAQQ LAFITE-BROWSECOMS
[(COMS (* ; "BROWSE")
(FNS \LAFITE.BROWSE \LAFITE.SUBBROWSE \LAFITE.BROWSE.PROC \LAFITE.BROWSE.FORGET
LAFITE.BROWSE.FOLDER \LAFITE.PREPARE.BROWSER \LAFITE.MAYBE.OPEN.FOLDER
@@ -78,7 +77,7 @@ Copyright (c) 1984-1989, 1999, 2001, 2021 by Xerox Corporation.
(DECLARE%: DOEVAL@COMPILE DONTCOPY (CONSTANTS * TOCSTATES)
[P (CL:PROCLAIM '(CL:SPECIAL \CURRENTDISPLAYLINE]
(FILES (SOURCE)
LAFITEDECLS)
LAFITE-DECLS)
(LOCALVARS . T))
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
@@ -93,12 +92,13 @@ Copyright (c) 1984-1989, 1999, 2001, 2021 by Xerox Corporation.
(DEFINEQ
(\LAFITE.BROWSE
[LAMBDA (ITEM MENU BUTTON) (* ; "Edited 17-Sep-87 19:13 by bvm:")
[LAMBDA (ITEM MENU BUTTON) (* ; "Edited 23-Feb-2024 21:53 by rmk")
(* ; "Edited 17-Sep-87 19:13 by bvm:")
(* ;;; "Function called by the Browse button on main Lafite window.")
(LET [(SUBP (EQ BUTTON 'MIDDLE] (* ;
 "Pass the :confirm option to LAFITE.BROWSE.FOLDER to require confirmation on folder creation.")
 "Pass the :confirm option to LAFITE.BROWSE.FOLDER to require confirmation on folder creation.")
(\LAFITE.PROCESS `[,(COND
(SUBP (FUNCTION \LAFITE.SUBBROWSE))
(T (FUNCTION \LAFITE.BROWSE.PROC)))
@@ -106,7 +106,7 @@ Copyright (c) 1984-1989, 1999, 2001, 2021 by Xerox Corporation.
',MENU
,@(AND (NOT SUBP)
'(NIL '(:CONFIRM]
'LAFITEBROWSE])
'LAFITE-BROWSE])
(\LAFITE.SUBBROWSE
[LAMBDA (ITEM MENU) (* ; "Edited 3-Sep-87 18:00 by bvm:")
@@ -633,8 +633,7 @@ Copyright (c) 1984-1989, 1999, 2001, 2021 by Xerox Corporation.
MAINW])
)
(RPAQQ LAFITE.DUMMY.SHADE
#*(16 16)@L@HA@@FALD@@DJ@AHF@@@JDH@NFD@@EDD@EDJ@EDJD@@LD@@HD@@HDD@@DJ@@DL)
(RPAQQ LAFITE.DUMMY.SHADE #*(16 16)@L@HA@@FALD@@DJ@AHF@@@JDH@NFD@@EDD@EDJ@EDJD@@LD@@HD@@HDD@@DJ@@DL)
(RPAQQ LAFITE.DUMMY.HALF.SHADE
#*(16 16)@H@@A@@D@@D@@DB@A@D@@@HDH@DB@@@DDD@A@B@DDHD@@D@@@@D@@H@D@@DJ@@@@)
@@ -2134,8 +2133,8 @@ Copyright (c) 1984-1989, 1999, 2001, 2021 by Xerox Corporation.
)
(RPAQQ LAFITE.FOLDER.ICON (#*(100 72)@OOOOOOOO@@@@@@@@@@@@@@@@@@@AOOOOOOOOH@@@@@@@@@@@@@@@@@@C@@@@@@@@L@@@@@@@@@@@@@@@@@@F@@@@@@@@F@@@@@@@@@@@@@@@@@@L@DA@@@@@C@@@@@@@@@@@@@@@@@@L@FC@@@@@C@@@@@@@@@@@@@@@@@@L@EE@HGB@C@@@@@@@@@@@@@@@@@@L@EEADBB@C@@@@@@@@@@@@@@@@@@L@DIBBBB@COOOOOOOOOOOOOOL@@@L@DACNBB@COOOOOOOOOOOOOOL@@@L@DABBGCL@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@@@@@L@@@LOOOOOOOOOOOOOOOOOOOOOOOO@@@LOOOOOOOOOOOOOOOOOOOOOOOO@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@FL@@@@@@@@@@@@@@@@@@@@@@C@@@CL@@@@@@@@@@@@@@@@@@@@@@C@@@AOOOOOOOOOOOOOOOOOOOOOOOO@@@@OOOOOOOOOOOOOOOOOOOOOOOO@@@
#*(100 72)@OOOOOOOO@@@@@@@@@@@@@@@@@@@AOOOOOOOOH@@@@@@@@@@@@@@@@@@COOOOOOOOL@@@@@@@@@@@@@@@@@@GOOOOOOOON@@@@@@@@@@@@@@@@@@OOOOOOOOOO@@@@@@@@@@@@@@@@@@OOOOOOOOOO@@@@@@@@@@@@@@@@@@OOOOOOOOOO@@@@@@@@@@@@@@@@@@OOOOOOOOOO@@@@@@@@@@@@@@@@@@OOOOOOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@GOOOOOOOOOOOOOOOOOOOOOOOO@@@COOOOOOOOOOOOOOOOOOOOOOOO@@@AOOOOOOOOOOOOOOOOOOOOOOOO@@@@OOOOOOOOOOOOOOOOOOOOOOOO@@@
(8 4 88 51)))
#*(100 72)@OOOOOOOO@@@@@@@@@@@@@@@@@@@AOOOOOOOOH@@@@@@@@@@@@@@@@@@COOOOOOOOL@@@@@@@@@@@@@@@@@@GOOOOOOOON@@@@@@@@@@@@@@@@@@OOOOOOOOOO@@@@@@@@@@@@@@@@@@OOOOOOOOOO@@@@@@@@@@@@@@@@@@OOOOOOOOOO@@@@@@@@@@@@@@@@@@OOOOOOOOOO@@@@@@@@@@@@@@@@@@OOOOOOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@GOOOOOOOOOOOOOOOOOOOOOOOO@@@COOOOOOOOOOOOOOOOOOOOOOOO@@@AOOOOOOOOOOOOOOOOOOOOOOOO@@@@OOOOOOOOOOOOOOOOOOOOOOOO@@@
(8 4 88 51)))
(RPAQ? LAFITEFROMFRACTION 0.3)
@@ -2191,7 +2190,7 @@ and delete the file(s) containing it."
"Specify which subgroups should also appear at top level."])
(RPAQQ LAFITEBROWSERICONMENUITEMS (("Get Mail" '\LAFITE.GETMAIL.FROM.ICON
"Open this window and retrieve new mail into it")))
"Open this window and retrieve new mail into it")))
(RPAQ? LAFITESUBBROWSEMENU )
@@ -2206,10 +2205,10 @@ and delete the file(s) containing it."
(ADDTOVAR LAFITEMENUVARS LAFITESUBBROWSEMENU LAFITEBROWSERICONMENU LAFITEEXTRAMENU)
(ADDTOVAR LAFITEEXTRAMENUITEMS ("Describe Folder" '\LAFITE.DESCRIBE.FOLDER
"Display some relevant info about this folder"
(SUBITEMS ("Inspect Folder" 'INSPECT
"Display some relevant info about this folder"
(SUBITEMS ("Inspect Folder" 'INSPECT
"Inspect the MAILFOLDER data structure associated with this browser"
))))
))))
(RPAQQ BROWSERMARKXPOSITION 8)
@@ -2224,13 +2223,13 @@ and delete the file(s) containing it."
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(RPAQQ TOCSTATES ((TS.IDLE 0)
(TS.REPLACING 1)
(TS.ADDING 2)
(TS.REMOVING 3)
(TS.EXTENDING.HI 4)
(TS.EXTENDING.LO 5)
(TS.SHRINKING.HI 6)
(TS.SHRINKING.LO 7)))
(TS.REPLACING 1)
(TS.ADDING 2)
(TS.REMOVING 3)
(TS.EXTENDING.HI 4)
(TS.EXTENDING.LO 5)
(TS.SHRINKING.HI 6)
(TS.SHRINKING.LO 7)))
(DECLARE%: EVAL@COMPILE
(RPAQQ TS.IDLE 0)
@@ -2265,7 +2264,7 @@ and delete the file(s) containing it."
(FILESLOAD (SOURCE)
LAFITEDECLS)
LAFITE-DECLS)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
@@ -2280,36 +2279,35 @@ and delete the file(s) containing it."
(ADDTOVAR LAMA LAB.MOUSECONFIRM LAB.FORMAT LAB.PROMPTPRINT)
)
(PUTPROPS LAFITEBROWSE COPYRIGHT ("Xerox Corporation" 1984 1985 1986 1987 1988 1989 1999 2001 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (5768 31473 (\LAFITE.BROWSE 5778 . 6525) (\LAFITE.SUBBROWSE 6527 . 6864) (
\LAFITE.BROWSE.PROC 6866 . 7959) (\LAFITE.BROWSE.FORGET 7961 . 8507) (LAFITE.BROWSE.FOLDER 8509 .
10444) (\LAFITE.PREPARE.BROWSER 10446 . 12612) (\LAFITE.MAYBE.OPEN.FOLDER 12614 . 16056) (
LAB.LOADFOLDER 16058 . 16553) (LAB.DISPLAYFOLDER 16555 . 18126) (LAB.MAKE.INITIAL.SELECTION 18128 .
19364) (LAB.CREATEWINDOW 19366 . 27821) (LAB.TITLE.STRING 27823 . 29588) (LAB.COMMANDFN 29590 . 30120)
(LAB.DO.COMMAND 30122 . 31099) (LAB.ASSURE.SELECTIONS 31101 . 31471)) (31474 41387 (
BUILD.LAFITE.LAYOUTS 31484 . 37742) (\LAFITE.LAYOUT.FROM.WINDOW 37744 . 40224) (
\LAFITE.MAKE.DUMMY.WINDOWS 40226 . 41385)) (41813 67265 (LAB.SETUP 41823 . 48008) (LAB.BUTTONEVENTFN
48010 . 48540) (LAB.DO.UNLESS.BUSY 48542 . 49038) (LOADMAILFOLDER 49040 . 50323) (LAFITE.OBTAIN.FOLDER
50325 . 59227) (\LAFITE.FIND.EXISTING.FOLDER 59229 . 60076) (\LAFITE.CONFLICTING.OLD.FOLDER 60078 .
61249) (LAB.REPAINTFN 61251 . 61876) (LAB.SCROLLFN 61878 . 62466) (LAB.RESHAPEFN 62468 . 63761) (
LAB.CLOSEFN 63763 . 63932) (LAB.SHRINKFN 63934 . 64098) (LAB.CLOSE/SHRINK 64100 . 65685) (LAB.EXPANDFN
65687 . 66931) (LAFITEEXTRABROWSERCOMMANDFN 66933 . 67263)) (67300 85005 (LAB.SELECTMESSAGE 67310 .
80668) (LAB.CHANGEMARK 80670 . 82271) (LA.READ.NEW.MARK 82273 . 84056) (YPOS.TO.MESSAGE# 84058 . 84666
) (MESSAGE#.TO.YPOS 84668 . 85003)) (85006 93673 (LA.CONSIDERRANGE 85016 . 85700) (LA.DECONSIDERRANGE
85702 . 86118) (LA.RECONSIDERRANGE 86120 . 86824) (LA.SELECTRANGE 86826 . 88162) (LA.DESELECTRANGE
88164 . 90242) (LAB.FIND.SELECTED.MSG 90244 . 90621) (LAB.REV.FIND.SELECTED.MSG 90623 . 91108) (
LA.UNDOSELECTION 91110 . 91404) (LA.VERIFY.SELECTION 91406 . 93671)) (93674 100537 (
LAB.COPYBUTTONEVENTFN 93684 . 98889) (LAB.SHOW.COPY.SELECTION 98891 . 100535)) (100744 108238 (
LAB.PROMPTPRINT 100754 . 100933) (LAB.FORMAT 100935 . 101372) (LAB.MOUSECONFIRM 101374 . 101837) (
LAB.PRINT.TO.PROMPTWINDOW 101839 . 104988) (LAB.PAGEFULLFN 104990 . 106042) (
\LAFITE.MAYBE.CLEAR.PROMPT 106044 . 108236)) (108462 129133 (PRINTMESSAGESUMMARY 108472 . 113229) (
FIRSTVISIBLEMESSAGE 113231 . 114251) (LASTVISIBLEMESSAGE 114253 . 115442) (LAB.DISPLAYLINES 115444 .
117686) (LAB.EXPOSEMESSAGE 117688 . 118795) (LAB.SELECTED.MESSAGES 118797 . 119059) (
UNSELECTALLMESSAGES 119061 . 119547) (SELECTMESSAGE 119549 . 119841) (LAB.GO.TO.MESSAGE 119843 .
121152) (MARKMESSAGE 121154 . 122201) (LAB.MARKS.CHANGED 122203 . 123010) (LA.SHOW.MARK 123012 .
123657) (LA.INVERT.MARK.BOX 123659 . 124228) (LA.BLT.MARK.BOX 124230 . 124736) (LA.SHOW.DELETION
124738 . 125642) (LA.SHOW.SELECTION 125644 . 126208) (SEENMESSAGE 126210 . 126996) (DELETEMESSAGE
126998 . 127406) (UNDELETEMESSAGE 127408 . 128287) (LAB.SET.EXPUNGEABILITY 128289 . 129131)) (129370
132578 (LAB.ICONFN 129380 . 131073) (LAB.ICON.BUTTONEVENTFN 131075 . 132576)))))
(FILEMAP (NIL (5688 31509 (\LAFITE.BROWSE 5698 . 6561) (\LAFITE.SUBBROWSE 6563 . 6900) (
\LAFITE.BROWSE.PROC 6902 . 7995) (\LAFITE.BROWSE.FORGET 7997 . 8543) (LAFITE.BROWSE.FOLDER 8545 .
10480) (\LAFITE.PREPARE.BROWSER 10482 . 12648) (\LAFITE.MAYBE.OPEN.FOLDER 12650 . 16092) (
LAB.LOADFOLDER 16094 . 16589) (LAB.DISPLAYFOLDER 16591 . 18162) (LAB.MAKE.INITIAL.SELECTION 18164 .
19400) (LAB.CREATEWINDOW 19402 . 27857) (LAB.TITLE.STRING 27859 . 29624) (LAB.COMMANDFN 29626 . 30156)
(LAB.DO.COMMAND 30158 . 31135) (LAB.ASSURE.SELECTIONS 31137 . 31507)) (31510 41423 (
BUILD.LAFITE.LAYOUTS 31520 . 37778) (\LAFITE.LAYOUT.FROM.WINDOW 37780 . 40260) (
\LAFITE.MAKE.DUMMY.WINDOWS 40262 . 41421)) (41820 67272 (LAB.SETUP 41830 . 48015) (LAB.BUTTONEVENTFN
48017 . 48547) (LAB.DO.UNLESS.BUSY 48549 . 49045) (LOADMAILFOLDER 49047 . 50330) (LAFITE.OBTAIN.FOLDER
50332 . 59234) (\LAFITE.FIND.EXISTING.FOLDER 59236 . 60083) (\LAFITE.CONFLICTING.OLD.FOLDER 60085 .
61256) (LAB.REPAINTFN 61258 . 61883) (LAB.SCROLLFN 61885 . 62473) (LAB.RESHAPEFN 62475 . 63768) (
LAB.CLOSEFN 63770 . 63939) (LAB.SHRINKFN 63941 . 64105) (LAB.CLOSE/SHRINK 64107 . 65692) (LAB.EXPANDFN
65694 . 66938) (LAFITEEXTRABROWSERCOMMANDFN 66940 . 67270)) (67307 85012 (LAB.SELECTMESSAGE 67317 .
80675) (LAB.CHANGEMARK 80677 . 82278) (LA.READ.NEW.MARK 82280 . 84063) (YPOS.TO.MESSAGE# 84065 . 84673
) (MESSAGE#.TO.YPOS 84675 . 85010)) (85013 93680 (LA.CONSIDERRANGE 85023 . 85707) (LA.DECONSIDERRANGE
85709 . 86125) (LA.RECONSIDERRANGE 86127 . 86831) (LA.SELECTRANGE 86833 . 88169) (LA.DESELECTRANGE
88171 . 90249) (LAB.FIND.SELECTED.MSG 90251 . 90628) (LAB.REV.FIND.SELECTED.MSG 90630 . 91115) (
LA.UNDOSELECTION 91117 . 91411) (LA.VERIFY.SELECTION 91413 . 93678)) (93681 100544 (
LAB.COPYBUTTONEVENTFN 93691 . 98896) (LAB.SHOW.COPY.SELECTION 98898 . 100542)) (100751 108245 (
LAB.PROMPTPRINT 100761 . 100940) (LAB.FORMAT 100942 . 101379) (LAB.MOUSECONFIRM 101381 . 101844) (
LAB.PRINT.TO.PROMPTWINDOW 101846 . 104995) (LAB.PAGEFULLFN 104997 . 106049) (
\LAFITE.MAYBE.CLEAR.PROMPT 106051 . 108243)) (108469 129140 (PRINTMESSAGESUMMARY 108479 . 113236) (
FIRSTVISIBLEMESSAGE 113238 . 114258) (LASTVISIBLEMESSAGE 114260 . 115449) (LAB.DISPLAYLINES 115451 .
117693) (LAB.EXPOSEMESSAGE 117695 . 118802) (LAB.SELECTED.MESSAGES 118804 . 119066) (
UNSELECTALLMESSAGES 119068 . 119554) (SELECTMESSAGE 119556 . 119848) (LAB.GO.TO.MESSAGE 119850 .
121159) (MARKMESSAGE 121161 . 122208) (LAB.MARKS.CHANGED 122210 . 123017) (LA.SHOW.MARK 123019 .
123664) (LA.INVERT.MARK.BOX 123666 . 124235) (LA.BLT.MARK.BOX 124237 . 124743) (LA.SHOW.DELETION
124745 . 125649) (LA.SHOW.SELECTION 125651 . 126215) (SEENMESSAGE 126217 . 127003) (DELETEMESSAGE
127005 . 127413) (UNDELETEMESSAGE 127415 . 128294) (LAB.SET.EXPUNGEABILITY 128296 . 129138)) (129377
132585 (LAB.ICONFN 129387 . 131080) (LAB.ICON.BUTTONEVENTFN 131082 . 132583)))))
STOP

BIN
library/lafite/LAFITEBROWSE.LCOM → library/lafite/LAFITE-BROWSE.LCOM
View File

Binary file not shown.

80
library/lafite/LAFITECOMMANDS → library/lafite/LAFITE-COMMANDS
View File

@@ -1,17 +1,17 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "14-Jan-2024 16:35:53" {WMEDLEY}<library>lafite>LAFITECOMMANDS.;3 164474
(FILECREATED "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-COMMANDS.;2 164484
:EDIT-BY rmk
:CHANGES-TO (FNS MESSAGEDISPLAYER)
:CHANGES-TO (VARS LAFITE-COMMANDSCOMS)
:PREVIOUS-DATE " 7-Feb-2022 12:04:09" {WMEDLEY}<library>lafite>LAFITECOMMANDS.;2)
:PREVIOUS-DATE "23-Feb-2024 21:58:18" {WMEDLEY}<library>lafite>LAFITE-COMMANDS.;1)
(PRETTYCOMPRINT LAFITECOMMANDSCOMS)
(PRETTYCOMPRINT LAFITE-COMMANDSCOMS)
(RPAQQ LAFITECOMMANDSCOMS
(RPAQQ LAFITE-COMMANDSCOMS
[
(* ;; "Handling of the main Lafite browser commands")
@@ -102,7 +102,7 @@
(COMS (* ; "Obsolete")
(INITVARS (LAFITEDISPLAYREGION (CREATEREGION 375 25 600 335]
(DECLARE%: DOEVAL@COMPILE DONTCOPY (FILES (SOURCE)
LAFITEDECLS)
LAFITE-DECLS)
(LOCALVARS . T))
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
@@ -2530,7 +2530,7 @@
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(FILESLOAD (SOURCE)
LAFITEDECLS)
LAFITE-DECLS)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
@@ -2546,37 +2546,37 @@
(ADDTOVAR LAMA LAFITE.HARDCOPY.MESSAGES)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (7734 27538 (\LAFITE.DISPLAY 7744 . 9449) (\LAFITE.DO.DISPLAY 9451 . 13616) (
SELECTMESSAGETODISPLAY 13618 . 15986) (MESSAGEDISPLAYER 15988 . 23540) (LA.COPY.MESSAGE.TEXT 23542 .
24296) (\LAFITE.CLOSE.DISPLAYWINDOWS 24298 . 25892) (\LAFITE.CLOSE.DISPLAYER 25894 . 27536)) (27539
36131 (\LAFITE.UNHIDE.HEADERS 27549 . 28639) (\LAFITE.HIDE.HEADERS 28641 . 29294) (
\LAFITE.REHIDE.HEADERS 29296 . 30332) (LAFITE.EAT.UNDESIRABLE.FIELD 30334 . 31093) (LAFITE.EAT.GVGV
31095 . 32256) (\LAFITE.HARDCOPY.FROM.DISPLAY 32258 . 35777) (LAFITE.HARDCOPY.TAB.WIDTH 35779 . 36129)
) (36132 44435 (\LAFITE.SET.LOOKS.FROM.MENU 36142 . 36319) (\LAFITE.SET.DEFAULT.LOOKS 36321 . 36512) (
\LAFITE.SET.FIXED.LOOKS 36514 . 36706) (LAFITE.SET.LOOKS 36708 . 41165) (LAFITE.SET.TAB.LOOKS 41167 .
41878) (LAFITE.SET.PARA.SEPARATION 41880 . 42088) (LAFITE.SET.LOWER.CASE 42090 . 42941) (
LAFITE.SUBSTITUTE.VP.EOL 42943 . 44433)) (46352 54680 (LAFITE.DELETE.MESSAGES 46362 . 47412) (
\LAFITE.DELETE 47414 . 48601) (DISPLAYAFTERDELETE 48603 . 53329) (\LAFITE.SELECT.NEXT 53331 . 53969) (
\LAFITE.UNDELETE 53971 . 54678)) (54702 69197 (LAFITE.MOVE.MESSAGES 54712 . 55359) (\COERCE.TO.MSGLST
55361 . 56119) (\LAFITE.MOVETO 56121 . 60065) (\LAFITE.COPYTO 60067 . 60483) (\LAFITE.MOVETO.PROC
60485 . 61755) (\LAFITE.MOVE.MESSAGES.INTERNAL 61757 . 69195)) (69223 77775 (\LAFITE.ENABLE.MOVE.MENU
69233 . 70275) (\LAFITE.ADD.TO.MOVE.MENU 70277 . 71293) (\LAFITE.UPDATE.MOVE.MENU 71295 . 75935) (
\LAFITE.RESTORE.MOVE.MENU 75937 . 76613) (\LAFITE.HANDLE.AUTO.MOVE 76615 . 77773)) (78631 96115 (
\LAFITE.UPDATE 78641 . 84274) (\LAFITE.EXPUNGE.PROC 84276 . 85081) (\LAFITE.UPDATE.PROC 85083 . 86166)
(\LAFITE.HARDCOPYONLY.PROC 86168 . 86610) (LAB.CHOOSE.UPDATE.MENU 86612 . 87393) (
LAB.CREATE.UPDATE.MENU 87395 . 89294) (LAB.UPDATE.NEEDED? 89296 . 90866) (\LAFITE.START.UPDATE 90868
. 91900) (LAB.START.COMMAND 91902 . 92752) (\LAFITE.FINISH.UPDATE 92754 . 95007) (
\LAFITE.CLOSE.OTHER.FOLDERS 95009 . 96113)) (96116 130910 (LAB.FLUSHWINDOW 96126 . 97805) (
LAB.APPENDMESSAGES 97807 . 100969) (\LAFITE.COMPACT.FOLDER 100971 . 105135) (\LAFITE.COMPACT.FOLDER1
105137 . 121176) (\LAFITE.COMPACT.FOLDER2 121178 . 125892) (\LAFITE.COMPACT.EXTRA 125894 . 128209) (
\LAFITE.INVALIDATE.TOC 128211 . 128904) (\LAFITE.RENAMEFILE 128906 . 129376) (SMART-RENAMEFILEP 129378
. 129938) (LA.OPENTEMPFILE 129940 . 130908)) (130911 144253 (\LAFITE.UPDATE.FOLDER 130921 . 132898) (
\LAFITE.UPDATE.CONTENTS 132900 . 133617) (\LAFITE.UPDATE.CONTENTS1 133619 . 138473) (WRITETOCENTRY
138475 . 141593) (WRITETOCMARKBYTES 141595 . 141837) (WRITEFOLDERMARKBYTES 141839 . 144251)) (144279
163254 (LAFITE.HARDCOPY.MESSAGES 144289 . 144749) (\LAFITE.HARDCOPY 144751 . 145086) (
\LAFITE.HARDCOPY.PROC 145088 . 148566) (\LAFITE.HARDCOPY.HEADERS 148568 . 153897) (
\LAFITE.MARK.HARDCOPIED 153899 . 155609) (\LAFITE.TRANSMIT.HARDCOPY 155611 . 157201) (
\LAFITE.HARDCOPY.BODIES 157203 . 158445) (\LAFITE.APPEND.MESSAGE.BODY 158447 . 160555) (
\LAFITE.DO.PENDING.HARDCOPY 160557 . 161632) (\LAFITE.CANCEL.HARDCOPY 161634 . 162350) (
\LAFITE.CLEAR.HARDCOPY.STATE 162352 . 163252)))))
(FILEMAP (NIL (7743 27547 (\LAFITE.DISPLAY 7753 . 9458) (\LAFITE.DO.DISPLAY 9460 . 13625) (
SELECTMESSAGETODISPLAY 13627 . 15995) (MESSAGEDISPLAYER 15997 . 23549) (LA.COPY.MESSAGE.TEXT 23551 .
24305) (\LAFITE.CLOSE.DISPLAYWINDOWS 24307 . 25901) (\LAFITE.CLOSE.DISPLAYER 25903 . 27545)) (27548
36140 (\LAFITE.UNHIDE.HEADERS 27558 . 28648) (\LAFITE.HIDE.HEADERS 28650 . 29303) (
\LAFITE.REHIDE.HEADERS 29305 . 30341) (LAFITE.EAT.UNDESIRABLE.FIELD 30343 . 31102) (LAFITE.EAT.GVGV
31104 . 32265) (\LAFITE.HARDCOPY.FROM.DISPLAY 32267 . 35786) (LAFITE.HARDCOPY.TAB.WIDTH 35788 . 36138)
) (36141 44444 (\LAFITE.SET.LOOKS.FROM.MENU 36151 . 36328) (\LAFITE.SET.DEFAULT.LOOKS 36330 . 36521) (
\LAFITE.SET.FIXED.LOOKS 36523 . 36715) (LAFITE.SET.LOOKS 36717 . 41174) (LAFITE.SET.TAB.LOOKS 41176 .
41887) (LAFITE.SET.PARA.SEPARATION 41889 . 42097) (LAFITE.SET.LOWER.CASE 42099 . 42950) (
LAFITE.SUBSTITUTE.VP.EOL 42952 . 44442)) (46361 54689 (LAFITE.DELETE.MESSAGES 46371 . 47421) (
\LAFITE.DELETE 47423 . 48610) (DISPLAYAFTERDELETE 48612 . 53338) (\LAFITE.SELECT.NEXT 53340 . 53978) (
\LAFITE.UNDELETE 53980 . 54687)) (54711 69206 (LAFITE.MOVE.MESSAGES 54721 . 55368) (\COERCE.TO.MSGLST
55370 . 56128) (\LAFITE.MOVETO 56130 . 60074) (\LAFITE.COPYTO 60076 . 60492) (\LAFITE.MOVETO.PROC
60494 . 61764) (\LAFITE.MOVE.MESSAGES.INTERNAL 61766 . 69204)) (69232 77784 (\LAFITE.ENABLE.MOVE.MENU
69242 . 70284) (\LAFITE.ADD.TO.MOVE.MENU 70286 . 71302) (\LAFITE.UPDATE.MOVE.MENU 71304 . 75944) (
\LAFITE.RESTORE.MOVE.MENU 75946 . 76622) (\LAFITE.HANDLE.AUTO.MOVE 76624 . 77782)) (78640 96124 (
\LAFITE.UPDATE 78650 . 84283) (\LAFITE.EXPUNGE.PROC 84285 . 85090) (\LAFITE.UPDATE.PROC 85092 . 86175)
(\LAFITE.HARDCOPYONLY.PROC 86177 . 86619) (LAB.CHOOSE.UPDATE.MENU 86621 . 87402) (
LAB.CREATE.UPDATE.MENU 87404 . 89303) (LAB.UPDATE.NEEDED? 89305 . 90875) (\LAFITE.START.UPDATE 90877
. 91909) (LAB.START.COMMAND 91911 . 92761) (\LAFITE.FINISH.UPDATE 92763 . 95016) (
\LAFITE.CLOSE.OTHER.FOLDERS 95018 . 96122)) (96125 130919 (LAB.FLUSHWINDOW 96135 . 97814) (
LAB.APPENDMESSAGES 97816 . 100978) (\LAFITE.COMPACT.FOLDER 100980 . 105144) (\LAFITE.COMPACT.FOLDER1
105146 . 121185) (\LAFITE.COMPACT.FOLDER2 121187 . 125901) (\LAFITE.COMPACT.EXTRA 125903 . 128218) (
\LAFITE.INVALIDATE.TOC 128220 . 128913) (\LAFITE.RENAMEFILE 128915 . 129385) (SMART-RENAMEFILEP 129387
. 129947) (LA.OPENTEMPFILE 129949 . 130917)) (130920 144262 (\LAFITE.UPDATE.FOLDER 130930 . 132907) (
\LAFITE.UPDATE.CONTENTS 132909 . 133626) (\LAFITE.UPDATE.CONTENTS1 133628 . 138482) (WRITETOCENTRY
138484 . 141602) (WRITETOCMARKBYTES 141604 . 141846) (WRITEFOLDERMARKBYTES 141848 . 144260)) (144288
163263 (LAFITE.HARDCOPY.MESSAGES 144298 . 144758) (\LAFITE.HARDCOPY 144760 . 145095) (
\LAFITE.HARDCOPY.PROC 145097 . 148575) (\LAFITE.HARDCOPY.HEADERS 148577 . 153906) (
\LAFITE.MARK.HARDCOPIED 153908 . 155618) (\LAFITE.TRANSMIT.HARDCOPY 155620 . 157210) (
\LAFITE.HARDCOPY.BODIES 157212 . 158454) (\LAFITE.APPEND.MESSAGE.BODY 158456 . 160564) (
\LAFITE.DO.PENDING.HARDCOPY 160566 . 161641) (\LAFITE.CANCEL.HARDCOPY 161643 . 162359) (
\LAFITE.CLEAR.HARDCOPY.STATE 162361 . 163261)))))
STOP

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

Binary file not shown.

527
library/lafite/LAFITEDECLS → library/lafite/LAFITE-DECLS
View File

@@ -1,260 +1,244 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "22-Aug-94 12:59:34" {DSK}<king>export>lispcore>lafite>parc-94>LAFITEDECLS.;2 37889
changes to%: (VARS LAFITEDECLSCOMS)
(RECORDS LAFITEMSG)
(FILECREATED "26-Feb-2024 20:14:22" {WMEDLEY}<library>lafite>LAFITE-DECLS.;5 35711
previous date%: "21-Jun-89 12:10:42" {DSK}<king>export>lispcore>lafite>parc-94>LAFITEDECLS.;1
)
:EDIT-BY rmk
:CHANGES-TO (VARS LAFITE.PROGRAMMER.ENTRIES)
:PREVIOUS-DATE "24-Feb-2024 12:01:11" {WMEDLEY}<library>lafite>LAFITE-DECLS.;4)
(* ; "
Copyright (c) 1985, 1986, 1987, 1988, 1989, 1994 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT LAFITE-DECLSCOMS)
(PRETTYCOMPRINT LAFITEDECLSCOMS)
(RPAQQ LAFITEDECLSCOMS ((RECORDS LAFITEOPS LAFITEMODEDATA LAFITEMSG MAILFOLDER FOLDERGROUP
DEFAULTHOST&DIR MAILSERVER MAILSERVEROPS OPENEDMAILBOX OUTBOX
PROFILEVAR)
(COMS (* ;
 "characteristics of standard Laurel messages")
(CONSTANTS (LAFITEBASICSTAMPLENGTH 19)
(LAFITESTAMPLENGTH 24)
(DELETEDFLAG (CHARCODE D))
(UNDELETEDFLAG (CHARCODE U))
(SEENFLAG (CHARCODE S))
(UNSEENFLAG (CHARCODE U))
(DUPLICATEMARK 128)))
(COMS (* ; "Stuff for table of contents")
(CONSTANTS LAFITETOCPASSWORD LAFITETOCHEADERLENGTH))
(COMS (* ;
 "Browser status values. %"Ready%" values have low bit 1.")
(CONSTANTS LAS.READY LAS.LOGGED.OUT)
(CONSTANTS LAS.PARSING LAS.FLUSHED LAS.OUT.OF.DATE))
(COMS (* ;
 "Bits for figuring out which menu to use on Update, etc.")
(CONSTANTS (\HARDCOPY.MENU.BIT 1)
(\UPDATE.MENU.BIT 2)
(\TOC.MENU.BIT 4)
(\EXPUNGE.MENU.BIT 8)
(\SORT.MENU.BIT 16)
(\EXPUNGE&SORT.MENU.BIT 32)
(\CLOSE.MENU.BIT 64)
(\SHRINK.MENU.BIT 128)))
(COMS (* ;
 "For iterating over the selected messages of a browser")
(I.S.OPRS SELECTEDIN))
(MACROS WORDIN FIXPIN WORDOUT FIXPOUT UCASECODE NTHMESSAGE .LAFITEMENU.
MAYBEVERIFYMSG UNSEENMARKP)
(COMS (GLOBALVARS * LAFITEGLOBALS)
[P (CL:PROCLAIM '(CL:SPECIAL *LAFITE-MODE-DATA*
*UPPER-CASE-FILE-NAMES* \#DISPLAYLINES]
(RPAQQ LAFITE-DECLSCOMS
((RECORDS LAFITEOPS LAFITEMODEDATA LAFITEMSG MAILFOLDER FOLDERGROUP DEFAULTHOST&DIR MAILSERVER
MAILSERVEROPS OPENEDMAILBOX OUTBOX PROFILEVAR)
(COMS (* ;
 "characteristics of standard Laurel messages")
(CONSTANTS (LAFITEBASICSTAMPLENGTH 19)
(LAFITESTAMPLENGTH 24)
(DELETEDFLAG (CHARCODE D))
(UNDELETEDFLAG (CHARCODE U))
(SEENFLAG (CHARCODE S))
(UNSEENFLAG (CHARCODE U))
(DUPLICATEMARK 128)))
(COMS (* ; "Stuff for table of contents")
(CONSTANTS LAFITETOCPASSWORD LAFITETOCHEADERLENGTH))
(COMS (* ;
 "Browser status values. %"Ready%" values have low bit 1.")
(CONSTANTS LAS.READY LAS.LOGGED.OUT)
(CONSTANTS LAS.PARSING LAS.FLUSHED LAS.OUT.OF.DATE))
(COMS (* ;
 "Bits for figuring out which menu to use on Update, etc.")
(CONSTANTS (\HARDCOPY.MENU.BIT 1)
(\UPDATE.MENU.BIT 2)
(\TOC.MENU.BIT 4)
(\EXPUNGE.MENU.BIT 8)
(\SORT.MENU.BIT 16)
(\EXPUNGE&SORT.MENU.BIT 32)
(\CLOSE.MENU.BIT 64)
(\SHRINK.MENU.BIT 128)))
(COMS (* ;
 "For iterating over the selected messages of a browser")
(I.S.OPRS SELECTEDIN))
(MACROS WORDIN FIXPIN WORDOUT FIXPOUT UCASECODE NTHMESSAGE .LAFITEMENU. MAYBEVERIFYMSG
UNSEENMARKP)
(COMS (GLOBALVARS * LAFITEGLOBALS)
[P (CL:PROCLAIM '(CL:SPECIAL *LAFITE-MODE-DATA* *UPPER-CASE-FILE-NAMES* \#DISPLAYLINES]
(* ;
 "LAFITE.PROCLAMATIONS are exported to user in file LAFITE--these are the documented variables")
(P * LAFITE.PROCLAMATIONS))
(COMS (* ;
 "For debugging with Masterscope, here are fns not called from code")
(VARS LAFITE.CALLED.FROM.LITERALS LAFITE.PROGRAMMER.ENTRIES)
(COMMANDS WHONOTLAFITE CHECKLAFITE))
(DECLARE%: DONTEVAL@COMPILE (TEMPLATES WINDOWPROP WINDOWADDPROP
WINDOWDELPROP PROCESSPROP TEXTPROP))))
 "LAFITE.PROCLAMATIONS are exported to user in file LAFITE--these are the documented variables")
(P * LAFITE.PROCLAMATIONS))
(COMS (* ;
 "For debugging with Masterscope, here are fns not called from code")
(VARS LAFITE.CALLED.FROM.LITERALS LAFITE.PROGRAMMER.ENTRIES)
(COMMANDS WHONOTLAFITE CHECKLAFITE))
(DECLARE%: DONTEVAL@COMPILE (TEMPLATES WINDOWPROP WINDOWADDPROP WINDOWDELPROP PROCESSPROP
TEXTPROP))))
(DECLARE%: EVAL@COMPILE
(RECORD LAFITEOPS (LAFITEMODE MODEINDEX SENDPARSER SENDER ANSWERER AUTHENTICATOR MESSAGEP
MESSAGE-FROM-SELFP LOGIN))
MESSAGE-FROM-SELFP LOGIN))
(RECORD LAFITEMODEDATA (LAFITEOPS (FULLUSERNAME CREDENTIALS UNPACKEDUSERNAME SHORTUSERNAME
FROMFIELD)
MAILSERVERS))
(RECORD LAFITEMODEDATA (LAFITEOPS (FULLUSERNAME CREDENTIALS UNPACKEDUSERNAME SHORTUSERNAME FROMFIELD)
MAILSERVERS))
(DATATYPE LAFITEMSG ((PARSED? FLAG) (* ;
 "True if we have parsed the message, and thus filled in the fields DATE, FROM, SUBJECT below.")
(DELETED? FLAG) (* ;
 "True if message marked for deletion")
(SEEN? FLAG) (* ; "True if message is examined.")
(DATEKNOWN? FLAG) (* ;
 "True if DATE field correctly parsed into IDATE [formerly formatted? flag]")
(DATEFETCHED? FLAG) (* ;
 "True if IDATE field contains a date (could be guess)")
(MODEBITS BITS 3) (* ;
 "Mode in which the message was received")
(MARKCHAR BYTE) (* ; "Arbitrary mark byte")
(%# WORD) (* ; "Ordinal number of message")
(BEGIN POINTER) (* ; "Start of the whole message")
(MESSAGELENGTH POINTER) (* ; "Lengfth of whole message")
(STAMPLENGTH WORD) (* ;
 "Number of bytes in file header (usually 24)")
(TOCLENGTH WORD) (* ;
 "Number of bytes this message consumes on toc")
(MESSAGELENGTHCHANGED? FLAG) (* ;
"True if we have decided that the true length of this message is different from what the file says")
(SELECTED? FLAG) (* ; "True if msg currently selected")
(MSGFROMMECHECKED? FLAG) (* ;
 "True if we have tested whether this message is from self")
(MSGFROMMETRUTH FLAG) (* ; "Is it?")
(DATE POINTER) (* ;
 "The fields of the parse (strings)")
(NIL FLAG)
(MARKSCHANGEDINFILE? FLAG)
(MARKSCHANGEDINTOC? FLAG)
(NIL FLAG)
(FROM POINTER)
(SUBJECT POINTER)
(TO POINTER)
(IDATE FIXP) (* ;
 "Integer form of DATE (for sorting)")
)
(DATATYPE LAFITEMSG ((PARSED? FLAG) (* ;
 "True if we have parsed the message, and thus filled in the fields DATE, FROM, SUBJECT below.")
(DELETED? FLAG) (* ;
 "True if message marked for deletion")
(SEEN? FLAG) (* ; "True if message is examined.")
(DATEKNOWN? FLAG) (* ;
 "True if DATE field correctly parsed into IDATE [formerly formatted? flag]")
(DATEFETCHED? FLAG) (* ;
 "True if IDATE field contains a date (could be guess)")
(MODEBITS BITS 3) (* ;
 "Mode in which the message was received")
(MARKCHAR BYTE) (* ; "Arbitrary mark byte")
(%# WORD) (* ; "Ordinal number of message")
(BEGIN POINTER) (* ; "Start of the whole message")
(MESSAGELENGTH POINTER) (* ; "Lengfth of whole message")
(STAMPLENGTH WORD) (* ;
 "Number of bytes in file header (usually 24)")
(TOCLENGTH WORD) (* ;
 "Number of bytes this message consumes on toc")
(MESSAGELENGTHCHANGED? FLAG) (* ;
 "True if we have decided that the true length of this message is different from what the file says")
(SELECTED? FLAG) (* ; "True if msg currently selected")
(MSGFROMMECHECKED? FLAG) (* ;
 "True if we have tested whether this message is from self")
(MSGFROMMETRUTH FLAG) (* ; "Is it?")
(DATE POINTER) (* ; "The fields of the parse (strings)")
(NIL FLAG)
(MARKSCHANGEDINFILE? FLAG)
(MARKSCHANGEDINTOC? FLAG)
(NIL FLAG)
(FROM POINTER)
(SUBJECT POINTER)
(TO POINTER)
(IDATE FIXP) (* ;
 "Integer form of DATE (for sorting)")
)
(* ;; "BEGIN is the only absolute pointer into the message file -- all other positions are relative to BEGIN -- see the ACCESSFNS")
(* ;; "BEGIN is the only absolute pointer into the message file -- all other positions are relative to BEGIN -- see the ACCESSFNS")
(BLOCKRECORD LAFITEMSG ((PARSED&DELETED&SEENBITS BITS 3)
(BLOCKRECORD LAFITEMSG ((PARSED&DELETED&SEENBITS BITS 3)
(* ; "For toc version 8")
(DATEBITS BITS 2)
(* ; "For toc version 10")
(NIL BITS 3)
(NIL BYTE)
(NIL WORD)))
(BLOCKRECORD LAFITEMSG ((MSGFLAGBITS BITS 8)
(NIL BYTE)
(NIL WORD)
(NIL BITS 4)
(NIL POINTER)
(NIL BITS 4)
(NIL POINTER)
(NIL WORD)
(NIL WORD)
(NIL BITS 4)
(NIL POINTER)
(NIL BITS 1)
(MARKSCHANGEDBITS BITS 2)
(NIL BITS 1)
(NIL 3 POINTER)
(IDATEHI WORD)
(IDATELO WORD)))
[ACCESSFNS LAFITEMSG ((END (+ (fetch (LAFITEMSG MESSAGELENGTH)
of DATUM)
(fetch (LAFITEMSG BEGIN) of DATUM)))
(START (+ (fetch (LAFITEMSG BEGIN) of DATUM)
(fetch (LAFITEMSG STAMPLENGTH)
of DATUM)))
(MSGFROMMEP (COND
((fetch (LAFITEMSG MSGFROMMECHECKED?
) of DATUM)
(fetch (LAFITEMSG MSGFROMMETRUTH)
of DATUM))
(T (LA.MSGFROMMEP DATUM)))
(PROG1 (replace (LAFITEMSG MSGFROMMETRUTH)
of DATUM with NEWVALUE)
(replace (LAFITEMSG MSGFROMMECHECKED?)
of DATUM with T)))
(MARKSCHANGED? (NEQ 0 (fetch (LAFITEMSG
MARKSCHANGEDBITS
) of DATUM)
)
(replace (LAFITEMSG MARKSCHANGEDBITS)
of DATUM with 3))
(MODE (CL:NTH (fetch (LAFITEMSG MODEBITS)
of DATUM)
*LAFITE-WELL-KNOWN-MODES*)
(replace (LAFITEMSG MODEBITS) of DATUM
WITH (OR (CL:POSITION NEWVALUE
*LAFITE-WELL-KNOWN-MODES*)
0])
(DATEBITS BITS 2)(* ; "For toc version 10")
(NIL BITS 3)
(NIL BYTE)
(NIL WORD)))
(BLOCKRECORD LAFITEMSG ((MSGFLAGBITS BITS 8)
(NIL BYTE)
(NIL WORD)
(NIL BITS 4)
(NIL POINTER)
(NIL BITS 4)
(NIL POINTER)
(NIL WORD)
(NIL WORD)
(NIL BITS 4)
(NIL POINTER)
(NIL BITS 1)
(MARKSCHANGEDBITS BITS 2)
(NIL BITS 1)
(NIL 3 POINTER)
(IDATEHI WORD)
(IDATELO WORD)))
[ACCESSFNS LAFITEMSG ((END (+ (fetch (LAFITEMSG MESSAGELENGTH) of DATUM)
(fetch (LAFITEMSG BEGIN) of DATUM)))
(START (+ (fetch (LAFITEMSG BEGIN) of DATUM)
(fetch (LAFITEMSG STAMPLENGTH) of DATUM)))
(MSGFROMMEP (COND
((fetch (LAFITEMSG MSGFROMMECHECKED?)
of DATUM)
(fetch (LAFITEMSG MSGFROMMETRUTH)
of DATUM))
(T (LA.MSGFROMMEP DATUM)))
(PROG1 (replace (LAFITEMSG MSGFROMMETRUTH)
of DATUM with NEWVALUE)
(replace (LAFITEMSG MSGFROMMECHECKED?)
of DATUM with T)))
(MARKSCHANGED? (NEQ 0 (fetch (LAFITEMSG MARKSCHANGEDBITS)
of DATUM))
(replace (LAFITEMSG MARKSCHANGEDBITS) of DATUM
with 3))
(MODE (CL:NTH (fetch (LAFITEMSG MODEBITS) of DATUM)
*LAFITE-WELL-KNOWN-MODES*)
(replace (LAFITEMSG MODEBITS) of DATUM
WITH (OR (CL:POSITION NEWVALUE
*LAFITE-WELL-KNOWN-MODES*)
0])
(DATATYPE MAILFOLDER ((BROWSERPROMPTDIRTY FLAG) (* ;
 "Something's been printed in prompt window")
(BROWSERPROMPTGREW FLAG) (* ;
 "Browser prompt window has expanded")
(FOLDERNEEDSUPDATE FLAG) (* ; "Something changed")
(FOLDERNEEDSEXPUNGE FLAG) (* ; "True if deleted msgs")
(FOLDERBEINGUPDATED FLAG) (* ; "True during Update cmd")
(BROWSERSTATUS BITS 3) (* ; "Ready, etc.")
(FULLFOLDERNAME POINTER) (* ; "Full name of actual file")
(FOLDEROKTOSHRINK FLAG) (* ;
 "Kludge to allow you to call SHRINKW without invoking the Update? question")
(FOLDERGETSMAIL FLAG) (* ; "True if GetMail ok")
(FOLDEROUTOFORDER FLAG) (* ; "True if folder has been sorted")
(NIL 5 FLAG)
(VERSIONLESSFOLDERNAME POINTER) (* ; "Versionless for conflict check")
(SHORTFOLDERNAME POINTER) (* ; "Normal name displayed to user")
(FOLDERSTREAM POINTER) (* ; "Stream open on the file, or NIL")
(MESSAGEDESCRIPTORS POINTER) (* ; "Array of LAFITEMSG")
(FOLDERLOCK POINTER) (* ; "Monitor lock for all access")
(%#OFMESSAGES WORD)
(TOCLASTMESSAGE# WORD) (* ;
 "Last message that is in TOC file")
(BROWSERFONTHEIGHT WORD) (* ; "Cached info about browser font")
(BROWSERFONTASCENT WORD)
(BROWSERFONTDESCENT WORD)
(BROWSERMAXXPOS WORD) (* ; "For extent computations")
(ORDINALXPOS WORD) (* ; "Where msg # starts")
(DATEXPOS WORD) (* ; "Where msg date starts")
(FROMXPOS WORD) (* ; "Where msg From starts")
(FROMMAXXPOS WORD) (* ; "Beyond here, From is truncated")
(SUBJECTXPOS WORD) (* ; "Where msg subject starts")
(BROWSERDIGITWIDTH WORD)
(FIRSTSELECTEDMESSAGE WORD) (* ;
 "First/last msgs currently selected")
(LASTSELECTEDMESSAGE WORD)
(FIRSTCHANGEDMESSAGE WORD) (* ;
 "First message with any change--not currently used")
(CURRENTPROMPTLINE WORD) (* ;
 "Value of \currentdisplayline for browser prompt")
(CURRENTDISPLAYEDSTREAM POINTER) (* ;
 "The backing core file for the current message (not used interestingly)")
(BROWSEREXTENT POINTER)
(BROWSERORIGIN POINTER)
(FOLDERDISPLAYREGION POINTER) (* ;
 "Region of display window (valid when browser shrunk)")
(BROWSERWINDOW POINTER) (* ;
 "The browser window and various pieces...")
(BROWSERMENU POINTER)
(BROWSERMENUWINDOW POINTER)
(BROWSERPROMPTWINDOW POINTER)
(ORIGINALBROWSERTITLE POINTER) (* ;
 "Original title before we added %"default move to%"")
(FOLDERDISPLAYWINDOWS POINTER) (* ; "WIndows currently displaying messages from this folder. First element is %"primary%" display window, or NIL")
(FOLDEREOFPTR POINTER) (* ; "Length of file")
(DEFAULTMOVETOFILE POINTER) (* ; "Folder we last moved to, or NIL")
(CURRENTDISPLAYEDMESSAGE POINTER) (* ;
 "Message descriptor of most recently displayed message")
(BROWSERUPDATEFROMHERE POINTER) (* ;
 "First potentially changed message, from which redisplay needs to occur when icon expands.")
(BROWSERLAYOUT POINTER) (* ;
 "The element of LAFITEBROWSERLAYOUTS used to build this window, if any")
(FOLDERCREATIONDATE POINTER) (* ; "the ICREATIONDATE of the file")
(HARDCOPYMESSAGES POINTER) (* ;
 "List of msg descriptors being hardcopied")
(HARDCOPYSTREAM POINTER) (* ;
 "A Textstream for pending hardcopy")
)
(BLOCKRECORD MAILFOLDER ((NIL 5 FLAG)
(NIL BITS 2)
(BROWSERREADYBIT FLAG)
(* ;
 "Low bit of status on means ready")
))
[ACCESSFNS MAILFOLDER ((BROWSERREADY (fetch (MAILFOLDER BROWSERREADYBIT)
of DATUM)
(REPLACE (MAILFOLDER BROWSERSTATUS)
OF DATUM WITH (COND
(NEWVALUE
LAS.READY)
(T LAS.PARSING])
(DATATYPE MAILFOLDER ((BROWSERPROMPTDIRTY FLAG) (* ;
 "Something's been printed in prompt window")
(BROWSERPROMPTGREW FLAG) (* ;
 "Browser prompt window has expanded")
(FOLDERNEEDSUPDATE FLAG) (* ; "Something changed")
(FOLDERNEEDSEXPUNGE FLAG) (* ; "True if deleted msgs")
(FOLDERBEINGUPDATED FLAG) (* ; "True during Update cmd")
(BROWSERSTATUS BITS 3) (* ; "Ready, etc.")
(FULLFOLDERNAME POINTER) (* ; "Full name of actual file")
(FOLDEROKTOSHRINK FLAG) (* ;
 "Kludge to allow you to call SHRINKW without invoking the Update? question")
(FOLDERGETSMAIL FLAG) (* ; "True if GetMail ok")
(FOLDEROUTOFORDER FLAG) (* ; "True if folder has been sorted")
(NIL 5 FLAG)
(VERSIONLESSFOLDERNAME POINTER) (* ; "Versionless for conflict check")
(SHORTFOLDERNAME POINTER) (* ; "Normal name displayed to user")
(FOLDERSTREAM POINTER) (* ; "Stream open on the file, or NIL")
(MESSAGEDESCRIPTORS POINTER) (* ; "Array of LAFITEMSG")
(FOLDERLOCK POINTER) (* ; "Monitor lock for all access")
(%#OFMESSAGES WORD)
(TOCLASTMESSAGE# WORD) (* ; "Last message that is in TOC file")
(BROWSERFONTHEIGHT WORD) (* ; "Cached info about browser font")
(BROWSERFONTASCENT WORD)
(BROWSERFONTDESCENT WORD)
(BROWSERMAXXPOS WORD) (* ; "For extent computations")
(ORDINALXPOS WORD) (* ; "Where msg # starts")
(DATEXPOS WORD) (* ; "Where msg date starts")
(FROMXPOS WORD) (* ; "Where msg From starts")
(FROMMAXXPOS WORD) (* ; "Beyond here, From is truncated")
(SUBJECTXPOS WORD) (* ; "Where msg subject starts")
(BROWSERDIGITWIDTH WORD)
(FIRSTSELECTEDMESSAGE WORD) (* ;
 "First/last msgs currently selected")
(LASTSELECTEDMESSAGE WORD)
(FIRSTCHANGEDMESSAGE WORD) (* ;
 "First message with any change--not currently used")
(CURRENTPROMPTLINE WORD) (* ;
 "Value of \currentdisplayline for browser prompt")
(CURRENTDISPLAYEDSTREAM POINTER) (* ;
 "The backing core file for the current message (not used interestingly)")
(BROWSEREXTENT POINTER)
(BROWSERORIGIN POINTER)
(FOLDERDISPLAYREGION POINTER) (* ;
 "Region of display window (valid when browser shrunk)")
(BROWSERWINDOW POINTER) (* ;
 "The browser window and various pieces...")
(BROWSERMENU POINTER)
(BROWSERMENUWINDOW POINTER)
(BROWSERPROMPTWINDOW POINTER)
(ORIGINALBROWSERTITLE POINTER) (* ;
 "Original title before we added %"default move to%"")
(FOLDERDISPLAYWINDOWS POINTER) (* ; "WIndows currently displaying messages from this folder. First element is %"primary%" display window, or NIL")
(FOLDEREOFPTR POINTER) (* ; "Length of file")
(DEFAULTMOVETOFILE POINTER) (* ; "Folder we last moved to, or NIL")
(CURRENTDISPLAYEDMESSAGE POINTER) (* ;
 "Message descriptor of most recently displayed message")
(BROWSERUPDATEFROMHERE POINTER) (* ;
 "First potentially changed message, from which redisplay needs to occur when icon expands.")
(BROWSERLAYOUT POINTER) (* ;
 "The element of LAFITEBROWSERLAYOUTS used to build this window, if any")
(FOLDERCREATIONDATE POINTER) (* ; "the ICREATIONDATE of the file")
(HARDCOPYMESSAGES POINTER) (* ;
 "List of msg descriptors being hardcopied")
(HARDCOPYSTREAM POINTER) (* ; "A Textstream for pending hardcopy")
)
(BLOCKRECORD MAILFOLDER ((NIL 5 FLAG)
(NIL BITS 2)
(BROWSERREADYBIT FLAG)
(* ; "Low bit of status on means ready")
))
[ACCESSFNS MAILFOLDER ((BROWSERREADY (fetch (MAILFOLDER BROWSERREADYBIT)
of DATUM)
(REPLACE (MAILFOLDER BROWSERSTATUS) OF DATUM
WITH (COND
(NEWVALUE LAS.READY)
(T LAS.PARSING])
(RECORD FOLDERGROUP (FGNAME (FGTOPLEVEL . FGSUBGROUPS) . FGFOLDERS))
(RECORD DEFAULTHOST&DIR (PACKEDHOST&DIR . UNPACKEDHOST&DIR)
(PROPRECORD UNPACKEDHOST&DIR (DEFAULTDIR DEFAULTHOST DEFAULTDEV)))
(PROPRECORD UNPACKEDHOST&DIR (DEFAULTDIR DEFAULTHOST DEFAULTDEV)))
(RECORD MAILSERVER (MAILSERVEROPS MAILPORT MAILSERVERNAME CONTINUANCE NEWMAILP . MAILSTATE))
(RECORD MAILSERVEROPS (POLLNEWMAIL OPENMAILBOX NEXTMESSAGE RETRIEVEMESSAGE CLOSEMAILBOX
SERVERPORTFROMNAME))
SERVERPORTFROMNAME))
(RECORD OPENEDMAILBOX (MAILBOX . PROPERTIES)
(PROPRECORD PROPERTIES (%#OFMESSAGES)))
(PROPRECORD PROPERTIES (%#OFMESSAGES)))
(RECORD OUTBOX (OBWINDOW OBSIZE OBHEIGHT OBDESCENT OBORIGIN OBITEMS))
@@ -462,55 +446,51 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989, 1994 by Xerox Corporation. All righ
(DECLARE%: EVAL@COMPILE
[I.S.OPR 'SELECTEDIN NIL '(bind ($$MESSAGES _ (fetch (MAILFOLDER MESSAGEDESCRIPTORS)
of BODY))
($$MSG# _ (SUB1 (fetch (MAILFOLDER FIRSTSELECTEDMESSAGE)
of BODY)))
($$MSGLAST _ (fetch (MAILFOLDER LASTSELECTEDMESSAGE)
of BODY)) until (IGREATERP (add $$MSG# 1
)
$$MSGLAST)
when (fetch (LAFITEMSG SELECTED?) of (SETQ I.V.
(NTHMESSAGE $$MESSAGES
$$MSG#]
[I.S.OPR 'SELECTEDIN NIL '(bind ($$MESSAGES _ (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of BODY))
($$MSG# _ (SUB1 (fetch (MAILFOLDER FIRSTSELECTEDMESSAGE) of BODY)))
($$MSGLAST _ (fetch (MAILFOLDER LASTSELECTEDMESSAGE) of BODY))
until (IGREATERP (add $$MSG# 1)
$$MSGLAST) when (fetch (LAFITEMSG SELECTED?)
of (SETQ I.V. (NTHMESSAGE $$MESSAGES
$$MSG#]
)
(DECLARE%: EVAL@COMPILE
(PROGN (PUTPROPS WORDIN DMACRO (= . \WIN))
(PUTPROPS WORDIN MACRO (= . \WIN)))
(PROGN (PUTPROPS WORDIN DMACRO (= . \WIN))
(PUTPROPS WORDIN MACRO (= . \WIN)))
[PUTPROPS FIXPIN DMACRO (OPENLAMBDA (STREAM)
(\MAKENUMBER (WORDIN STREAM)
(WORDIN STREAM]
(PUTPROPS FIXPIN DMACRO (OPENLAMBDA (STREAM)
(\MAKENUMBER (WORDIN STREAM)
(WORDIN STREAM))))
(PUTPROPS WORDOUT DMACRO (= . \WOUT))
(PUTPROPS WORDOUT DMACRO (= . \WOUT))
[PUTPROPS FIXPOUT DMACRO (OPENLAMBDA (STREAM N)
(PROGN (WORDOUT STREAM (LRSH N 16))
(WORDOUT STREAM (LOGAND N 65535]
(PUTPROPS FIXPOUT DMACRO [OPENLAMBDA (STREAM N)
(PROGN (WORDOUT STREAM (LRSH N 16))
(WORDOUT STREAM (LOGAND N 65535])
[PUTPROPS UCASECODE MACRO (OPENLAMBDA (CHAR)
(COND
((AND (IGEQ CHAR (CHARCODE a))
(ILEQ CHAR (CHARCODE z)))
(LOGAND CHAR 95))
(T CHAR]
(PUTPROPS UCASECODE MACRO (OPENLAMBDA (CHAR)
(COND
((AND (IGEQ CHAR (CHARCODE a))
(ILEQ CHAR (CHARCODE z)))
(LOGAND CHAR 95))
(T CHAR))))
(PUTPROPS NTHMESSAGE MACRO (= . ELT))
(PUTPROPS NTHMESSAGE MACRO (= . ELT))
[PUTPROPS .LAFITEMENU. MACRO ((NAME ITEMS TITLE)
(PUTPROPS .LAFITEMENU. MACRO [(NAME ITEMS TITLE)
(PROGN (DECLARE (GLOBALVARS NAME))
(OR NAME (SETQ NAME (\LAFITE.CREATE.MENU ITEMS TITLE]
(OR NAME (SETQ NAME (\LAFITE.CREATE.MENU ITEMS TITLE])
[PUTPROPS MAYBEVERIFYMSG MACRO ((MSG MAILFOLDER)
(AND LAFITEVERIFYFLG (\LAFITE.VERIFYMSG MSG MAILFOLDER]
(PUTPROPS MAYBEVERIFYMSG MACRO ((MSG MAILFOLDER)
(AND LAFITEVERIFYFLG (\LAFITE.VERIFYMSG MSG MAILFOLDER))))
[PUTPROPS UNSEENMARKP MACRO (OPENLAMBDA (MK)
(OR (EQ MK UNSEENMARK)
(EQ MK HEARDMARK]
(PUTPROPS UNSEENMARKP MACRO (OPENLAMBDA (MK)
(OR (EQ MK UNSEENMARK)
(EQ MK HEARDMARK))))
)
(RPAQQ LAFITEGLOBALS
(RPAQQ LAFITEGLOBALS
(*LAFITE-WELL-KNOWN-MODES* ANOTHERFOLDERMENUITEM AROUNDEXITFNS BackgroundMenu
BackgroundMenuCommands FORWARDMARK HARDCOPYBATCHMARK HARDCOPYMARK HEARDMARK
LA.CROSSCURSOR LA.SELECTION.BITMAP LAFITE.PERSONAL.VARS LAFITE.UPDATE.MENU.HASH
@@ -551,7 +531,7 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989, 1994 by Xerox Corporation. All righ
(* ; "LAFITE.PROCLAMATIONS are exported to user in file LAFITE--these are the documented variables")
(RPAQQ LAFITE.PROCLAMATIONS
(RPAQQ LAFITE.PROCLAMATIONS
[(CL:PROCLAIM '(GLOBAL ANSWERMARK BROWSERMARKXPOSITION DEFAULTMAILFOLDERNAME
LAFITE.2COLUMN.MENU.MIN.ITEMS LAFITE.AUTO.MOVE.MENU
LAFITE.BACKGROUND.ITEM LAFITE.BROWSER.ICON.PREFERENCE
@@ -610,7 +590,7 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989, 1994 by Xerox Corporation. All righ
(* ; "For debugging with Masterscope, here are fns not called from code")
(RPAQQ LAFITE.CALLED.FROM.LITERALS
(RPAQQ LAFITE.CALLED.FROM.LITERALS
(GV.CLOSEMAILBOX GV.INIT.MAIL.USER GV.MAKEANSWERFORM GV.NEXTMESSAGE GV.OPENMAILBOX
GV.POLLNEWMAIL GV.PORTFROMNAME GV.RETRIEVEMESSAGE LAFITE.COMPUTE.CACHED.VARS
LAFITE.GRAB.DATE LAFITE.ON.FROM.BACKGROUND LAFITE.PARSE.DATE.FIELD.ONLY
@@ -637,11 +617,11 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989, 1994 by Xerox Corporation. All righ
\NSMAIL.MESSAGE.FROM.SELF.P \NSMAIL.MESSAGE.P \NSMAIL.SEND \NSMAIL.SEND.PARSE
\SENDMSG.CHANGE.MODE \SENDMSG.DELIVER \SENDMSG.SAVE.FORM))
(RPAQQ LAFITE.PROGRAMMER.ENTRIES
(LAFITEDEFAULTHOST&DIR LOAD-LAFITE LAFITE.SENDMESSAGE BUILD.LAFITE.LAYOUTS
LAB.SELECTED.MESSAGES LAFITE.DELETE.MESSAGES LAFITE.MOVE.MESSAGES
LAFITE.HARDCOPY.MESSAGES LAFITE.OBTAIN.FOLDER MAILSCAVENGE MS.EXPAND GV.READTOC
GV.WRITETOC GV.DELETEMESSAGE))
(RPAQQ LAFITE.PROGRAMMER.ENTRIES (LAFITEDEFAULTHOST&DIR LOAD-LAFITE LAFITE.SENDMESSAGE
BUILD.LAFITE.LAYOUTS LAB.SELECTED.MESSAGES
LAFITE.DELETE.MESSAGES LAFITE.MOVE.MESSAGES
LAFITE.HARDCOPY.MESSAGES LAFITE.OBTAIN.FOLDER MAILSCAVENGE
MS.EXPAND GV.READTOC GV.WRITETOC GV.DELETEMESSAGE))
(DEFCOMMAND (WHONOTLAFITE :HISTORY) NIL
'((CL:SET-DIFFERENCE (CL:SET-DIFFERENCE (%. WHO ON ANY IN LAFITEFILES IS NOT CALLED)
@@ -662,7 +642,6 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989, 1994 by Xerox Corporation. All righ
(SETTEMPLATE 'TEXTPROP '(EVAL PROP EVAL . PPE))
)
(PUTPROPS LAFITEDECLS COPYRIGHT ("Xerox Corporation" 1985 1986 1987 1988 1989 1994))
(DECLARE%: DONTCOPY
(FILEMAP (NIL)))
STOP

34
library/lafite/LAFITEFIND → library/lafite/LAFITE-FIND
View File

@@ -1,20 +1,17 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "30-Sep-2021 23:01:05" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITEFIND.;2 14882
changes to%: (FILES LAFITEDECLS)
(FILECREATED "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-FIND.;2 14652
previous date%: " 3-Jun-92 10:10:41"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITEFIND.;1)
:EDIT-BY rmk
:CHANGES-TO (VARS LAFITE-FINDCOMS)
:PREVIOUS-DATE "23-Feb-2024 22:11:33" {WMEDLEY}<library>lafite>LAFITE-FIND.;1)
(* ; "
Copyright (c) 1984-1988, 1990, 1992, 2021 by Venue & Xerox Corporation.
")
(PRETTYCOMPRINT LAFITE-FINDCOMS)
(PRETTYCOMPRINT LAFITEFINDCOMS)
(RPAQQ LAFITEFINDCOMS
(RPAQQ LAFITE-FINDCOMS
((FNS \LAFITE.FIND \LAFITE.FIND.RELATED \LAFITE.FIND.RELATED.BACKWARD \LAFITE.GO.TO.FIRST
\LAFITE.GO.TO.INTERACTIVE \LAFITE.GO.TO.LAST \LAFITE.FIND.AGAIN \LAFITE.FIND.PROMPT
\LAFITE.DO.FIND \LAFITE.FIND.START)
@@ -22,7 +19,7 @@ Copyright (c) 1984-1988, 1990, 1992, 2021 by Venue & Xerox Corporation.
(GLOBALVARS LAFITEFINDAREAMENUITEMS LAFITEFINDTYPEMENUITEMS LAFITEFINDTYPEMENU
LAFITEFINDAREAMENU LAFITEEXTRAMENU LAFITEEXTRAMENUFLG \LAFITE.LAST.SEARCH)
(FILES (SOURCE)
LAFITEDECLS)
LAFITE-DECLS)
(LOCALVARS . T))
(INITVARS LAFITEFINDTYPEMENU LAFITEFINDAREAMENU)
(VARS LAFITEFINDAREAMENUITEMS LAFITEFINDTYPEMENUITEMS)
@@ -133,7 +130,7 @@ Copyright (c) 1984-1988, 1990, 1992, 2021 by Venue & Xerox Corporation.
(FILESLOAD (SOURCE)
LAFITEDECLS)
LAFITE-DECLS)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
@@ -181,11 +178,10 @@ Copyright (c) 1984-1988, 1990, 1992, 2021 by Venue & Xerox Corporation.
(ADDTOVAR LAFITEMENUVARS LAFITEFINDTYPEMENU LAFITEFINDAREAMENU)
(RPAQQ \LAFITE.LAST.SEARCH NIL)
(PUTPROPS LAFITEFIND COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1988 1990 1992 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2309 12081 (\LAFITE.FIND 2319 . 3351) (\LAFITE.FIND.RELATED 3353 . 4018) (
\LAFITE.FIND.RELATED.BACKWARD 4020 . 4156) (\LAFITE.GO.TO.FIRST 4158 . 4325) (
\LAFITE.GO.TO.INTERACTIVE 4327 . 4939) (\LAFITE.GO.TO.LAST 4941 . 5149) (\LAFITE.FIND.AGAIN 5151 .
5733) (\LAFITE.FIND.PROMPT 5735 . 7857) (\LAFITE.DO.FIND 7859 . 11010) (\LAFITE.FIND.START 11012 .
12079)))))
(FILEMAP (NIL (2180 11952 (\LAFITE.FIND 2190 . 3222) (\LAFITE.FIND.RELATED 3224 . 3889) (
\LAFITE.FIND.RELATED.BACKWARD 3891 . 4027) (\LAFITE.GO.TO.FIRST 4029 . 4196) (
\LAFITE.GO.TO.INTERACTIVE 4198 . 4810) (\LAFITE.GO.TO.LAST 4812 . 5020) (\LAFITE.FIND.AGAIN 5022 .
5604) (\LAFITE.FIND.PROMPT 5606 . 7728) (\LAFITE.DO.FIND 7730 . 10881) (\LAFITE.FIND.START 10883 .
11950)))))
STOP

BIN
library/lafite/LAFITE-FIND.LCOM Normal file
View File

Binary file not shown.

61
library/lafite/LAFITEFOLDERS → library/lafite/LAFITE-FOLDERS
View File

@@ -1,21 +1,17 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 7-Feb-2022 12:04:09" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>lafite>LAFITEFOLDERS.;2 44421
(FILECREATED "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-FOLDERS.;2 44255
:CHANGES-TO (FNS \LAFITE.MAKE.RANDOM.DISPLAY)
:EDIT-BY rmk
:PREVIOUS-DATE " 2-Nov-89 18:16:37"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>lafite>LAFITEFOLDERS.;1)
:CHANGES-TO (VARS LAFITE-FOLDERSCOMS)
:PREVIOUS-DATE "23-Feb-2024 22:01:00" {WMEDLEY}<library>lafite>LAFITE-FOLDERS.;1)
(* ; "
Copyright (c) 1989 by Xerox Corporation.
")
(PRETTYCOMPRINT LAFITE-FOLDERSCOMS)
(PRETTYCOMPRINT LAFITEFOLDERSCOMS)
(RPAQQ LAFITEFOLDERSCOMS
(RPAQQ LAFITE-FOLDERSCOMS
[
(* ;; "Maintenance of Lafite's folder structures, menus etc.")
@@ -53,7 +49,7 @@ Copyright (c) 1989 by Xerox Corporation.
UALPHORDERCAR)
(VARS LAFITE.SPACER.MENU.ITEM LAFITE.GROUP.COMMANDS (LAFITE.GROUP.COMMANDS.MENU)))
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (SOURCE)
LAFITEDECLS)
LAFITE-DECLS)
(LOCALVARS . T)
(GLOBALVARS MENUFONT LAFITE.GROUP.COMMANDS.MENU LAFITE.GROUP.COMMANDS)
(P (CL:PROCLAIM '(CL:SPECIAL *LA.ABBREVS.IN.PROFILE*])
@@ -334,7 +330,7 @@ Done." (ADD1 (GETEOFPTR TEXTSTREAM))))))
(DECLARE%: EVAL@COMPILE DONTCOPY
(FILESLOAD (SOURCE)
LAFITEDECLS)
LAFITE-DECLS)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
@@ -349,25 +345,24 @@ Done." (ADD1 (GETEOFPTR TEXTSTREAM))))))
(CL:PROCLAIM '(CL:SPECIAL *LA.ABBREVS.IN.PROFILE*))
)
(PUTPROPS LAFITEFOLDERS COPYRIGHT ("Xerox Corporation" 1989))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3536 11401 (\LAFITE.READ.PROFILE 3546 . 5750) (\LAFITE.PROCESS.PROFILE 5752 . 6942) (
\LAFITE.WRITE.PROFILE 6944 . 8778) (\LAFITE.MERGE.NAMELISTS 8780 . 9514) (\LAFITE.READ.OLD.PROFILE
9516 . 10115) (\LAFITE.MERGE.FOLDERS 10117 . 10429) (\LAFITE.MERGE.STRUCTURES 10431 . 10631) (
\LAFITE.REPACK.FOLDERS 10633 . 11399)) (11828 20372 (\LAFITE.PROMPTFORFOLDER 11838 . 12388) (
PROMPTFORFILENAME 12390 . 13231) (MAKELAFITEMAILFOLDERSMENU 13233 . 13397) (MAKELAFITEFOLDERSMENUITEMS
13399 . 14514) (LAFITE.GROUP.ITEM 14516 . 15053) (\LAFITE.ARRANGE.MENU 15055 . 16337) (
\LAFITE.MAKE.FOLDER.MENU 16339 . 16864) (LAFITE.SELECT.FOLDERS 16866 . 17251) (LAFITE.SELECT.MULTIPLE
17253 . 19597) (\LAFITE.HANDLE.MULTIPLE.SELECTION 19599 . 20071) (COLLECT.SHADED.ITEMS 20073 . 20370))
(20595 29104 (LA.LONGFILENAME 20605 . 22480) (LA.SHORTFILENAME 22482 . 24305) (FORGETMAILFILE 24307
. 24767) (\LAFITE.FOLDER.NAME.CHANGED 24769 . 25992) (\LAFITE.CHANGE.NAME.IN.LIST 25994 . 26373) (
\LAFITE.RECOMPUTE.FOLDER.NAMES 26375 . 27796) (\LAFITE.NEW.SHORT.NAME 27798 . 28479) (
\LAFITE.NOTICE.FILE 28481 . 28662) (\LAFITE.UNCACHE.FOLDER 28664 . 29102)) (29220 43399 (
\LAFITE.NOTICE.FOLDERS 29230 . 30870) (\LAFITE.GC.FOLDERS 30872 . 31959) (\LAFITE.GC.FOLDERS.CONFIRM
31961 . 32771) (\LAFITE.MAKE.RANDOM.DISPLAY 32773 . 34764) (\LAFITE.CHANGE.FOLDER.LIST 34766 . 35519)
(\LAFITE.RENAME.FOLDER 35521 . 37251) (\LAFITE.ADD.NEW.GROUP 37253 . 37978) (\LAFITE.CHECK.GROUP.NAME
37980 . 38331) (\LAFITE.CHANGE.GROUP.MEMBERS 38333 . 38708) (\LAFITE.SELECT.GROUP.FOLDERS 38710 .
39716) (\LAFITE.CHANGE.SUBGROUPS 39718 . 40369) (\LAFITE.CHANGE.TOP.GROUPS 40371 . 41079) (
\LAFITE.DELETE.GROUP 41081 . 41663) (LAFITE.RENAME.GROUP 41665 . 42521) (\LAFITE.EDIT.HIERARCHY 42523
. 43082) (LAFITE.FIND.GROUP 43084 . 43280) (UALPHORDERCAR 43282 . 43397)))))
(FILEMAP (NIL (3431 11296 (\LAFITE.READ.PROFILE 3441 . 5645) (\LAFITE.PROCESS.PROFILE 5647 . 6837) (
\LAFITE.WRITE.PROFILE 6839 . 8673) (\LAFITE.MERGE.NAMELISTS 8675 . 9409) (\LAFITE.READ.OLD.PROFILE
9411 . 10010) (\LAFITE.MERGE.FOLDERS 10012 . 10324) (\LAFITE.MERGE.STRUCTURES 10326 . 10526) (
\LAFITE.REPACK.FOLDERS 10528 . 11294)) (11723 20267 (\LAFITE.PROMPTFORFOLDER 11733 . 12283) (
PROMPTFORFILENAME 12285 . 13126) (MAKELAFITEMAILFOLDERSMENU 13128 . 13292) (MAKELAFITEFOLDERSMENUITEMS
13294 . 14409) (LAFITE.GROUP.ITEM 14411 . 14948) (\LAFITE.ARRANGE.MENU 14950 . 16232) (
\LAFITE.MAKE.FOLDER.MENU 16234 . 16759) (LAFITE.SELECT.FOLDERS 16761 . 17146) (LAFITE.SELECT.MULTIPLE
17148 . 19492) (\LAFITE.HANDLE.MULTIPLE.SELECTION 19494 . 19966) (COLLECT.SHADED.ITEMS 19968 . 20265))
(20490 28999 (LA.LONGFILENAME 20500 . 22375) (LA.SHORTFILENAME 22377 . 24200) (FORGETMAILFILE 24202
. 24662) (\LAFITE.FOLDER.NAME.CHANGED 24664 . 25887) (\LAFITE.CHANGE.NAME.IN.LIST 25889 . 26268) (
\LAFITE.RECOMPUTE.FOLDER.NAMES 26270 . 27691) (\LAFITE.NEW.SHORT.NAME 27693 . 28374) (
\LAFITE.NOTICE.FILE 28376 . 28557) (\LAFITE.UNCACHE.FOLDER 28559 . 28997)) (29115 43294 (
\LAFITE.NOTICE.FOLDERS 29125 . 30765) (\LAFITE.GC.FOLDERS 30767 . 31854) (\LAFITE.GC.FOLDERS.CONFIRM
31856 . 32666) (\LAFITE.MAKE.RANDOM.DISPLAY 32668 . 34659) (\LAFITE.CHANGE.FOLDER.LIST 34661 . 35414)
(\LAFITE.RENAME.FOLDER 35416 . 37146) (\LAFITE.ADD.NEW.GROUP 37148 . 37873) (\LAFITE.CHECK.GROUP.NAME
37875 . 38226) (\LAFITE.CHANGE.GROUP.MEMBERS 38228 . 38603) (\LAFITE.SELECT.GROUP.FOLDERS 38605 .
39611) (\LAFITE.CHANGE.SUBGROUPS 39613 . 40264) (\LAFITE.CHANGE.TOP.GROUPS 40266 . 40974) (
\LAFITE.DELETE.GROUP 40976 . 41558) (LAFITE.RENAME.GROUP 41560 . 42416) (\LAFITE.EDIT.HIERARCHY 42418
. 42977) (LAFITE.FIND.GROUP 42979 . 43175) (UALPHORDERCAR 43177 . 43292)))))
STOP

BIN
library/lafite/LAFITEFOLDERS.LCOM → library/lafite/LAFITE-FOLDERS.LCOM
View File

Binary file not shown.

52
library/lafite/LAFITEHAX → library/lafite/LAFITE-HAX
View File

@@ -1,19 +1,30 @@
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "26-Feb-93 14:36:38" "{DSK}<tilde>vanmelle>lisp>lafite>LAFITEHAX.;12" 9033
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
changes to%: (FNS \NSMAIL.PARSE1 \NSMAIL.NEW.CHECKSERVER LAFITE.TOGGLE.SERVER.TRACE LAFITE.HANDLE.ORIGINAL.FIELD LAFITE.COMPUTE.CACHED.VARS LAFITE.NEW.PARSE.HEADER INIT.NEW.PARSE.HANDLER)
(VARS LAFITEHAXCOMS)
(FILECREATED "23-Feb-2024 23:58:34" {WMEDLEY}<library>lafite>LAFITE-HAX.;1 9138
previous date%: " 3-Jun-92 16:10:47" "{DSK}<tilde>vanmelle>lisp>lafite>LAFITEHAX.;1")
:EDIT-BY rmk
:PREVIOUS-DATE "26-Feb-93 14:36:38" {WMEDLEY}<library>lafite>LAFITEHAX.;1)
(* ; "
Copyright (c) 1992, 1993 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT LAFITE-HAXCOMS)
(PRETTYCOMPRINT LAFITEHAXCOMS)
(RPAQQ LAFITEHAXCOMS ((COMS (* ; "New header parser") (FNS LAFITE.NEW.PARSE.HEADER LAFITE.HANDLE.ORIGINAL.FIELD INIT.NEW.PARSE.HANDLER LAFITE.COMPUTE.CACHED.VARS) (INITVARS (*LAFITE-MAX-FIELD-WIDTH* 100) (*LAFITE-PARSE-HEADER-STRING-RESOURCE*)) (GLOBALVARS *LAFITE-MAX-FIELD-WIDTH* *LAFITE-PARSE-HEADER-STRING-RESOURCE*) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (INIT.NEW.PARSE.HANDLER)))) (COMS (* ; "automatically handle internet addresses") (FNS \NSMAIL.PARSE1)) (COMS (FNS LAFITE.TOGGLE.SERVER.TRACE) (APPENDVARS (LAFITESUBQUITMENUITEMS ("Server trace" (QUOTE LAFITE.TOGGLE.SERVER.TRACE) "Change setting of *NSMAIL-TRACE-SERVERS*"))) (VARS (LAFITESUBQUITMENU)))))
(RPAQQ LAFITE-HAXCOMS
[[COMS (* ; "New header parser")
(FNS LAFITE.NEW.PARSE.HEADER LAFITE.HANDLE.ORIGINAL.FIELD INIT.NEW.PARSE.HANDLER
LAFITE.COMPUTE.CACHED.VARS)
(INITVARS (*LAFITE-MAX-FIELD-WIDTH* 100)
(*LAFITE-PARSE-HEADER-STRING-RESOURCE*))
(GLOBALVARS *LAFITE-MAX-FIELD-WIDTH* *LAFITE-PARSE-HEADER-STRING-RESOURCE*)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (INIT.NEW.PARSE.HANDLER]
(COMS (* ;
 "automatically handle internet addresses")
(FNS \NSMAIL.PARSE1))
(COMS (FNS LAFITE.TOGGLE.SERVER.TRACE)
(APPENDVARS (LAFITESUBQUITMENUITEMS ("Server trace" 'LAFITE.TOGGLE.SERVER.TRACE
"Change setting of *NSMAIL-TRACE-SERVERS*"))
)
(VARS (LAFITESUBQUITMENU])
@@ -40,16 +51,16 @@ Copyright (c) 1992, 1993 by Xerox Corporation. All rights reserved.
)
)
(RPAQ? *LAFITE-MAX-FIELD-WIDTH* 100)
(RPAQ? *LAFITE-MAX-FIELD-WIDTH* 100)
(RPAQ? *LAFITE-PARSE-HEADER-STRING-RESOURCE*)
(RPAQ? *LAFITE-PARSE-HEADER-STRING-RESOURCE* )
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS *LAFITE-MAX-FIELD-WIDTH* *LAFITE-PARSE-HEADER-STRING-RESOURCE*)
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(INIT.NEW.PARSE.HANDLER)
(INIT.NEW.PARSE.HANDLER)
)
@@ -69,13 +80,12 @@ Copyright (c) 1992, 1993 by Xerox Corporation. All rights reserved.
)
)
(APPENDTOVAR LAFITESUBQUITMENUITEMS ("Server trace" (QUOTE LAFITE.TOGGLE.SERVER.TRACE) "Change setting of *NSMAIL-TRACE-SERVERS*")
)
(APPENDTOVAR LAFITESUBQUITMENUITEMS ("Server trace" 'LAFITE.TOGGLE.SERVER.TRACE
"Change setting of *NSMAIL-TRACE-SERVERS*"))
(RPAQQ LAFITESUBQUITMENU NIL)
(PUTPROPS LAFITEHAX COPYRIGHT ("Xerox Corporation" 1992 1993))
(RPAQQ LAFITESUBQUITMENU NIL)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1281 6753 (LAFITE.NEW.PARSE.HEADER 1291 . 3112) (LAFITE.HANDLE.ORIGINAL.FIELD 3114 .
3790) (INIT.NEW.PARSE.HANDLER 3792 . 4047) (LAFITE.COMPUTE.CACHED.VARS 4049 . 6751)) (7070 8290 (
\NSMAIL.PARSE1 7080 . 8288)) (8291 8778 (LAFITE.TOGGLE.SERVER.TRACE 8301 . 8776)))))
(FILEMAP (NIL (1396 6868 (LAFITE.NEW.PARSE.HEADER 1406 . 3227) (LAFITE.HANDLE.ORIGINAL.FIELD 3229 .
3905) (INIT.NEW.PARSE.HANDLER 3907 . 4162) (LAFITE.COMPUTE.CACHED.VARS 4164 . 6866)) (7198 8418 (
\NSMAIL.PARSE1 7208 . 8416)) (8419 8906 (LAFITE.TOGGLE.SERVER.TRACE 8429 . 8904)))))
STOP

81
library/lafite/LAFITEMAIL → library/lafite/LAFITE-MAIL
View File

@@ -1,18 +1,17 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "30-Sep-2021 23:01:47" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITEMAIL.;3 133718
previous date%: "22-Jun-2021 10:19:08"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITEMAIL.;2)
(FILECREATED "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-MAIL.;2 133521
:EDIT-BY rmk
:CHANGES-TO (VARS LAFITE-MAILCOMS)
:PREVIOUS-DATE "23-Feb-2024 22:05:03" {WMEDLEY}<library>lafite>LAFITE-MAIL.;1)
(* ; "
Copyright (c) 1984-1989, 1991-1993, 2021 by Xerox Corporation.
")
(PRETTYCOMPRINT LAFITE-MAILCOMS)
(PRETTYCOMPRINT LAFITEMAILCOMS)
(RPAQQ LAFITEMAILCOMS
(RPAQQ LAFITE-MAILCOMS
((COMS (* ; "Retrieving mail")
(FNS \LAFITE.GETMAIL \LAFITE.GETMAIL.FROM.ICON \LAFITE.GETMAIL.PROC \LAFITE.GETNEWMAIL
\LAFITE.GETNEWMAIL1 \LAFITE.GETNEWMAIL# \LAFITE.RETRIEVEMESSAGES))
@@ -64,7 +63,7 @@ Copyright (c) 1984-1989, 1991-1993, 2021 by Xerox Corporation.
\LAPARSE.TOCFIELDS \LAPARSE.TOFIELD \LAPARSE.SUBJECTFIELD \LAPARSE.DATEFIELD
LAFITE.AFTER.GETMAIL.FN)
(FILES (SOURCE)
LAFITEDECLS)
LAFITE-DECLS)
(LOCALVARS . T))))
@@ -1909,9 +1908,9 @@ Copyright (c) 1984-1989, 1991-1993, 2021 by Xerox Corporation.
("FORMAT:" LAFITE.READ.FORMAT)))
(RPAQQ LA.TOCFIELDS (("DATE:" LAFITE.GRAB.DATE)
("FROM:" LAFITE.READ.LINE.FOR.TOC From)
("SUBJECT:" LAFITE.READ.LINE.FOR.TOC Subject)
("ORIGINAL-FROM:" LAFITE.READ.LINE.FOR.TOC Original-From)))
("FROM:" LAFITE.READ.LINE.FOR.TOC From)
("SUBJECT:" LAFITE.READ.LINE.FOR.TOC Subject)
("ORIGINAL-FROM:" LAFITE.READ.LINE.FOR.TOC Original-From)))
(RPAQQ LA.TOFIELDONLY (("TO:" LAFITE.READ.ONE.LINE.FOR.TOC)))
@@ -2110,39 +2109,37 @@ Copyright (c) 1984-1989, 1991-1993, 2021 by Xerox Corporation.
(FILESLOAD (SOURCE)
LAFITEDECLS)
LAFITE-DECLS)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
)
(PUTPROPS LAFITEMAIL COPYRIGHT ("Xerox Corporation" 1984 1985 1986 1987 1988 1989 1991 1992 1993 2021)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (4395 22354 (\LAFITE.GETMAIL 4405 . 4776) (\LAFITE.GETMAIL.FROM.ICON 4778 . 5126) (
\LAFITE.GETMAIL.PROC 5128 . 5575) (\LAFITE.GETNEWMAIL 5577 . 11919) (\LAFITE.GETNEWMAIL1 11921 . 14653
) (\LAFITE.GETNEWMAIL# 14655 . 15044) (\LAFITE.RETRIEVEMESSAGES 15046 . 22352)) (22401 51381 (
\LAFITE.GET.USER.DATA 22411 . 25245) (\LAFITE.GUESS.MODE 25247 . 27467) (\LAFITE.REGISTER.MODE 27469
. 28728) (LAFITECLEARCACHE 28730 . 29484) (FULLUSERNAME 29486 . 30585) (LAFITE.USER.NAME.FROM.LOGIN
30587 . 32370) (LAFITEMAILWATCH 32372 . 33702) (\LAFITE.WAKE.WATCHER 33704 . 34293) (POLLNEWMAIL 34295
. 47918) (\LAFITE.NEW.MAIL.EXISTS 47920 . 48256) (PRINTLAFITESTATUS 48258 . 50624) (
LAFITE.STATUS.WITH.TIME 50626 . 50930) (\LAFITE.REINITIALIZING 50932 . 51379)) (51417 106191 (
\LAFITE.PARSE.FOLDER 51427 . 52795) (\LAFITE.PARSE.FOLDER1 52797 . 60252) (\LAFITE.HANDLE.DUPLICATES
60254 . 63290) (\LAFITE.CHECK.DUPLICATE 63292 . 64227) (\LAFITE.REPORT.DUPLICATES 64229 . 66114) (
BADMAILFILE 66116 . 74672) (BADMAILFILE.CLOSEFN 74674 . 75002) (BADMAILFILE.FLAGBYTE 75004 . 75202) (
VERIFYMAILFOLDER 75204 . 79775) (VERIFYFAILED 79777 . 79965) (\LAFITE.READ.TOC.FILE 79967 . 93470) (
BADTOCFILE 93472 . 93966) (\LAFITE.TOCEOF 93968 . 94303) (LA.READCOUNT 94305 . 95533) (LA.READSTAMP
95535 . 96078) (LA.PRINTHEADER 96080 . 99402) (LA.PRINTCOUNT 99404 . 99637) (LA.PRINTSTAMP 99639 .
100063) (LA.READSHORTSTRING 100065 . 100832) (LA.PRINTSHORTSTRING 100834 . 101963) (LA.READSTRING
101965 . 102436) (\LAFITE.VERIFYMSG 102438 . 104219) (LA.MSGFROMMEP 104221 . 106189)) (106192 122077 (
LAFITE.PARSE.MSG.FOR.TOC 106202 . 109562) (LAFITE-EXTRACT-REAL-NAME 109564 . 112693) (
LAFITE.FETCH.TO.FIELD 112695 . 113970) (LAFITE.PARSE.HEADER 113972 . 117081) (LAFITE.GRAB.DATE 117083
. 117488) (LAFITE.READ.LINE.FOR.TOC 117490 . 117926) (LAFITE.READ.FORMAT 117928 . 118310) (
LAFITE.READ.NAME.FIELD 118312 . 119345) (LAFITE.READ.ONE.LINE.FOR.TOC 119347 . 119528) (
LAFITE.READ.TO.EOL 119530 . 120460) (LA.SKIP.TO.EOL 120462 . 121797) (LAFITE.SKIP.WHITE.SPACE 121799
. 122075)) (122078 122719 (\LAFITE.PARSE.MESSAGE 122088 . 122717)) (123679 127667 (
LAFITE.INIT.PARSETABLES 123689 . 124200) (LAFITE.MAKE.PARSE.TABLE 124202 . 125172) (
LAFITE.MAKE.PARSE.TABLE1 125174 . 127665)) (127702 132269 (LAFITE.NEW.PARSE.HEADER 127712 . 131321) (
LAFITE.HANDLE.ORIGINAL.FIELD 131323 . 132267)))))
(FILEMAP (NIL (4314 22273 (\LAFITE.GETMAIL 4324 . 4695) (\LAFITE.GETMAIL.FROM.ICON 4697 . 5045) (
\LAFITE.GETMAIL.PROC 5047 . 5494) (\LAFITE.GETNEWMAIL 5496 . 11838) (\LAFITE.GETNEWMAIL1 11840 . 14572
) (\LAFITE.GETNEWMAIL# 14574 . 14963) (\LAFITE.RETRIEVEMESSAGES 14965 . 22271)) (22320 51300 (
\LAFITE.GET.USER.DATA 22330 . 25164) (\LAFITE.GUESS.MODE 25166 . 27386) (\LAFITE.REGISTER.MODE 27388
. 28647) (LAFITECLEARCACHE 28649 . 29403) (FULLUSERNAME 29405 . 30504) (LAFITE.USER.NAME.FROM.LOGIN
30506 . 32289) (LAFITEMAILWATCH 32291 . 33621) (\LAFITE.WAKE.WATCHER 33623 . 34212) (POLLNEWMAIL 34214
. 47837) (\LAFITE.NEW.MAIL.EXISTS 47839 . 48175) (PRINTLAFITESTATUS 48177 . 50543) (
LAFITE.STATUS.WITH.TIME 50545 . 50849) (\LAFITE.REINITIALIZING 50851 . 51298)) (51336 106110 (
\LAFITE.PARSE.FOLDER 51346 . 52714) (\LAFITE.PARSE.FOLDER1 52716 . 60171) (\LAFITE.HANDLE.DUPLICATES
60173 . 63209) (\LAFITE.CHECK.DUPLICATE 63211 . 64146) (\LAFITE.REPORT.DUPLICATES 64148 . 66033) (
BADMAILFILE 66035 . 74591) (BADMAILFILE.CLOSEFN 74593 . 74921) (BADMAILFILE.FLAGBYTE 74923 . 75121) (
VERIFYMAILFOLDER 75123 . 79694) (VERIFYFAILED 79696 . 79884) (\LAFITE.READ.TOC.FILE 79886 . 93389) (
BADTOCFILE 93391 . 93885) (\LAFITE.TOCEOF 93887 . 94222) (LA.READCOUNT 94224 . 95452) (LA.READSTAMP
95454 . 95997) (LA.PRINTHEADER 95999 . 99321) (LA.PRINTCOUNT 99323 . 99556) (LA.PRINTSTAMP 99558 .
99982) (LA.READSHORTSTRING 99984 . 100751) (LA.PRINTSHORTSTRING 100753 . 101882) (LA.READSTRING 101884
. 102355) (\LAFITE.VERIFYMSG 102357 . 104138) (LA.MSGFROMMEP 104140 . 106108)) (106111 121996 (
LAFITE.PARSE.MSG.FOR.TOC 106121 . 109481) (LAFITE-EXTRACT-REAL-NAME 109483 . 112612) (
LAFITE.FETCH.TO.FIELD 112614 . 113889) (LAFITE.PARSE.HEADER 113891 . 117000) (LAFITE.GRAB.DATE 117002
. 117407) (LAFITE.READ.LINE.FOR.TOC 117409 . 117845) (LAFITE.READ.FORMAT 117847 . 118229) (
LAFITE.READ.NAME.FIELD 118231 . 119264) (LAFITE.READ.ONE.LINE.FOR.TOC 119266 . 119447) (
LAFITE.READ.TO.EOL 119449 . 120379) (LA.SKIP.TO.EOL 120381 . 121716) (LAFITE.SKIP.WHITE.SPACE 121718
. 121994)) (121997 122638 (\LAFITE.PARSE.MESSAGE 122007 . 122636)) (123586 127574 (
LAFITE.INIT.PARSETABLES 123596 . 124107) (LAFITE.MAKE.PARSE.TABLE 124109 . 125079) (
LAFITE.MAKE.PARSE.TABLE1 125081 . 127572)) (127609 132176 (LAFITE.NEW.PARSE.HEADER 127619 . 131228) (
LAFITE.HANDLE.ORIGINAL.FIELD 131230 . 132174)))))
STOP

BIN
library/lafite/LAFITEMAIL.LCOM → library/lafite/LAFITE-MAIL.LCOM
View File

Binary file not shown.

46
library/lafite/MAILSCAVENGE → library/lafite/LAFITE-MAILSCAVENGE
View File

@@ -1,25 +1,22 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 7-Feb-2022 12:04:09" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>lafite>MAILSCAVENGE.;4 40080
(FILECREATED "26-Feb-2024 20:13:24" {WMEDLEY}<library>lafite>LAFITE-MAILSCAVENGE.;2 39927
:CHANGES-TO (FNS \MAILSCAVENGE.MAKEWINDOW)
:EDIT-BY rmk
:PREVIOUS-DATE "30-Sep-2021 22:57:39"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>lafite>MAILSCAVENGE.;3)
:CHANGES-TO (VARS LAFITE-MAILSCAVENGECOMS)
(FNS MAILSCAVENGE)
:PREVIOUS-DATE "24-Feb-2024 11:28:52" {WMEDLEY}<library>lafite>LAFITE-SCAVENGE.;1)
(* ; "
Copyright (c) 1985, 1989-1990, 2021 by Venue & Xerox Corporation.
")
(PRETTYCOMPRINT LAFITE-MAILSCAVENGECOMS)
(PRETTYCOMPRINT MAILSCAVENGECOMS)
(RPAQQ MAILSCAVENGECOMS
[(FNS LAFITE.SCAVENGE \MAILSCAVENGE.INTERNAL \MAILSCAVENGE.OPEN.SCRATCH
\MAILSCAVENGE.LENGTHWIDTH \MAILSCAVENGE.LFCOPYBYTES \MAILSCAVENGE.READSTAMP
\MAILSCAVENGE.DUPLICATE? \MAILSCAVENGE.FORMAT \MAILSCAVENGE.MAKEWINDOW
\MAILSCAVENGE.ASKUSER \MAILSCAVENGE.FIX.LENGTHS \MAILSCAVENGE.CONFIRM)
(RPAQQ LAFITE-MAILSCAVENGECOMS
[(FNS MAILSCAVENGE \MAILSCAVENGE.INTERNAL \MAILSCAVENGE.OPEN.SCRATCH \MAILSCAVENGE.LENGTHWIDTH
\MAILSCAVENGE.LFCOPYBYTES \MAILSCAVENGE.READSTAMP \MAILSCAVENGE.DUPLICATE?
\MAILSCAVENGE.FORMAT \MAILSCAVENGE.MAKEWINDOW \MAILSCAVENGE.ASKUSER
\MAILSCAVENGE.FIX.LENGTHS \MAILSCAVENGE.CONFIRM)
(DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (*START*LENGTH 8))
(SPECVARS *FOLDER* *ERRORMSGSTREAM* *EOL*)
(LOCALVARS . T))
@@ -30,11 +27,11 @@ Copyright (c) 1985, 1989-1990, 2021 by Venue & Xerox Corporation.
])
(DEFINEQ
(LAFITE.SCAVENGE
[LAMBDA (FOLDERNAME ERRORMSGSTREAM FORGET?) (* ; "Edited 18-Apr-89 18:19 by bvm")
(MAILSCAVENGE
[LAMBDA (FOLDERNAME ERRORMSGSTREAM FORGET?) (* ; "Edited 18-Apr-89 18:19 by bvm")
(* ;;
 "User entry to the scavenger. If FORGET?, we won't add folder to the list of known folders.")
 "User entry to the scavenger. If FORGET?, we won't add folder to the list of known folders.")
(LET [(FOLDER (LAFITE.OBTAIN.FOLDER (LA.LONGFILENAME FOLDERNAME LAFITEMAIL.EXT)
'INPUT T (AND FORGET? :FORGET]
@@ -654,12 +651,11 @@ Copyright (c) 1985, 1989-1990, 2021 by Venue & Xerox Corporation.
(ADDTOVAR LAMA \MAILSCAVENGE.FORMAT)
)
(PUTPROPS MAILSCAVENGE COPYRIGHT ("Venue & Xerox Corporation" 1985 1989 1990 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1459 39559 (LAFITE.SCAVENGE 1469 . 1991) (\MAILSCAVENGE.INTERNAL 1993 . 28504) (
\MAILSCAVENGE.OPEN.SCRATCH 28506 . 29109) (\MAILSCAVENGE.LENGTHWIDTH 29111 . 29524) (
\MAILSCAVENGE.LFCOPYBYTES 29526 . 30095) (\MAILSCAVENGE.READSTAMP 30097 . 30844) (
\MAILSCAVENGE.DUPLICATE? 30846 . 31547) (\MAILSCAVENGE.FORMAT 31549 . 32376) (\MAILSCAVENGE.MAKEWINDOW
32378 . 34275) (\MAILSCAVENGE.ASKUSER 34277 . 37407) (\MAILSCAVENGE.FIX.LENGTHS 37409 . 38567) (
\MAILSCAVENGE.CONFIRM 38569 . 39557)))))
(FILEMAP (NIL (1387 39490 (MAILSCAVENGE 1397 . 1922) (\MAILSCAVENGE.INTERNAL 1924 . 28435) (
\MAILSCAVENGE.OPEN.SCRATCH 28437 . 29040) (\MAILSCAVENGE.LENGTHWIDTH 29042 . 29455) (
\MAILSCAVENGE.LFCOPYBYTES 29457 . 30026) (\MAILSCAVENGE.READSTAMP 30028 . 30775) (
\MAILSCAVENGE.DUPLICATE? 30777 . 31478) (\MAILSCAVENGE.FORMAT 31480 . 32307) (\MAILSCAVENGE.MAKEWINDOW
32309 . 34206) (\MAILSCAVENGE.ASKUSER 34208 . 37338) (\MAILSCAVENGE.FIX.LENGTHS 37340 . 38498) (
\MAILSCAVENGE.CONFIRM 38500 . 39488)))))
STOP

BIN
library/lafite/MAILSCAVENGE.LCOM → library/lafite/LAFITE-MAILSCAVENGE.LCOM
View File

Binary file not shown.

0
library/lafite/MAILSCAVENGE.TEDIT → library/lafite/LAFITE-MAILSCAVENGE.TEDIT
View File

48
library/lafite/MAILSHARE → library/lafite/LAFITE-MAILSHARE
View File

@@ -1,26 +1,26 @@
(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")
(FILECREATED "20-Feb-87 08:05:52" {IVY}<BLOOMBERG>LISP>MAILSHARE.;1 12250
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
previous date%: "15-Dec-86 10:01:06" {INDIGO}<GSLWS>BASICS>MAILSHARE.;3)
(FILECREATED "23-Feb-2024 23:24:20" {WMEDLEY}<library>lafite>LAFITE-MAILSHARE.;1 12072
:EDIT-BY rmk
:PREVIOUS-DATE "20-Feb-87 08:05:52" {WMEDLEY}<library>lafite>MAILSHARE.;1)
(* "
Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT LAFITE-MAILSHARECOMS)
(PRETTYCOMPRINT MAILSHARECOMS)
(RPAQQ MAILSHARECOMS ((* Menu Functions)
(FNS MASH.TopLevel MASH.CreateFreeMenu MASH.GetMail MASH.Quit MASH.Consistent
MASH.MakeDirectoryName MASH.MakeProfileName MASH.MakeIconWindow)
(* Icon bitmaps)
(BITMAPS MASH.Icon MASH.IconMask)
(* VARS)
(INITVARS (MASH.VALID-HOSTS '(IVY INDIGO PHYLUM ERIS QV CHERRY)))
(GLOBALVARS MASH.VALID-HOSTS)
(ADDVARS (BackgroundMenuCommands (Mail% Share '(MASH.TopLevel)
"Start the Mail Share menu")))
(VARS (BackgroundMenu NIL))))
(RPAQQ LAFITE-MAILSHARECOMS
((* Menu Functions)
(FNS MASH.TopLevel MASH.CreateFreeMenu MASH.GetMail MASH.Quit MASH.Consistent
MASH.MakeDirectoryName MASH.MakeProfileName MASH.MakeIconWindow)
(* Icon bitmaps)
(BITMAPS MASH.Icon MASH.IconMask)
(* VARS)
[INITVARS (MASH.VALID-HOSTS '(IVY INDIGO PHYLUM ERIS QV CHERRY]
(GLOBALVARS MASH.VALID-HOSTS)
(ADDVARS (BackgroundMenuCommands (Mail% Share '(MASH.TopLevel)
"Start the Mail Share menu")))
(VARS (BackgroundMenu NIL))))
@@ -237,12 +237,12 @@ Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
(GLOBALVARS MASH.VALID-HOSTS)
)
(ADDTOVAR BackgroundMenuCommands (Mail% Share '(MASH.TopLevel) "Start the Mail Share menu"))
(ADDTOVAR BackgroundMenuCommands (Mail% Share '(MASH.TopLevel)
"Start the Mail Share menu"))
(RPAQQ BackgroundMenu NIL)
(PUTPROPS MAILSHARE COPYRIGHT ("Xerox Corporation" 1986 1987))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1099 9386 (MASH.TopLevel 1109 . 1795) (MASH.CreateFreeMenu 1797 . 2978) (MASH.GetMail
2980 . 6921) (MASH.Quit 6923 . 7601) (MASH.Consistent 7603 . 8502) (MASH.MakeDirectoryName 8504 . 8783
) (MASH.MakeProfileName 8785 . 9126) (MASH.MakeIconWindow 9128 . 9384)))))
(FILEMAP (NIL (944 9231 (MASH.TopLevel 954 . 1640) (MASH.CreateFreeMenu 1642 . 2823) (MASH.GetMail
2825 . 6766) (MASH.Quit 6768 . 7446) (MASH.Consistent 7448 . 8347) (MASH.MakeDirectoryName 8349 . 8628
) (MASH.MakeProfileName 8630 . 8971) (MASH.MakeIconWindow 8973 . 9229)))))
STOP

BIN
library/lafite/LAFITE-MAILSHARE.LCOM Normal file
View File

Binary file not shown.

190
library/lafite/MIME → library/lafite/LAFITE-MIME
View File

@@ -1,29 +1,28 @@
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED " 3-Aug-2005 09:39:34" {DSK}<project>medley3.5>lispusers>MIME.;42 139917
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
changes to%: (FNS DEMIMEPART)
(FILECREATED "24-Feb-2024 10:05:37" {WMEDLEY}<library>lafite>LAFITE-MIME.;1 140113
previous date%: "28-Jun-2002 16:23:39" {DSK}<project>medley3.5>lispusers>MIME.;41)
:EDIT-BY rmk
:CHANGES-TO (VARS MIMECOMS)
:PREVIOUS-DATE " 3-Aug-2005 09:39:34" {WMEDLEY}<library>lafite>MIME.;1)
(* ; "
Copyright (c) 1998, 1999, 1920, 2000, 2001, 2002, 2005 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT LAFITE-MIMECOMS)
(PRETTYCOMPRINT MIMECOMS)
(RPAQQ MIMECOMS
(RPAQQ LAFITE-MIMECOMS
((FNS DEMIME PARSEMIME DEMIMEPART DEMIMETEXT DEMIMEAPPL MIMEERROR MIMEHEADERS MIMEPARAMS
PARSE-SUNATTACHMENT RECODEMIMEHEADER)
(COMS
(* ;; "Replaces function on LAFITECOMMANDS and LAFITEHARDCOPY, so that MIME objects are decoded in messages. These functions require the LAFITEMSG and MAILFOLDER records to be available:")
(DECLARE%: DONTEVAL@LOAD DONTCOPY EVAL@COMPILE (FILES (LOADCOMP)
LAFITEDECLS))
LAFITE-DECLS))
(FNS LA.COPY.MESSAGE.TEXT \LAFITE.APPEND.MESSAGE.BODY)
(* ;;
 "Replaces function on LAFITEBROWSE, so that browser window interprets different character sets.")
 "Replaces function on LAFITEBROWSE, so that browser window interprets different character sets.")
(FNS PRINTMESSAGESUMMARY.STRING))
(FNS ADDMIMEOBJECT MIMEOBJINIT MIMEOBJ.DISPLAYFN MIMEOBJ.COPYFN MIMEOBJ.BUTTONEVENTINFN
@@ -41,7 +40,7 @@ Copyright (c) 1998, 1999, 1920, 2000, 2001, 2002, 2005 by Xerox Corporation. Al
(GLOBALVARS ATTACHMENTDIR)
[COMS
(* ;;
 "MIMEFASTRECODECHARCODE is a copy of FASTRECODECHARCODED on /project/dict/code/CHARACTERFNS")
 "MIMEFASTRECODECHARCODE is a copy of FASTRECODECHARCODED on /project/dict/code/CHARACTERFNS")
(FNS CACHEMIMECHARRECODEMAPS MIMEFASTRECODECHARCODE MIMERECODEMAP)
(INITVARS (CURRENTCHARENCODING 'XEROX-RENDERING))
@@ -582,7 +581,7 @@ Copyright (c) 1998, 1999, 1920, 2000, 2001, 2002, 2005 by Xerox Corporation. Al
(DECLARE%: DONTEVAL@LOAD DONTCOPY EVAL@COMPILE
(FILESLOAD (LOADCOMP)
LAFITEDECLS)
LAFITE-DECLS)
)
(DEFINEQ
@@ -685,8 +684,8 @@ Copyright (c) 1998, 1999, 1920, 2000, 2001, 2002, 2005 by Xerox Corporation. Al
(* ;;
"Replaces function on LAFITEBROWSE, so that browser window interprets different character sets.")
(* ;; "Replaces function on LAFITEBROWSE, so that browser window interprets different character sets."
)
(DEFINEQ
@@ -1649,84 +1648,83 @@ Copyright (c) 1998, 1999, 1920, 2000, 2001, 2002, 2005 by Xerox Corporation. Al
(DECLARE%: EVAL@COMPILE
(PUTPROPS BINHEXBYTE MACRO
(NIL (IF (EQ REPEAT 0)
THEN [PROG (C C2 REPFLAG)
GETBYTE
[WHILE (MEMB (SETQ C (BIN INSTREAM))
(CHARCODE (CR LF]
(CL:UNLESS (EQ (CHARCODE %:)
C)
[SETQ C (CL:SVREF BINHEXCHARARRAY (- C (CONSTANT (CHCON1 BINHEXCHARS]
(PUTPROPS BINHEXBYTE MACRO
(NIL (IF (EQ REPEAT 0)
THEN [PROG (C C2 REPFLAG)
GETBYTE
[WHILE (MEMB (SETQ C (BIN INSTREAM))
(CHARCODE (CR LF]
(CL:UNLESS (EQ (CHARCODE %:)
C)
[SETQ C (CL:SVREF BINHEXCHARARRAY (- C (CONSTANT (CHCON1
BINHEXCHARS
]
(* ;; "Save byte in C for repetition")
(* ;; "Save byte in C for repetition")
(SETQ C (SELECTQ POS
(0 (* ;
 "Start of byte, used 6 bits from first code, 2 bits from second code, carry over 4 bits")
(SETQ POS 1)
[WHILE (MEMB (SETQ C2 (BIN INSTREAM))
(CHARCODE (CR LF]
(CL:WHEN (EQ (CHARCODE %:)
C2)
(HELP
(SETQ C (SELECTQ POS
(0 (* ;
 "Start of byte, used 6 bits from first code, 2 bits from second code, carry over 4 bits")
(SETQ POS 1)
[WHILE (MEMB (SETQ C2 (BIN INSTREAM))
(CHARCODE (CR LF]
(CL:WHEN (EQ (CHARCODE %:)
C2)
(HELP
"BINHEX FILE TERMINATES IN THE MIDDLE OF A BYTE"
))
[SETQ C2 (CL:SVREF BINHEXCHARARRAY
(- C2 (CONSTANT (CHCON1 BINHEXCHARS]
(SETQ NEXTBYTE (LOGAND 255 (LLSH C2 4)))
(LOGOR (LLSH C 2)
(LRSH C2 4)))
(1 (* ;
 " NEXTBYTE has 4 left-adjusted bits, use 4 bits from current code, save 2 bits")
(SETQ POS 2)
(PROG1 (LOGOR NEXTBYTE (LRSH C 2))
(SETQ NEXTBYTE (LOGAND 255 (LLSH C 6)))))
(2 (* ;
 "NEXTBYTE has 2 left-adjusted bits, use all 6 bits from current code, save nothing")
(SETQ POS 0)
(PROG1 (LOGOR NEXTBYTE C)
(SETQ NEXTBYTE 0)))
NIL))
))
[SETQ C2 (CL:SVREF BINHEXCHARARRAY
(- C2 (CONSTANT (CHCON1 BINHEXCHARS]
(SETQ NEXTBYTE (LOGAND 255 (LLSH C2 4)))
(LOGOR (LLSH C 2)
(LRSH C2 4)))
(1 (* ;
 " NEXTBYTE has 4 left-adjusted bits, use 4 bits from current code, save 2 bits")
(SETQ POS 2)
(PROG1 (LOGOR NEXTBYTE (LRSH C 2))
(SETQ NEXTBYTE (LOGAND 255 (LLSH C 6)))))
(2 (* ;
 "NEXTBYTE has 2 left-adjusted bits, use all 6 bits from current code, save nothing")
(SETQ POS 0)
(PROG1 (LOGOR NEXTBYTE C)
(SETQ NEXTBYTE 0)))
NIL))
(* ;; "144 is hex 90, the repetition mark")
(* ;; "144 is hex 90, the repetition mark")
(IF REPFLAG
THEN
(IF REPFLAG
THEN
(* ;; "C now contains the repetition factor")
(* ;; "C now contains the repetition factor")
(IF (EQ C 0)
THEN (SETQ LASTBYTE 144)
(RETURN 144)
ELSE
(IF (EQ C 0)
THEN (SETQ LASTBYTE 144)
(RETURN 144)
ELSE
(* ;; "We already put out the prefix byte, and now we are putting out one that corresponds to the repeat-mark+number.")
(SETQ REPEAT (- C 2))
(RETURN LASTBYTE))
ELSEIF (EQ C 144)
THEN (SETQ REPFLAG T)
(GO GETBYTE)
ELSE (SETQ LASTBYTE C)
(RETURN C)))]
ELSE (CL:DECF REPEAT)
LASTBYTE)))
(SETQ REPEAT (- C 2))
(RETURN LASTBYTE))
ELSEIF (EQ C 144)
THEN (SETQ REPFLAG T)
(GO GETBYTE)
ELSE (SETQ LASTBYTE C)
(RETURN C)))]
ELSE (CL:DECF REPEAT)
LASTBYTE)))
(PUTPROPS BINHEXWORD MACRO
(NIL (LOGOR (LLSH (BINHEXBYTE)
8)
(BINHEXBYTE))))
(PUTPROPS BINHEXWORD MACRO (NIL (LOGOR (LLSH (BINHEXBYTE)
8)
(BINHEXBYTE))))
(PUTPROPS BINHEXLONG MACRO
(NIL (LOGOR (LLSH (BINHEXWORD)
16)
(BINHEXWORD))))
(PUTPROPS BINHEXLONG MACRO (NIL (LOGOR (LLSH (BINHEXWORD)
16)
(BINHEXWORD))))
)
)
(RPAQ? ATTACHMENTDIR '(CONCAT "{dsk}/tilde/" (L-CASE (USERNAME))
"/attachments"))
"/attachments"))
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS ATTACHMENTDIR)
@@ -1823,9 +1821,8 @@ Copyright (c) 1998, 1999, 1920, 2000, 2001, 2002, 2005 by Xerox Corporation. Al
(RPAQ? CURRENTCHARENCODING 'XEROX-RENDERING)
(RPAQQ CACHEDCHARENCODINGS (ISO8859/1 ISO-8859-1 ISO8859_1 ISO% 8859-1 LATIN1 ISO8859/2
ISO-8859-2 ISO8859_2 LATIN2 CP1252 WINDOWS-1252 CP1250
WINDOWS-1250))
(RPAQQ CACHEDCHARENCODINGS (ISO8859/1 ISO-8859-1 ISO8859_1 ISO% 8859-1 LATIN1 ISO8859/2 ISO-8859-2
ISO8859_2 LATIN2 CP1252 WINDOWS-1252 CP1250 WINDOWS-1250))
@@ -1951,22 +1948,21 @@ Copyright (c) 1998, 1999, 1920, 2000, 2001, 2002, 2005 by Xerox Corporation. Al
(DECLARE%: EVAL@COMPILE
(RECORD MIMEPART (STARTPOS ENDPOS TYPE ENCODING DISPOSITION PARTNUM SUBPARTS)
(RECORD TYPE ((MAINTYPE SUBTYPE) . TYPEPROPS))
(RECORD DISPOSITION ((MAINDISPOSITION SUBDISPOSITION) . DISPOSITIONPROPS)))
(RECORD TYPE ((MAINTYPE SUBTYPE) . TYPEPROPS))
(RECORD DISPOSITION ((MAINDISPOSITION SUBDISPOSITION) . DISPOSITIONPROPS)))
)
)
(PUTPROPS MIME COPYRIGHT ("Xerox Corporation" 1998 1999 1920 2000 2001 2002 2005))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2958 37439 (DEMIME 2968 . 4254) (PARSEMIME 4256 . 12136) (DEMIMEPART 12138 . 15903) (
DEMIMETEXT 15905 . 20315) (DEMIMEAPPL 20317 . 25190) (MIMEERROR 25192 . 25520) (MIMEHEADERS 25522 .
27090) (MIMEPARAMS 27092 . 30800) (PARSE-SUNATTACHMENT 30802 . 33712) (RECODEMIMEHEADER 33714 . 37437)
) (37733 44293 (LA.COPY.MESSAGE.TEXT 37743 . 40444) (\LAFITE.APPEND.MESSAGE.BODY 40446 . 44291)) (
44407 44646 (PRINTMESSAGESUMMARY.STRING 44417 . 44644)) (44647 54572 (ADDMIMEOBJECT 44657 . 46002) (
MIMEOBJINIT 46004 . 46929) (MIMEOBJ.DISPLAYFN 46931 . 48688) (MIMEOBJ.COPYFN 48690 . 49587) (
MIMEOBJ.BUTTONEVENTINFN 49589 . 52996) (MIMEOBJ.IMAGEBOXFN 52998 . 54570)) (54592 64584 (DEPS 54602 .
57677) (FINDPSSEGMENTS 57679 . 59923) (POSTSCRIPTPART 59925 . 64582)) (64585 101169 (STREAMFROMBASE64
64595 . 73017) (STREAMFROMBINHEX 73019 . 78166) (STREAMFROMASCII 78168 . 79197) (
STREAMFROMENRICHEDTEXT 79199 . 86552) (STREAMFROMUUENCODE 86554 . 89507) (STREAMFROMQUOTEDPRINTABLE
89509 . 94702) (STREAMFROMUTF-8 94704 . 101167)) (105793 110524 (CACHEMIMECHARRECODEMAPS 105803 .
107748) (MIMEFASTRECODECHARCODE 107750 . 109231) (MIMERECODEMAP 109233 . 110522)))))
(FILEMAP (NIL (2880 37361 (DEMIME 2890 . 4176) (PARSEMIME 4178 . 12058) (DEMIMEPART 12060 . 15825) (
DEMIMETEXT 15827 . 20237) (DEMIMEAPPL 20239 . 25112) (MIMEERROR 25114 . 25442) (MIMEHEADERS 25444 .
27012) (MIMEPARAMS 27014 . 30722) (PARSE-SUNATTACHMENT 30724 . 33634) (RECODEMIMEHEADER 33636 . 37359)
) (37656 44216 (LA.COPY.MESSAGE.TEXT 37666 . 40367) (\LAFITE.APPEND.MESSAGE.BODY 40369 . 44214)) (
44330 44569 (PRINTMESSAGESUMMARY.STRING 44340 . 44567)) (44570 54495 (ADDMIMEOBJECT 44580 . 45925) (
MIMEOBJINIT 45927 . 46852) (MIMEOBJ.DISPLAYFN 46854 . 48611) (MIMEOBJ.COPYFN 48613 . 49510) (
MIMEOBJ.BUTTONEVENTINFN 49512 . 52919) (MIMEOBJ.IMAGEBOXFN 52921 . 54493)) (54515 64507 (DEPS 54525 .
57600) (FINDPSSEGMENTS 57602 . 59846) (POSTSCRIPTPART 59848 . 64505)) (64508 101092 (STREAMFROMBASE64
64518 . 72940) (STREAMFROMBINHEX 72942 . 78089) (STREAMFROMASCII 78091 . 79120) (
STREAMFROMENRICHEDTEXT 79122 . 86475) (STREAMFROMUUENCODE 86477 . 89430) (STREAMFROMQUOTEDPRINTABLE
89432 . 94625) (STREAMFROMUTF-8 94627 . 101090)) (106123 110854 (CACHEMIMECHARRECODEMAPS 106133 .
108078) (MIMEFASTRECODECHARCODE 108080 . 109561) (MIMERECODEMAP 109563 . 110852)))))
STOP

BIN
library/lafite/LAFITE-MIME.LCOM Normal file
View File

Binary file not shown.

0
library/lafite/MIME.TEDIT → library/lafite/LAFITE-MIME.TEDIT
View File

226
library/lafite/NEWNSMAIL → library/lafite/LAFITE-NEWNSMAIL
View File

@@ -1,18 +1,18 @@
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED " 5-Sep-95 16:43:15" {DSK}<lispcore>lafite>parc-94>NEWNSMAIL.;2 91089
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
changes to%: (VARS NEWNSMAILCOMS)
(FILECREATED "24-Feb-2024 11:59:44" {WMEDLEY}<library>lafite>LAFITE-NEWNSMAIL.;2 95095
previous date%: " 6-Aug-93 17:20:37" {DSK}<lispcore>lafite>parc-94>NEWNSMAIL.;1)
:EDIT-BY rmk
:CHANGES-TO (VARS LAFITE-NEWNSMAILCOMS NEWNSMAILCOMS)
(FNS \NSMAIL.NEW.CHECK)
:PREVIOUS-DATE " 5-Sep-95 16:43:15" {WMEDLEY}<library>lafite>NEWNSMAIL.;1)
(* ; "
Copyright (c) 1989, 1990, 1992, 1993, 1995 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT LAFITE-NEWNSMAILCOMS)
(PRETTYCOMPRINT NEWNSMAILCOMS)
(RPAQQ NEWNSMAILCOMS
(RPAQQ LAFITE-NEWNSMAILCOMS
[(COURIERPROGRAMS NEW.MAILTRANSPORT NEW.INBASKET)
(COMS (* ; "Courier type EnvelopeItem")
(FNS \NS.NEW.READ.ENVELOPE.ITEM \NS.NEW.WRITE.ENVELOPE.ITEM)
@@ -68,20 +68,19 @@ Copyright (c) 1989, 1990, 1992, 1993, 1995 by Xerox Corporation. All rights res
(VARS \NSMAIL.GOOD.BODY.PARTS \NSMAIL.DISCARDABLE.BODY.PARTS)
(GLOBALVARS \NSMAIL.GOOD.BODY.PARTS \NSMAIL.DISCARDABLE.BODY.PARTS)
(ALISTS (LAFITEMODELST NS))
(FILES NSMAIL))
(FILES LAFITE-NSMAIL))
(DECLARE%: EVAL@COMPILE DONTCOPY (LOCALVARS . T)
(RECORDS FORWARD)
(MACROS \NSMAIL.BODY.PART.TYPE)
(GLOBALVARS \NSMAIL.BODY.PART.TYPES \NSMAIL.HEADING.ATTRIBUTES)
[P (CL:PROCLAIM '(CL:SPECIAL *RETRIEVAL-ERROR*]
(FILES (SOURCE)
LAFITEDECLS)
LAFITE-DECLS)
(FILES (LOADCOMP)
NSMAIL ATBL)
LAFITE-NSMAIL ATBL)
(* ; "ATBL has \COMPUTED.FORM macro.")
(CONSTANTS * \NSMAIL.CONTENTS.TYPES)
(* ;
 "This one we need at run time also")
(* ; "This one we need at run time also")
DOCOPY
(VARS \NSMAIL.BODY.PART.TYPES))
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
@@ -106,7 +105,7 @@ Copyright (c) 1989, 1990, 1992, 1993, 1995 by Xerox Corporation. All rights res
(ReportNotAllowed 4)))
(NAME NSNAME)
(RNAME NEW.RNAME (* ;
 "(choice (xns 0 name) (gateway 1 gateway.name))")
 "(choice (xns 0 name) (gateway 1 gateway.name))")
)
(RNAME.LIST (SEQUENCE RNAME))
[GATEWAY.NAME (RECORD (COUNTRY STRING)
@@ -367,8 +366,7 @@ Copyright (c) 1989, 1990, 1992, 1993, 1995 by Xerox Corporation. All rights res
(Converted 15 (SEQUENCE CONVERTED.ITEM))
(AuthenticationLevelOfSender 16 AUTHENTICATION.LEVEL)))
(PUTPROPS NEW.ENVELOPE.ITEM COURIERDEF (\NS.NEW.READ.ENVELOPE.ITEM
\NS.NEW.WRITE.ENVELOPE.ITEM))
(PUTPROPS NEW.ENVELOPE.ITEM COURIERDEF (\NS.NEW.READ.ENVELOPE.ITEM \NS.NEW.WRITE.ENVELOPE.ITEM))
@@ -414,8 +412,7 @@ Copyright (c) 1989, 1990, 1992, 1993, 1995 by Xerox Corporation. All rights res
(BodyOffset 198 LONGCARDINAL)
(LispFormatting 4911 STRING)))
(PUTPROPS HEADING.ATTRIBUTE COURIERDEF (\NS.READ.HEADING.ATTRIBUTE
\NS.WRITE.HEADING.ATTRIBUTE))
(PUTPROPS HEADING.ATTRIBUTE COURIERDEF (\NS.READ.HEADING.ATTRIBUTE \NS.WRITE.HEADING.ATTRIBUTE))
@@ -546,7 +543,7 @@ Copyright (c) 1989, 1990, 1992, 1993, 1995 by Xerox Corporation. All rights res
(RPAQ? \NSMAIL.NEW.SERVER.CACHE )
(RPAQQ *NSMAIL-OP-VECTOR* (NEWNS.POLLNEWMAIL NEWNS.OPENMAILBOX NEWNS.NEXTMESSAGE
NEWNS.RETRIEVEMESSAGE NEWNS.CLOSEMAILBOX))
NEWNS.RETRIEVEMESSAGE NEWNS.CLOSEMAILBOX))
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \NSMAIL.NEW.SERVER.CACHE \NSMAIL.MIN.VP.TYPE \NSMAIL.MAX.VP.TYPE)
@@ -577,8 +574,127 @@ Copyright (c) 1989, 1990, 1992, 1993, 1995 by Xerox Corporation. All rights res
)
(\NSMAIL.NEW.CHECK
(LAMBDA (ADDRESS REGISTEREDNAME CREDENTIALS MAILSERVER STREAM RETURNERRORS) (* ; "Edited 6-Aug-93 16:41 by bvm") (* ;;; "Performs a mail check for user REGISTEREDNAME at ADDRESS, returning INBASKETSTATE if successful, NIL if not. Updates the MAILSTATE of MAILSERVER as appropriate to reflect current SESSION and STATEFIRSTNEW (first new message)") (RESETLST (PROG ((JUSTCHECKING (NULL STREAM)) (STATE (fetch (MAILSERVER MAILSTATE) of MAILSERVER)) SESSION POLLRESULT TIMER) (SETQ SESSION (fetch STATESESSION of STATE)) RETRY (COND ((NULL SESSION) (if JUSTCHECKING then (* ; "Just polling, don't need session") (SETQ POLLRESULT (COURIER.EXPEDITED.CALL ADDRESS \NSMAIL.SOCKET (QUOTE NEW.INBASKET) (QUOTE MAILPOLL) (fetch STATENAME of STATE) (CAR CREDENTIALS) (CDR CREDENTIALS) (QUOTE RETURNERRORS))) (GO GOTRESULT)) (COND ((NULL STREAM) (* ; "Need a real Courier stream for some reason here") (COND ((SETQ STREAM (COURIER.OPEN ADDRESS NIL T (QUOTE NSMAIL))) (RESETSAVE NIL (LIST (QUOTE CLOSEF) STREAM))) (T (RETURN NIL))))) (COND ((EQ (CAR (SETQ SESSION (COURIER.CALL STREAM (QUOTE NEW.INBASKET) (QUOTE LOGON) (fetch STATENAME of STATE) (CAR CREDENTIALS) (CDR CREDENTIALS) (QUOTE RETURNERRORS)))) (QUOTE ERROR)) (GO ERROR))) (* ; "result = (session state anchor)") (SETQ POLLRESULT (CADR SESSION)) (replace STATESESSION of STATE with (SETQ SESSION (CAR SESSION)))) (T (SETQ POLLRESULT (COND ((NULL STREAM) (* ; "Just checking") (COURIER.EXPEDITED.CALL ADDRESS \NSMAIL.SOCKET (QUOTE NEW.INBASKET) (QUOTE MAILCHECK) SESSION (QUOTE RETURNERRORS))) (T (COURIER.CALL STREAM (QUOTE NEW.INBASKET) (QUOTE MAILCHECK) SESSION (QUOTE RETURNERRORS))))))) GOTRESULT (COND ((NULL POLLRESULT) (* ; "Failed somehow") (RETURN NIL)) ((EQ (CAR (LISTP POLLRESULT)) (QUOTE ERROR)) (COND ((EQ (CADR POLLRESULT) (QUOTE SESSION.ERROR)) (* ; "Session timed out, start a new one") (replace STATESESSION of STATE with (SETQ SESSION NIL)) (replace STATEFIRSTNEW of STATE with NIL) (replace STATEOLDLAST of STATE with NIL) (GO RETRY)) (T (SETQ SESSION POLLRESULT) (GO ERROR))))) (replace STATELASTERROR of STATE with NIL) (replace (MAILSERVER CONTINUANCE) of MAILSERVER with NIL) (RETURN (COURIER.FETCH (NEW.INBASKET . STATE) TOTAL of POLLRESULT)) ERROR (if (AND (NOT (EQUAL (CDR SESSION) (QUOTE (CONNECTION.PROBLEM NoResponse)))) (NOT (EQUAL (CDR SESSION) (fetch STATELASTERROR of STATE)))) then (* ;; "Don't bother mentioning the error if it's just a timeout, since mailwatch will handle our NIL response fine. Also don't repeatedly print the same error message.") (replace STATELASTERROR of STATE with (CDR SESSION)) (LET ((ERRMSG (CASE (CADR SESSION) ((REJECT) (* ; "3rd element = reject reason") (LET* ((REASON (CADDR SESSION)) (TYPE (CAR REASON))) (if (AND (EQ TYPE (QUOTE WrongVersionOfService)) (<= (CAADR REASON) 1) (< (CADADR REASON) 2)) then (* ; "Server supports old inbasket, but not new") (PRINTOUT PROMPTWINDOW T T "****Note: " (fetch (MAILSERVER MAILSERVERNAME) of MAILSERVER) " does not support new mail protocols." T) (if (NOT RETURNERRORS) then (RETURN NIL))) TYPE)) ((SERVICE.ERROR ACCESS.ERROR) (* ; "the specific reason is just as informative, and more readable than the whole error.") (CADDR SESSION)) (T (COND (NSWIZARDFLG (HELP SESSION))) (SUBSTRING (CDR SESSION) 2 -2))))) (if RETURNERRORS then (RETURN (CONS (QUOTE ERROR) ERRMSG)) elseif (AND (EQ ERRMSG (QUOTE NoSuchInbasket)) (\NSMAIL.FIX.MAILBOX.LOCATIONS)) then (* ;; "We get this when the server no longer holds this inbox. At this point we have fixed mail servers in NS mode, but there's no good way for us to report the news, so go ahead and return NIL, but set %"continuance%" so that poll will happen again immediately") (replace (MAILSERVER CONTINUANCE) of MAILSERVER with 0) else (LET ((*PRINT-CASE* :UPCASE)) (* ; "Lousy atomic error names...") (CL:FORMAT PROMPTWINDOW "~%%From mail server ~A: ~A" (fetch (MAILSERVER MAILSERVERNAME) of MAILSERVER) (CASE ERRMSG (NoSuchService "Mail service not running") (T ERRMSG))))))) (RETURN NIL))))
)
[LAMBDA (ADDRESS REGISTEREDNAME CREDENTIALS MAILSERVER STREAM RETURNERRORS)
(* ; "Edited 24-Feb-2024 11:54 by rmk")
(* ; "Edited 6-Aug-93 16:41 by bvm")
(* ;;; "Performs a mail check for user REGISTEREDNAME at ADDRESS, returning INBASKETSTATE if successful, NIL if not. Updates the MAILSTATE of MAILSERVER as appropriate to reflect current SESSION and STATEFIRSTNEW (first new message)")
(RESETLST
(PROG ((JUSTCHECKING (NULL STREAM))
(STATE (fetch (MAILSERVER MAILSTATE) of MAILSERVER))
SESSION POLLRESULT TIMER)
(SETQ SESSION (fetch STATESESSION of STATE))
RETRY
[COND
[(NULL SESSION)
(if JUSTCHECKING
then (* ; "Just polling, don't need session")
(SETQ POLLRESULT (COURIER.EXPEDITED.CALL ADDRESS \NSMAIL.SOCKET
'NEW.INBASKET
'MAILPOLL
(fetch STATENAME of STATE)
(CAR CREDENTIALS)
(CDR CREDENTIALS)
'RETURNERRORS))
(GO GOTRESULT))
[COND
((NULL STREAM) (* ;
 "Need a real Courier stream for some reason here")
(COND
((SETQ STREAM (COURIER.OPEN ADDRESS NIL T 'NSMAIL))
(RESETSAVE NIL (LIST 'CLOSEF STREAM)))
(T (RETURN NIL]
(COND
((EQ [CAR (SETQ SESSION (COURIER.CALL STREAM 'NEW.INBASKET 'LOGON
(fetch STATENAME of STATE)
(CAR CREDENTIALS)
(CDR CREDENTIALS)
'RETURNERRORS]
'ERROR)
(GO ERROR))) (* ; "result = (session state anchor)")
(SETQ POLLRESULT (CADR SESSION))
(replace STATESESSION of STATE with (SETQ SESSION (CAR SESSION]
(T (SETQ POLLRESULT (COND
((NULL STREAM) (* ; "Just checking")
(COURIER.EXPEDITED.CALL ADDRESS \NSMAIL.SOCKET
'NEW.INBASKET 'MAILCHECK SESSION 'RETURNERRORS))
(T (COURIER.CALL STREAM 'NEW.INBASKET 'MAILCHECK SESSION
'RETURNERRORS]
GOTRESULT
[COND
((NULL POLLRESULT) (* ; "Failed somehow")
(RETURN NIL))
((EQ (CAR (LISTP POLLRESULT))
'ERROR)
(COND
((EQ (CADR POLLRESULT)
'SESSION.ERROR) (* ;
 "Session timed out, start a new one")
(replace STATESESSION of STATE with (SETQ SESSION NIL))
(replace STATEFIRSTNEW of STATE with NIL)
(replace STATEOLDLAST of STATE with NIL)
(GO RETRY))
(T (SETQ SESSION POLLRESULT)
(GO ERROR]
(replace STATELASTERROR of STATE with NIL)
(replace (MAILSERVER CONTINUANCE) of MAILSERVER with NIL)
(RETURN (COURIER.FETCH (NEW.INBASKET . STATE)
TOTAL of POLLRESULT))
ERROR
[if [AND [NOT (EQUAL (CDR SESSION)
'(CONNECTION.PROBLEM NoResponse]
(NOT (EQUAL (CDR SESSION)
(fetch STATELASTERROR of STATE]
then
(* ;; "Don't bother mentioning the error if it's just a timeout, since mailwatch will handle our NIL response fine. Also don't repeatedly print the same error message.")
(replace STATELASTERROR of STATE with (CDR SESSION))
(LET [(ERRMSG (CASE (CADR SESSION)
((REJECT) (* ; "3rd element = reject reason")
(LET* ((REASON (CADDR SESSION))
(TYPE (CAR REASON)))
(if (AND (EQ TYPE 'WrongVersionOfService)
(<= (CAADR REASON)
1)
(< (CADADR REASON)
2))
then (* ;
 "Server supports old inbasket, but not new")
(PRINTOUT PROMPTWINDOW T T "****Note: "
(fetch (MAILSERVER MAILSERVERNAME)
of MAILSERVER)
" does not support new mail protocols."
T)
(if (NOT RETURNERRORS)
then (RETURN NIL)))
TYPE))
((SERVICE.ERROR ACCESS.ERROR)
(* ;
 "the specific reason is just as informative, and more readable than the whole error.")
(CADDR SESSION))
(T (COND
(NSWIZARDFLG (HELP SESSION)))
(SUBSTRING (CDR SESSION)
2 -2)))]
(if RETURNERRORS
then (RETURN (CONS 'ERROR ERRMSG))
elseif (AND (EQ ERRMSG 'NoSuchInbasket)
(\NSMAIL.FIX.MAILBOX.LOCATIONS))
then
(* ;; "We get this when the server no longer holds this inbox. At this point we have fixed mail servers in NS mode, but there's no good way for us to report the news, so go ahead and return NIL, but set %"continuance%" so that poll will happen again immediately")
(replace (MAILSERVER CONTINUANCE) of MAILSERVER with 0)
else (LET ((*PRINT-CASE* :UPCASE))
(* ; "Lousy atomic error names...")
(CL:FORMAT PROMPTWINDOW "~%%From mail server ~A: ~A"
(fetch (MAILSERVER MAILSERVERNAME) of MAILSERVER)
(CASE ERRMSG
(NoSuchService "Mail service not running")
(T ERRMSG))]
(RETURN NIL)))])
(NEWNS.NEXTMESSAGE
(LAMBDA (MAILBOX) (* ; "Edited 13-Dec-89 17:27 by bvm") (LET ((NEXT (NEW.INBASKET.CALL MAILBOX (QUOTE RETRIEVE.ENVELOPES) (fetch NSMAILLASTINDEX of MAILBOX) (QUOTE NEXT) (fetch NSMAILSESSION of MAILBOX)))) (* ;; "NEXT = (envelope status index)") (DESTRUCTURING-BIND (ENVELOPE STATUS INDEX) NEXT (if (EQ INDEX 0) then (* ; "No more messages") NIL else (replace NSMAILLASTINDEX of MAILBOX with INDEX) (replace NSMAILENVTAIL of MAILBOX with ENVELOPE) (* ; "Success") T))))
@@ -684,17 +800,17 @@ Attachment: " T)) (TERPRI *MSGSTREAM*) (* ; "End header with blank line") (SETQ
(RPAQQ \NSMAIL.GOOD.BODY.PARTS (0 5 6 2))
(RPAQQ \NSMAIL.DISCARDABLE.BODY.PARTS ((201 "Tioga formatting")
(202 "Tioga header")))
(202 "Tioga header")))
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \NSMAIL.GOOD.BODY.PARTS \NSMAIL.DISCARDABLE.BODY.PARTS)
)
(ADDTOVAR LAFITEMODELST (NS 1 \NSMAIL.NEW.SEND.PARSE \NSMAIL.NEW.SEND \NSMAIL.MAKEANSWERFORM
\NSMAIL.NEW.AUTHENTICATE \NSMAIL.MESSAGE.P
\NSMAIL.MESSAGE.FROM.SELF.P \NSMAIL.LOGIN))
\NSMAIL.NEW.AUTHENTICATE \NSMAIL.MESSAGE.P \NSMAIL.MESSAGE.FROM.SELF.P
\NSMAIL.LOGIN))
(FILESLOAD NSMAIL)
(FILESLOAD LAFITE-NSMAIL)
(DECLARE%: EVAL@COMPILE DONTCOPY
(DECLARE%: DOEVAL@COMPILE DONTCOPY
@@ -709,11 +825,10 @@ Attachment: " T)) (TERPRI *MSGSTREAM*) (* ; "End header with blank line") (SETQ
(DECLARE%: EVAL@COMPILE
(PUTPROPS \NSMAIL.BODY.PART.TYPE MACRO [ARGS (COND
((CADR (ASSOC (CAR ARGS)
\NSMAIL.BODY.PART.TYPES)))
(T (ERROR "Unknown body part type"
(CAR ARGS))
'IGNOREMACRO])
((CADR (ASSOC (CAR ARGS)
\NSMAIL.BODY.PART.TYPES)))
(T (ERROR "Unknown body part type" (CAR ARGS))
'IGNOREMACRO])
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
@@ -726,16 +841,16 @@ Attachment: " T)) (TERPRI *MSGSTREAM*) (* ; "End header with blank line") (SETQ
(FILESLOAD (SOURCE)
LAFITEDECLS)
LAFITE-DECLS)
(FILESLOAD (LOADCOMP)
NSMAIL ATBL)
LAFITE-NSMAIL ATBL)
(RPAQQ \NSMAIL.CONTENTS.TYPES ((\CT.NULL 0)
(\CT.STANDARD.MESSAGE 4)
(\CT.REPORT 6)))
(\CT.STANDARD.MESSAGE 4)
(\CT.REPORT 6)))
(DECLARE%: EVAL@COMPILE
(RPAQQ \CT.NULL 0)
@@ -774,26 +889,25 @@ DOCOPY
(ADDTOVAR LAMA NEW.INBASKET.CALL)
)
(PUTPROPS NEWNSMAIL COPYRIGHT ("Xerox Corporation" 1989 1990 1992 1993 1995))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (17944 19459 (\NS.NEW.READ.ENVELOPE.ITEM 17954 . 18719) (\NS.NEW.WRITE.ENVELOPE.ITEM
18721 . 19457)) (20397 22075 (\NS.READ.HEADING.ATTRIBUTE 20407 . 21385) (\NS.WRITE.HEADING.ATTRIBUTE
21387 . 22073)) (23334 24737 (\NSMAIL.READ.RNAME 23344 . 23902) (\NSMAIL.WRITE.RNAME 23904 . 24395) (
\NSMAIL.RNAME.LENGTH 24397 . 24735)) (24841 26915 (RNAME.TO.STRING 24851 . 25030) (X400.NAME.TO.STRING
25032 . 26719) (EQUAL.RNAMES 26721 . 26913)) (26940 46533 (\NSMAIL.NEW.SEND.PARSE 26950 . 29292) (
\NSMAIL.CHECK.ENUMERATION 29294 . 30213) (\NSMAIL.NEW.SEND 30215 . 38707) (
\NSMAIL.NEW.INVALID.RECIPIENTS 38709 . 39290) (\NSMAIL.BUILD.HEADING 39292 . 40591) (
\NSMAIL.POST.BODY.PART 40593 . 42424) (\NSMAIL.NEW.PREPARE.ATTACHMENT 42426 . 44075) (
\NSMAIL.CHECK.ABORT 44077 . 44435) (\NSMAIL.NEW.FINDSERVER 44437 . 45492) (\NSMAIL.NEW.CHECKSERVER
45494 . 46531)) (48707 88661 (\NSMAIL.NEW.AUTHENTICATE 48717 . 49925) (NEWNS.POLLNEWMAIL 49927 . 50242
) (NEWNS.OPENMAILBOX 50244 . 50928) (\NSMAIL.NEW.CHECK 50930 . 54952) (NEWNS.NEXTMESSAGE 54954 . 55448
) (NEWNS.RETRIEVEMESSAGE 55450 . 59314) (\NSMAIL.READ.BODY.PARTS 59316 . 64727) (\NSMAIL.COPY.IA5
64729 . 65478) (\NSMAIL.COPY.NSTEXTFILE 65480 . 67629) (\NSMAIL.READ.HEADING 67631 . 70366) (
\NSMAIL.PARSE.ANNOTATION 70368 . 71102) (\NSMAIL.EMIT.ANNOTATION 71104 . 72372) (LA.TRIM.WHITESPACE
72374 . 72496) (\NSMAIL.READ.FORWARDING 72498 . 73523) (\NSMAIL.NEW.PRINT.HEADING 73525 . 79149) (
\NSMAIL.NEW.PRINT.NAMES 79151 . 80127) (\NSMAIL.EMIT.FORWARDING 80129 . 81963) (\NSMAIL.GDATE 81965 .
82081) (\NSMAIL.TRANSLATE.IP.MESSAGEID 82083 . 82630) (\NSMAIL.MAYBE.QUOTE 82632 . 83270) (NULL.NSNAME
83272 . 83614) (\NSMAIL.HANDLE.DELIVERY.REPORT 83616 . 86647) (\NSMAIL.RECIPIENT.NAME 86649 . 86876)
(NEW.INBASKET.CALL 86878 . 87502) (NEWNS.CLOSEMAILBOX 87504 . 88220) (\NSMAIL.NEW.LOGOFF 88222 . 88659
(FILEMAP (NIL (17902 19417 (\NS.NEW.READ.ENVELOPE.ITEM 17912 . 18677) (\NS.NEW.WRITE.ENVELOPE.ITEM
18679 . 19415)) (20300 21978 (\NS.READ.HEADING.ATTRIBUTE 20310 . 21288) (\NS.WRITE.HEADING.ATTRIBUTE
21290 . 21976)) (23182 24585 (\NSMAIL.READ.RNAME 23192 . 23750) (\NSMAIL.WRITE.RNAME 23752 . 24243) (
\NSMAIL.RNAME.LENGTH 24245 . 24583)) (24689 26763 (RNAME.TO.STRING 24699 . 24878) (X400.NAME.TO.STRING
24880 . 26567) (EQUAL.RNAMES 26569 . 26761)) (26788 46381 (\NSMAIL.NEW.SEND.PARSE 26798 . 29140) (
\NSMAIL.CHECK.ENUMERATION 29142 . 30061) (\NSMAIL.NEW.SEND 30063 . 38555) (
\NSMAIL.NEW.INVALID.RECIPIENTS 38557 . 39138) (\NSMAIL.BUILD.HEADING 39140 . 40439) (
\NSMAIL.POST.BODY.PART 40441 . 42272) (\NSMAIL.NEW.PREPARE.ATTACHMENT 42274 . 43923) (
\NSMAIL.CHECK.ABORT 43925 . 44283) (\NSMAIL.NEW.FINDSERVER 44285 . 45340) (\NSMAIL.NEW.CHECKSERVER
45342 . 46379)) (48551 92848 (\NSMAIL.NEW.AUTHENTICATE 48561 . 49769) (NEWNS.POLLNEWMAIL 49771 . 50086
) (NEWNS.OPENMAILBOX 50088 . 50772) (\NSMAIL.NEW.CHECK 50774 . 59139) (NEWNS.NEXTMESSAGE 59141 . 59635
) (NEWNS.RETRIEVEMESSAGE 59637 . 63501) (\NSMAIL.READ.BODY.PARTS 63503 . 68914) (\NSMAIL.COPY.IA5
68916 . 69665) (\NSMAIL.COPY.NSTEXTFILE 69667 . 71816) (\NSMAIL.READ.HEADING 71818 . 74553) (
\NSMAIL.PARSE.ANNOTATION 74555 . 75289) (\NSMAIL.EMIT.ANNOTATION 75291 . 76559) (LA.TRIM.WHITESPACE
76561 . 76683) (\NSMAIL.READ.FORWARDING 76685 . 77710) (\NSMAIL.NEW.PRINT.HEADING 77712 . 83336) (
\NSMAIL.NEW.PRINT.NAMES 83338 . 84314) (\NSMAIL.EMIT.FORWARDING 84316 . 86150) (\NSMAIL.GDATE 86152 .
86268) (\NSMAIL.TRANSLATE.IP.MESSAGEID 86270 . 86817) (\NSMAIL.MAYBE.QUOTE 86819 . 87457) (NULL.NSNAME
87459 . 87801) (\NSMAIL.HANDLE.DELIVERY.REPORT 87803 . 90834) (\NSMAIL.RECIPIENT.NAME 90836 . 91063)
(NEW.INBASKET.CALL 91065 . 91689) (NEWNS.CLOSEMAILBOX 91691 . 92407) (\NSMAIL.NEW.LOGOFF 92409 . 92846
)))))
STOP

BIN
library/lafite/LAFITE-NEWNSMAIL.LCOM Normal file
View File

Binary file not shown.

117
library/lafite/LAFITE-NOXNSPATCH Normal file
View File

@@ -0,0 +1,117 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "24-Feb-2024 12:03:41" {WMEDLEY}<library>lafite>LAFITE-NOXNSPATCH.;1 7148
:EDIT-BY rmk
:PREVIOUS-DATE "24-Feb-2024 12:02:23" {WMEDLEY}<library>lafite>NOXNSPATCH.;2)
(PRETTYCOMPRINT LAFITE-NOXNSPATCHCOMS)
(RPAQQ LAFITE-NOXNSPATCHCOMS
[
(* ;; "Suppress login/clearinghouse/nsmail if not running XNS. Mail stuff is necessary in order to parse old NS messages in existing folders. User should set NS.USER.NAME to the canonical name (E.g. %"Ronald Kaplan%") before starting Lafite.")
[COMS (* ; "Suppress general XNS access")
(FNS NOXNSLOGIN NOXNSCANONICAL.NSHOSTNAME NOXNSGETCLEARINGHOUSE)
(P (MOVD? 'LOGIN 'XNSLOGIN)
(MOVD 'NOXNSLOGIN 'LOGIN)
(MOVD? '\CANONICAL.NSHOSTNAME 'XNSCANONICAL.NSHOSTNAME)
(MOVD 'NOXNSCANONICAL.NSHOSTNAME '\CANONICAL.NSHOSTNAME)
(MOVD? 'GETCLEARINGHOUSE 'XNSGETCLEARINGHOUSE)
(MOVD 'NOXNSGETCLEARINGHOUSE 'GETCLEARINGHOUSE]
(COMS (* ;
 "Let Unixmail deal with old NS messages when XNS unavailable")
(FNS NOXNSNSMAIL.NEW.AUTHENTICATE NOXNSNSMAIL.MAKEANSWERFORM NOXNSNSMAIL.NEW.SEND
NOXNSNSMAIL.NEW.SEND.PARSE)
(INITVARS (NS.USER.NAME "no NS user name"))
(VARS (LAFITE.USE.ALL.MODES NIL))
(P (MOVD? '\NSMAIL.NEW.AUTHENTICATE 'XNSNSMAIL.NEW.AUTHENTICATE)
(MOVD 'NOXNSNSMAIL.NEW.AUTHENTICATE '\NSMAIL.NEW.AUTHENTICATE)
(MOVD? '\NSMAIL.MAKEANSWERFORM 'XNSNSMAIL.MAKEANSWERFORM)
(MOVD 'NOXNSNSMAIL.MAKEANSWERFORM '\NSMAIL.MAKEANSWERFORM)
(MOVD? '\NSMAIL.NEW.SEND 'XNSNSMAIL.NEW.SEND)
(MOVD 'NOXNSNSMAIL.NEW.SEND '\NSMAIL.NEW.SEND)
(MOVD? '\NSMAIL.NEW.SEND.PARSE 'XNSNSMAIL.NEW.SEND.PARSE)
(MOVD 'NOXNSNSMAIL.NEW.SEND.PARSE '\NSMAIL.NEW.SEND.PARSE))
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
LAFITE-DECLS])
(* ;;
"Suppress login/clearinghouse/nsmail if not running XNS. Mail stuff is necessary in order to parse old NS messages in existing folders. User should set NS.USER.NAME to the canonical name (E.g. %"Ronald Kaplan%") before starting Lafite."
)
(* ; "Suppress general XNS access")
(DEFINEQ
(NOXNSLOGIN
[LAMBDA (HOST FLG DIRECTORY MSG) (* ; "Edited 14-Oct-97 18:38 by rmk:")
(* ;; "Replace login with NOOP Lisp isn't running XNS")
(CL:WHEN (STREQUAL "1" (UNIX-GETENV "LDELISPXNS"))
(XNSLOGIN HOST FLG DIRECTORY MSG])
(NOXNSCANONICAL.NSHOSTNAME
[LAMBDA (HOST) (* ; "Edited 11-Feb-98 14:34 by rmk:")
(* ;; "Replace login with NOOP Lisp isn't running XNS")
(CL:WHEN (STREQUAL "1" (UNIX-GETENV "LDELISPXNS"))
(XNSCANONICAL.NSHOSTNAME HOST])
(NOXNSGETCLEARINGHOUSE
[LAMBDA NIL (* ; "Edited 6-Mar-99 01:15 by rmk:")
(* ;; "Replace login with NOOP Lisp isn't running XNS")
(CL:WHEN (STREQUAL "1" (UNIX-GETENV "LDELISPXNS"))
(XNSGETCLEARINGHOUSE])
)
(MOVD? 'LOGIN 'XNSLOGIN)
(MOVD 'NOXNSLOGIN 'LOGIN)
(MOVD? '\CANONICAL.NSHOSTNAME 'XNSCANONICAL.NSHOSTNAME)
(MOVD 'NOXNSCANONICAL.NSHOSTNAME '\CANONICAL.NSHOSTNAME)
(MOVD? 'GETCLEARINGHOUSE 'XNSGETCLEARINGHOUSE)
(MOVD 'NOXNSGETCLEARINGHOUSE 'GETCLEARINGHOUSE)
(* ; "Let Unixmail deal with old NS messages when XNS unavailable")
(DEFINEQ
(NOXNSNSMAIL.NEW.AUTHENTICATE
[LAMBDA NIL (* ; "Edited 18-Mar-99 10:39 by rmk:")
(* ; "Edited 8-Mar-99 20:59 by rmk:")
(* ; "Edited 6-Mar-99 11:54 by rmk:")
(* ;; "Fake up lafite user data when not running XNS. This permits us to parse old mail folders with NS mesages and detect whether they are from the current user.")
(IF (STREQUAL "1" (UNIX-GETENV "LDELISPXNS"))
THEN (XNSNSMAIL.NEW.AUTHENTICATE)
ELSE (CREATE LAFITEMODEDATA
FULLUSERNAME _ (CONCAT NS.USER.NAME ":" CH.DEFAULT.DOMAIN ":"
CH.DEFAULT.ORGANIZATION)
SHORTUSERNAME _ (UNIX-USERNAME)
UNPACKEDUSERNAME _ (CREATE NSNAME
NSOBJECT _ NS.USER.NAME
NSDOMAIN _ CH.DEFAULT.DOMAIN
NSORGANIZATION _ CH.DEFAULT.ORGANIZATION])
(NOXNSNSMAIL.MAKEANSWERFORM
[LAMBDA (MSGDESCRIPTORS MAILFOLDER) (* ; "Edited 31-Mar-99 17:04 by rmk:")

BIN
library/lafite/LAFITE-NOXNSPATCH.LCOM Normal file
View File

Binary file not shown.

293
library/lafite/NSMAIL → library/lafite/LAFITE-NSMAIL
View File

@@ -1,22 +1,94 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 6-Aug-93 17:14:21" {DSK}<archive>lafite>sources>nsmail.;34 48519
changes to%: (VARS NSMAILCOMS) (FILES LLNSDECLS) (FNS \NSMAIL.MESSAGE.FROM.SELF.P \NSMAIL.PARSE1 \NSMAIL.MAKE.MAILSERVERS)
(FILECREATED "24-Feb-2024 11:55:46" {WMEDLEY}<library>lafite>LAFITE-NSMAIL.;1 51946
previous date%: "26-May-92 11:56:11" {DSK}<archive>lafite>sources>nsmail.;30)
:EDIT-BY rmk
:CHANGES-TO (VARS NSMAILCOMS)
(FNS \NSMAIL.COURIER.OPEN)
:PREVIOUS-DATE "13-Jan-2024 18:26:57" {WMEDLEY}<library>lafite>NSMAIL.;2)
(* ; "
Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1992, 1993 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT LAFITE-NSMAILCOMS)
(PRETTYCOMPRINT NSMAILCOMS)
(RPAQQ LAFITE-NSMAILCOMS
(
(* ;; "Stuff used by both LAFITE-NEWNSMAIL & OLDNSMAIL")
(RPAQQ NSMAILCOMS ((* ;; "Stuff used by both NEWNSMAIL & OLDNSMAIL") (COMS (* ; "Support of authentication") (FNS \NSMAIL.LOGIN NS.FINDMAILBOXES \NSMAIL.MAKE.MAILSERVERS \NSMAIL.FIX.MAILBOX.LOCATIONS)) (COMS (* ; "Utilities") (FNS \NSMAIL.CHECK.SERIALIZED.VERSION \NSMAIL.READ.SERIALIZED.CONTENT \NSMAIL.DISCARD.SERIALIZED.CONTENT \NSMAIL.READ.STRING.AS.STREAM) (* ; "Error handling") (FNS \NSMAIL.COURIER.OPEN \NSMAIL.ERRORHANDLER \NSMAIL.SIGNAL.ERROR) (INITVARS (NSMAILDEBUGFLG) (NSMAIL.HEADER.ORDER (QUOTE (Date Sender From Subject In-Reply-to To cc Message-ID Reply-to))))) (COMS (* ; "Handling attachments as a special kind of image object") (FNS \MAILOBJ.CREATE \MAILOBJ.TYPE.NAME \MAILOBJ.NS.TO.LISP.NAME \MAILOBJ.DISPLAY \MAILOBJ.GET \MAILOBJ.IMAGEBOX \MAILOBJ.PUT \MAILOBJ.INIT) (FNS \MAILOBJ.BUTTONEVENTFN \MAILOBJ.DO.COMMAND \MAILOBJ.HARDCOPY \MAILOBJ.FB \MAILOBJ.PUT.FILE \MAILOBJ.VIEW \MAILOBJ.MUNGE.NAME \MAILOBJ.COPY.BODY \MAILOBJ.EXPAND \MAILOBJ.COPY.CHILD \MAILOBJ.COPY.SEQUENCE \MAILOBJ.EXTRACT.TEXT \MAILOBJ.PARSE.ATTRIBUTES) (ADDVARS (FILING.TYPES (VIEWPOINT 4353) (RES 4428) (XEROX860 5120) (REFERENCE 4427) (MAILFOLDER 4417))) (VARS MAILOBJ.REFERENCE.FIELD) (INITVARS (MAILOBJ.WINDOWOFFSET 16) (MAILOBJ.SKIPCHAR (CHARCODE "."))) (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS MAILOBJ) (CONSTANTS \MAILOBJ.REFERENCE.LAST.FILED)) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\MAILOBJ.INIT) (AND (EQ MAKESYSNAME :LYRIC) (FILESLOAD (SYSLOAD) NSRANDOM))))) (COMS (FNS \NSMAIL.WRITE.ATTRIBUTE) (DECLARE%: EVAL@COMPILE DOCOPY (VARS \NSMAIL.ATTRIBUTES))) (COMS (* ; "sending mail") (FNS \NSMAIL.PARSE.REFERENCE \NSMAIL.EXPAND.DL \NSMAIL.PARSE \NSMAIL.PARSE1 NS.REMOVEDUPLICATES \NSMAIL.GUESS.FILE.TYPE COURIER.WRITE.STREAM.UNSPECIFIED \NSMAIL.SEND.STREAM.AS.STRING) (FILES LAFITEMAIL) (* ; "for LAFITE.MAKE.PARSE.TABLE") (VARS NSMAIL.PARSEFIELDS (\LAPARSE.NSMAIL (LAFITE.MAKE.PARSE.TABLE NSMAIL.PARSEFIELDS))) (GLOBALVARS \LAPARSE.NSMAIL) (INITVARS (NSMAIL.NET.HINT) (*NSMAIL-MAX-NOTE-LENGTH* 8000) (*NSMAIL-CACHE-TIMEOUT* 14400000) (*NSMAIL-GENEROUS-SELF-TEST* T) (LAFITEDL.EXT "DL")) (P (CL:PROCLAIM (QUOTE (GLOBAL NSMAIL.NET.HINT *NSMAIL-MAX-NOTE-LENGTH* *NSMAIL-CACHE-TIMEOUT* *NSMAIL-GENEROUS-SELF-TEST*)))) (FNS \NSMAIL.MESSAGE.P \NSMAIL.MESSAGE.FROM.SELF.P \NSMAIL.MAKEANSWERFORM \NSMAIL.PRINT.NAMES)) (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS NSMAILBOX NSMAILSTATE NSMAILPARSE) (CONSTANTS \NSMAIL.SOCKET \SERIALIZED.FILE.VERSION \SERIALIZED.FILE.VERSIONS \NSMAIL.TEXT.BODYTYPE \NSMAIL.EMPTY.BODYTYPE \NSMAIL.REFERENCE.BODYTYPE MAX.BULK.SEGMENT.LENGTH) (MACROS \NSMAIL.ATTRIBUTE.TYPE \NSMAIL.WRITE.ATTRIBUTE \NSMAIL.WRITE.ATTRIBUTE.MACRO) (PROP INFO \NSMAIL.ATTRIBUTE.TYPE) (GLOBALVARS *NSMAIL-OP-VECTOR* DEFAULTICONFONT FILING.TYPES MAILOBJ.REFERENCE.FIELD MAILOBJ.SKIPCHAR MAILOBJ.WINDOWOFFSET NSMAIL.HEADER.ORDER NSMAIL.NET.HINT NSMAILDEBUGFLG NSPRINT.WATCHERFLG NSWIZARDFLG \MAILOBJ.IMAGEFNS \NSFILING.ATTRIBUTES \NSMAIL.ATTRIBUTES) (FILES (SOURCE) LAFITEDECLS LLNSDECLS) (* ;; "LLNSDECLS to get NSADDRESS, needed by \NSMAIL.SIGNAL.ERROR") (LOCALVARS . T))))
(COMS (* ; "Support of authentication")
(FNS \NSMAIL.LOGIN NS.FINDMAILBOXES \NSMAIL.MAKE.MAILSERVERS
\NSMAIL.FIX.MAILBOX.LOCATIONS))
[COMS (* ; "Utilities")
(FNS \NSMAIL.CHECK.SERIALIZED.VERSION \NSMAIL.READ.SERIALIZED.CONTENT
\NSMAIL.DISCARD.SERIALIZED.CONTENT \NSMAIL.READ.STRING.AS.STREAM)
(* ; "Error handling")
(FNS \NSMAIL.COURIER.OPEN \NSMAIL.ERRORHANDLER \NSMAIL.SIGNAL.ERROR)
(INITVARS (NSMAILDEBUGFLG)
(NSMAIL.HEADER.ORDER '(Date Sender From Subject In-Reply-to To cc Message-ID
Reply-to]
[COMS (* ;
 "Handling attachments as a special kind of image object")
(FNS \MAILOBJ.CREATE \MAILOBJ.TYPE.NAME \MAILOBJ.NS.TO.LISP.NAME \MAILOBJ.DISPLAY
\MAILOBJ.GET \MAILOBJ.IMAGEBOX \MAILOBJ.PUT \MAILOBJ.INIT)
(FNS \MAILOBJ.BUTTONEVENTFN \MAILOBJ.DO.COMMAND \MAILOBJ.HARDCOPY \MAILOBJ.FB
\MAILOBJ.PUT.FILE \MAILOBJ.VIEW \MAILOBJ.MUNGE.NAME \MAILOBJ.COPY.BODY
\MAILOBJ.EXPAND \MAILOBJ.COPY.CHILD \MAILOBJ.COPY.SEQUENCE \MAILOBJ.EXTRACT.TEXT
\MAILOBJ.PARSE.ATTRIBUTES)
(ADDVARS (FILING.TYPES (VIEWPOINT 4353)
(RES 4428)
(XEROX860 5120)
(REFERENCE 4427)
(MAILFOLDER 4417)))
(VARS MAILOBJ.REFERENCE.FIELD)
(INITVARS (MAILOBJ.WINDOWOFFSET 16)
(MAILOBJ.SKIPCHAR (CHARCODE ".")))
(DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS MAILOBJ)
(CONSTANTS \MAILOBJ.REFERENCE.LAST.FILED))
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\MAILOBJ.INIT)
(AND (EQ MAKESYSNAME :LYRIC)
(FILESLOAD (SYSLOAD)
NSRANDOM]
(COMS (FNS \NSMAIL.WRITE.ATTRIBUTE)
(DECLARE%: EVAL@COMPILE DOCOPY (VARS \NSMAIL.ATTRIBUTES)))
(COMS (* ; "sending mail")
(FNS \NSMAIL.PARSE.REFERENCE \NSMAIL.EXPAND.DL \NSMAIL.PARSE \NSMAIL.PARSE1
NS.REMOVEDUPLICATES \NSMAIL.GUESS.FILE.TYPE COURIER.WRITE.STREAM.UNSPECIFIED
\NSMAIL.SEND.STREAM.AS.STRING)
(FILES LAFITE-MAIL)
(* ; "for LAFITE.MAKE.PARSE.TABLE")
(VARS NSMAIL.PARSEFIELDS (\LAPARSE.NSMAIL (LAFITE.MAKE.PARSE.TABLE NSMAIL.PARSEFIELDS))
)
(GLOBALVARS \LAPARSE.NSMAIL)
(INITVARS (NSMAIL.NET.HINT)
(*NSMAIL-MAX-NOTE-LENGTH* 8000)
(*NSMAIL-CACHE-TIMEOUT* 14400000)
(*NSMAIL-GENEROUS-SELF-TEST* T)
(LAFITEDL.EXT "DL"))
[P (CL:PROCLAIM '(GLOBAL NSMAIL.NET.HINT *NSMAIL-MAX-NOTE-LENGTH*
*NSMAIL-CACHE-TIMEOUT* *NSMAIL-GENEROUS-SELF-TEST*]
(FNS \NSMAIL.MESSAGE.P \NSMAIL.MESSAGE.FROM.SELF.P \NSMAIL.MAKEANSWERFORM
\NSMAIL.PRINT.NAMES))
(DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS NSMAILBOX NSMAILSTATE NSMAILPARSE)
(CONSTANTS \NSMAIL.SOCKET \SERIALIZED.FILE.VERSION \SERIALIZED.FILE.VERSIONS
\NSMAIL.TEXT.BODYTYPE \NSMAIL.EMPTY.BODYTYPE \NSMAIL.REFERENCE.BODYTYPE
MAX.BULK.SEGMENT.LENGTH)
(MACROS \NSMAIL.ATTRIBUTE.TYPE \NSMAIL.WRITE.ATTRIBUTE \NSMAIL.WRITE.ATTRIBUTE.MACRO)
(PROP INFO \NSMAIL.ATTRIBUTE.TYPE)
(GLOBALVARS *NSMAIL-OP-VECTOR* DEFAULTICONFONT FILING.TYPES MAILOBJ.REFERENCE.FIELD
MAILOBJ.SKIPCHAR MAILOBJ.WINDOWOFFSET NSMAIL.HEADER.ORDER NSMAIL.NET.HINT
NSMAILDEBUGFLG NSPRINT.WATCHERFLG NSWIZARDFLG \MAILOBJ.IMAGEFNS
\NSFILING.ATTRIBUTES \NSMAIL.ATTRIBUTES)
(FILES (SOURCE)
LAFITE-DECLS LLNSDECLS)
(* ;; "LLNSDECLS to get NSADDRESS, needed by \NSMAIL.SIGNAL.ERROR")
(LOCALVARS . T))))
(* ;; "Stuff used by both NEWNSMAIL & OLDNSMAIL")
(* ;; "Stuff used by both LAFITE-NEWNSMAIL & OLDNSMAIL")
@@ -61,8 +133,16 @@ RETURN to attempt retrieval anyway." V))))))
)
(\NSMAIL.READ.STRING.AS.STREAM
(LAMBDA (INSTREAM OUTSTREAM) (* bvm%: "30-Jul-84 16:13") (* ;; "Considers INSTREAM to be positioned at a sequence of unspecified, and reads it as if its datatype were string, and copies said bytes to OUTSTREAM") (PROG (LENGTH) (\WIN INSTREAM) (* ; "Skip sequence count") (COPYBYTES INSTREAM OUTSTREAM (SETQ LENGTH (\WIN INSTREAM))) (COND ((ODDP LENGTH) (\BIN INSTREAM)))))
)
[LAMBDA (INSTREAM OUTSTREAM) (* bvm%: "30-Jul-84 16:13")
(* ;; "Considers INSTREAM to be positioned at a sequence of unspecified, and reads it as if its datatype were string, and copies said bytes to OUTSTREAM")
(PROG (LENGTH)
(\WIN INSTREAM) (* ; "Skip sequence count")
(COPYBYTES INSTREAM OUTSTREAM (SETQ LENGTH (\WIN INSTREAM)))
(COND
((ODDP LENGTH)
(\BIN INSTREAM])
)
@@ -72,8 +152,10 @@ RETURN to attempt retrieval anyway." V))))))
(DEFINEQ
(\NSMAIL.COURIER.OPEN
(LAMBDA (ADDRESS) (* ; "Edited 9-Sep-88 12:06 by bvm") (COURIER.OPEN ADDRESS NIL T (QUOTE NSMAIL) NIL (CONSTANT (LIST (QUOTE ERRORHANDLER) (FUNCTION \NSMAIL.ERRORHANDLER)))))
)
[LAMBDA (ADDRESS) (* ; "Edited 24-Feb-2024 11:52 by rmk")
(* ; "Edited 9-Sep-88 12:06 by bvm")
(COURIER.OPEN ADDRESS NIL T 'LAFITE-NSMAIL NIL (CONSTANT (LIST 'ERRORHANDLER
(FUNCTION \NSMAIL.ERRORHANDLER])
(\NSMAIL.ERRORHANDLER
(LAMBDA (STREAM ERRCODE) (* ; "Edited 9-Sep-88 12:35 by bvm") (* ;; "Called when SPP error occurs on NS mail courier connection STREAM. Fakes an error return from the courier.call.") (LET (POS) (if (AND (EQ ERRCODE (QUOTE STREAM.LOST)) (SETQ POS (STKPOS (FUNCTION COURIER.CALL)))) then (BLOCK 500) (RETFROM POS (QUOTE (ERROR STREAM.LOST)) T) else (\SPP.DEFAULT.ERRORHANDLER STREAM ERRCODE))))
@@ -84,9 +166,9 @@ RETURN to attempt retrieval anyway." V))))))
)
)
(RPAQ? NSMAILDEBUGFLG)
(RPAQ? NSMAILDEBUGFLG )
(RPAQ? NSMAIL.HEADER.ORDER (QUOTE (Date Sender From Subject In-Reply-to To cc Message-ID Reply-to)))
(RPAQ? NSMAIL.HEADER.ORDER '(Date Sender From Subject In-Reply-to To cc Message-ID Reply-to))
@@ -181,23 +263,38 @@ RETURN to attempt retrieval anyway." V))))))
)
)
(ADDTOVAR FILING.TYPES (VIEWPOINT 4353) (RES 4428) (XEROX860 5120) (REFERENCE 4427) (MAILFOLDER 4417))
(ADDTOVAR FILING.TYPES (VIEWPOINT 4353)
(RES 4428)
(XEROX860 5120)
(REFERENCE 4427)
(MAILFOLDER 4417))
(RPAQQ MAILOBJ.REFERENCE.FIELD (REFERENCE 4421 (NAMEDRECORD (FILE.ID (FILING . FILE.ID)) (SERVICE NSNAME) (ADDRESS NSADDRESS) (HOST STRING) (DIRECTORY STRING) (NAME STRING) (TYPE (FILING . ATTRIBUTE.TYPE)) (NIL UNSPECIFIED) (PAGES CARDINAL) (VERSION CARDINAL) (FLAGS CARDINAL))))
(RPAQQ MAILOBJ.REFERENCE.FIELD
(REFERENCE 4421 (NAMEDRECORD (FILE.ID (FILING . FILE.ID))
(SERVICE NSNAME)
(ADDRESS NSADDRESS)
(HOST STRING)
(DIRECTORY STRING)
(NAME STRING)
(TYPE (FILING . ATTRIBUTE.TYPE))
(NIL UNSPECIFIED)
(PAGES CARDINAL)
(VERSION CARDINAL)
(FLAGS CARDINAL))))
(RPAQ? MAILOBJ.WINDOWOFFSET 16)
(RPAQ? MAILOBJ.WINDOWOFFSET 16)
(RPAQ? MAILOBJ.SKIPCHAR (CHARCODE "."))
(RPAQ? MAILOBJ.SKIPCHAR (CHARCODE "."))
(DECLARE%: EVAL@COMPILE DONTCOPY
(DECLARE%: EVAL@COMPILE
(RECORD MAILOBJ (MAILOBJ.IMAGE MAILOBJ.BOX MAILOBJ.TYPE MAILOBJ.DATA MAILOBJ.ATTR.LENGTH MAILOBJ.START MAILOBJ.NAME MAILOBJ.EXPANDABLE . MAILOBJ.INFO)
)
(RECORD MAILOBJ (MAILOBJ.IMAGE MAILOBJ.BOX MAILOBJ.TYPE MAILOBJ.DATA MAILOBJ.ATTR.LENGTH
MAILOBJ.START MAILOBJ.NAME MAILOBJ.EXPANDABLE . MAILOBJ.INFO))
)
(DECLARE%: EVAL@COMPILE
(RPAQQ \MAILOBJ.REFERENCE.LAST.FILED 8192)
(RPAQQ \MAILOBJ.REFERENCE.LAST.FILED 8192)
(CONSTANTS \MAILOBJ.REFERENCE.LAST.FILED)
@@ -205,9 +302,11 @@ RETURN to attempt retrieval anyway." V))))))
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(\MAILOBJ.INIT)
(\MAILOBJ.INIT)
(AND (EQ MAKESYSNAME :LYRIC) (FILESLOAD (SYSLOAD) NSRANDOM))
(AND (EQ MAKESYSNAME :LYRIC)
(FILESLOAD (SYSLOAD)
NSRANDOM))
)
(DEFINEQ
@@ -217,7 +316,21 @@ RETURN to attempt retrieval anyway." V))))))
)
(DECLARE%: EVAL@COMPILE DOCOPY
(RPAQQ \NSMAIL.ATTRIBUTES ((From 4672 NAME.LIST) (Date 4673 TIME) (Reply-to 4674 NAME.LIST) (To 4676 NAME.LIST) (cc 4677 NAME.LIST) (Subject 9 STRING) (Message-ID 4693 MESSAGEID) (Sender 4705 NAME) (BodySize 16 LONGCARDINAL) (BodyType 17 LONGCARDINAL) (Note 4687 STRING) (OldLispFormatting 4910 STRING) (LispFormatting 4911 STRING) (In-Reply-to 4690 STRING)))
(RPAQQ \NSMAIL.ATTRIBUTES
((From 4672 NAME.LIST)
(Date 4673 TIME)
(Reply-to 4674 NAME.LIST)
(To 4676 NAME.LIST)
(cc 4677 NAME.LIST)
(Subject 9 STRING)
(Message-ID 4693 MESSAGEID)
(Sender 4705 NAME)
(BodySize 16 LONGCARDINAL)
(BodyType 17 LONGCARDINAL)
(Note 4687 STRING)
(OldLispFormatting 4910 STRING)
(LispFormatting 4911 STRING)
(In-Reply-to 4690 STRING)))
)
@@ -259,32 +372,47 @@ RETURN to attempt retrieval anyway." V))))))
)
)
(FILESLOAD LAFITEMAIL)
(FILESLOAD LAFITE-MAIL)
(* ; "for LAFITE.MAKE.PARSE.TABLE")
(RPAQQ NSMAIL.PARSEFIELDS (("DATE:" LAFITE.READ.LINE.FOR.TOC Date) ("SUBJECT:" LAFITE.READ.LINE.FOR.TOC Subject) ("SENDER:" LAFITE.READ.NAME.FIELD Sender) ("FROM:" LAFITE.READ.NAME.FIELD From) ("REPLY-TO:" LAFITE.READ.NAME.FIELD Reply-to) ("IN-REPLY-TO:" LAFITE.READ.LINE.FOR.TOC In-Reply-to) ("TO:" LAFITE.READ.NAME.FIELD To) ("CC:" LAFITE.READ.NAME.FIELD cc) ("FORMAT:" LAFITE.READ.FORMAT) ("ATTACHED-REFERENCE:" LAFITE.READ.LINE.FOR.TOC REFERENCE) ("ATTACHED-FILE:" LAFITE.READ.LINE.FOR.TOC ATTACHMENT) ("Importance:" LAFITE.READ.LINE.FOR.TOC Importance) ("Sensitivity:" LAFITE.READ.LINE.FOR.TOC Sensitivity) ("Immutable:" LAFITE.READ.LINE.FOR.TOC Immutable)))
(RPAQQ NSMAIL.PARSEFIELDS
(("DATE:" LAFITE.READ.LINE.FOR.TOC Date)
("SUBJECT:" LAFITE.READ.LINE.FOR.TOC Subject)
("SENDER:" LAFITE.READ.NAME.FIELD Sender)
("FROM:" LAFITE.READ.NAME.FIELD From)
("REPLY-TO:" LAFITE.READ.NAME.FIELD Reply-to)
("IN-REPLY-TO:" LAFITE.READ.LINE.FOR.TOC In-Reply-to)
("TO:" LAFITE.READ.NAME.FIELD To)
("CC:" LAFITE.READ.NAME.FIELD cc)
("FORMAT:" LAFITE.READ.FORMAT)
("ATTACHED-REFERENCE:" LAFITE.READ.LINE.FOR.TOC REFERENCE)
("ATTACHED-FILE:" LAFITE.READ.LINE.FOR.TOC ATTACHMENT)
("Importance:" LAFITE.READ.LINE.FOR.TOC Importance)
("Sensitivity:" LAFITE.READ.LINE.FOR.TOC Sensitivity)
("Immutable:" LAFITE.READ.LINE.FOR.TOC Immutable)))
(RPAQ \LAPARSE.NSMAIL (LAFITE.MAKE.PARSE.TABLE NSMAIL.PARSEFIELDS))
(RPAQ \LAPARSE.NSMAIL (LAFITE.MAKE.PARSE.TABLE NSMAIL.PARSEFIELDS))
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \LAPARSE.NSMAIL)
)
(RPAQ? NSMAIL.NET.HINT)
(RPAQ? NSMAIL.NET.HINT )
(RPAQ? *NSMAIL-MAX-NOTE-LENGTH* 8000)
(RPAQ? *NSMAIL-MAX-NOTE-LENGTH* 8000)
(RPAQ? *NSMAIL-CACHE-TIMEOUT* 14400000)
(RPAQ? *NSMAIL-CACHE-TIMEOUT* 14400000)
(RPAQ? *NSMAIL-GENEROUS-SELF-TEST* T)
(RPAQ? *NSMAIL-GENEROUS-SELF-TEST* T)
(RPAQ? LAFITEDL.EXT "DL")
(RPAQ? LAFITEDL.EXT "DL")
(CL:PROCLAIM (QUOTE (GLOBAL NSMAIL.NET.HINT *NSMAIL-MAX-NOTE-LENGTH* *NSMAIL-CACHE-TIMEOUT* *NSMAIL-GENEROUS-SELF-TEST*)))
(CL:PROCLAIM '(GLOBAL NSMAIL.NET.HINT *NSMAIL-MAX-NOTE-LENGTH* *NSMAIL-CACHE-TIMEOUT*
*NSMAIL-GENEROUS-SELF-TEST*))
(DEFINEQ
(\NSMAIL.MESSAGE.P
@@ -306,79 +434,100 @@ RETURN to attempt retrieval anyway." V))))))
(DECLARE%: EVAL@COMPILE DONTCOPY
(DECLARE%: EVAL@COMPILE
(RECORD NSMAILBOX (NSMAILSTREAM NSMAILENVTAIL NSMAILENVELOPES NSMAILLASTINDEX . NSMAILSTATE) (ACCESSFNS NSMAILBOX ((NSMAILSESSION (fetch STATESESSION of (fetch NSMAILSTATE of DATUM))) (NSMAILFIRSTINDEX (fetch STATEFIRSTNEW of (fetch NSMAILSTATE of DATUM)))))
)
(RECORD NSMAILBOX (NSMAILSTREAM NSMAILENVTAIL NSMAILENVELOPES NSMAILLASTINDEX . NSMAILSTATE)
[ACCESSFNS NSMAILBOX ((NSMAILSESSION (fetch STATESESSION
of (fetch NSMAILSTATE of DATUM)))
(NSMAILFIRSTINDEX (fetch STATEFIRSTNEW
of (fetch NSMAILSTATE of DATUM])
(RECORD NSMAILSTATE (STATESESSION STATEFIRSTNEW STATEOLDLAST STATENAME STATECREDENTIALS STATEADDRESS STATELASTERROR STATETIMER)
)
(RECORD NSMAILSTATE (STATESESSION STATEFIRSTNEW STATEOLDLAST STATENAME STATECREDENTIALS STATEADDRESS
STATELASTERROR STATETIMER))
(RECORD NSMAILPARSE (NSPSUBJECT NSPRECIPIENTS NSPSTART NSPFORMATTED . NSPFIELDS))
)
(DECLARE%: EVAL@COMPILE
(RPAQQ \NSMAIL.SOCKET 26)
(RPAQQ \NSMAIL.SOCKET 26)
(RPAQQ \SERIALIZED.FILE.VERSION 2)
(RPAQQ \SERIALIZED.FILE.VERSION 2)
(RPAQQ \SERIALIZED.FILE.VERSIONS (2 3))
(RPAQQ \SERIALIZED.FILE.VERSIONS (2 3))
(RPAQQ \NSMAIL.TEXT.BODYTYPE 2)
(RPAQQ \NSMAIL.TEXT.BODYTYPE 2)
(RPAQQ \NSMAIL.EMPTY.BODYTYPE 4)
(RPAQQ \NSMAIL.EMPTY.BODYTYPE 4)
(RPAQQ \NSMAIL.REFERENCE.BODYTYPE 4427)
(RPAQQ \NSMAIL.REFERENCE.BODYTYPE 4427)
(RPAQQ MAX.BULK.SEGMENT.LENGTH 32768)
(RPAQQ MAX.BULK.SEGMENT.LENGTH 32768)
(CONSTANTS \NSMAIL.SOCKET \SERIALIZED.FILE.VERSION \SERIALIZED.FILE.VERSIONS \NSMAIL.TEXT.BODYTYPE \NSMAIL.EMPTY.BODYTYPE \NSMAIL.REFERENCE.BODYTYPE MAX.BULK.SEGMENT.LENGTH)
(CONSTANTS \NSMAIL.SOCKET \SERIALIZED.FILE.VERSION \SERIALIZED.FILE.VERSIONS \NSMAIL.TEXT.BODYTYPE
\NSMAIL.EMPTY.BODYTYPE \NSMAIL.REFERENCE.BODYTYPE MAX.BULK.SEGMENT.LENGTH)
)
(DECLARE%: EVAL@COMPILE
(PUTPROPS \NSMAIL.ATTRIBUTE.TYPE MACRO (ARGS (COND ((CADR (ASSOC (CAR ARGS) \NSMAIL.ATTRIBUTES))) (T (ERROR "Unknown mail attribute" (CAR ARGS)) (QUOTE IGNOREMACRO)))))
(PUTPROPS \NSMAIL.ATTRIBUTE.TYPE MACRO [ARGS (COND
((CADR (ASSOC (CAR ARGS)
\NSMAIL.ATTRIBUTES)))
(T (ERROR "Unknown mail attribute" (CAR ARGS))
'IGNOREMACRO])
(PUTPROPS \NSMAIL.WRITE.ATTRIBUTE MACRO (ARGS (LET ((INFO (CDR (ASSOC (CAR (CONSTANTEXPRESSIONP (CADR ARGS))) \NSMAIL.ATTRIBUTES)))) (COND (INFO (LIST (QUOTE \NSMAIL.WRITE.ATTRIBUTE.MACRO) (CAR ARGS) (CAR INFO) (CADDR ARGS) (KWOTE (CADR INFO)))) (T (QUOTE IGNOREMACRO))))))
(PUTPROPS \NSMAIL.WRITE.ATTRIBUTE MACRO
[ARGS (LET [(INFO (CDR (ASSOC (CAR (CONSTANTEXPRESSIONP (CADR ARGS)))
\NSMAIL.ATTRIBUTES]
(COND
[INFO (LIST '\NSMAIL.WRITE.ATTRIBUTE.MACRO (CAR ARGS)
(CAR INFO)
(CADDR ARGS)
(KWOTE (CADR INFO]
(T 'IGNOREMACRO])
(PUTPROPS \NSMAIL.WRITE.ATTRIBUTE.MACRO MACRO (OPENLAMBDA (STREAM TYPENO VALUE VALUETYPE) (COURIER.WRITE STREAM TYPENO NIL (QUOTE LONGCARDINAL)) (COURIER.WRITE.SEQUENCE.UNSPECIFIED STREAM VALUE (QUOTE MAILTRANSPORT) VALUETYPE)))
(PUTPROPS \NSMAIL.WRITE.ATTRIBUTE.MACRO MACRO (OPENLAMBDA (STREAM TYPENO VALUE VALUETYPE)
(COURIER.WRITE STREAM TYPENO NIL 'LONGCARDINAL)
(COURIER.WRITE.SEQUENCE.UNSPECIFIED STREAM VALUE
'MAILTRANSPORT VALUETYPE)))
)
(PUTPROPS \NSMAIL.ATTRIBUTE.TYPE INFO NOEVAL)
(PUTPROPS \NSMAIL.ATTRIBUTE.TYPE INFO NOEVAL)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS *NSMAIL-OP-VECTOR* DEFAULTICONFONT FILING.TYPES MAILOBJ.REFERENCE.FIELD MAILOBJ.SKIPCHAR MAILOBJ.WINDOWOFFSET NSMAIL.HEADER.ORDER NSMAIL.NET.HINT NSMAILDEBUGFLG NSPRINT.WATCHERFLG NSWIZARDFLG \MAILOBJ.IMAGEFNS \NSFILING.ATTRIBUTES \NSMAIL.ATTRIBUTES)
(GLOBALVARS *NSMAIL-OP-VECTOR* DEFAULTICONFONT FILING.TYPES MAILOBJ.REFERENCE.FIELD MAILOBJ.SKIPCHAR
MAILOBJ.WINDOWOFFSET NSMAIL.HEADER.ORDER NSMAIL.NET.HINT NSMAILDEBUGFLG NSPRINT.WATCHERFLG
NSWIZARDFLG \MAILOBJ.IMAGEFNS \NSFILING.ATTRIBUTES \NSMAIL.ATTRIBUTES)
)
(FILESLOAD (SOURCE) LAFITEDECLS LLNSDECLS)
(FILESLOAD (SOURCE)
LAFITE-DECLS LLNSDECLS)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
)
(PUTPROPS NSMAIL COPYRIGHT ("Xerox Corporation" 1984 1985 1986 1987 1988 1989 1990 1992 1993))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3699 7008 (\NSMAIL.LOGIN 3709 . 3935) (NS.FINDMAILBOXES 3937 . 4394) (
\NSMAIL.MAKE.MAILSERVERS 4396 . 5190) (\NSMAIL.FIX.MAILBOX.LOCATIONS 5192 . 7006)) (7035 9116 (
\NSMAIL.CHECK.SERIALIZED.VERSION 7045 . 7358) (\NSMAIL.READ.SERIALIZED.CONTENT 7360 . 8254) (
\NSMAIL.DISCARD.SERIALIZED.CONTENT 8256 . 8703) (\NSMAIL.READ.STRING.AS.STREAM 8705 . 9114)) (9148
10549 (\NSMAIL.COURIER.OPEN 9158 . 9361) (\NSMAIL.ERRORHANDLER 9363 . 9785) (\NSMAIL.SIGNAL.ERROR 9787
. 10547)) (10747 16949 (\MAILOBJ.CREATE 10757 . 12982) (\MAILOBJ.TYPE.NAME 12984 . 13451) (
\MAILOBJ.NS.TO.LISP.NAME 13453 . 14804) (\MAILOBJ.DISPLAY 14806 . 15126) (\MAILOBJ.GET 15128 . 15951)
(\MAILOBJ.IMAGEBOX 15953 . 16081) (\MAILOBJ.PUT 16083 . 16669) (\MAILOBJ.INIT 16671 . 16947)) (16950
31846 (\MAILOBJ.BUTTONEVENTFN 16960 . 19089) (\MAILOBJ.DO.COMMAND 19091 . 19338) (\MAILOBJ.HARDCOPY
19340 . 21146) (\MAILOBJ.FB 21148 . 21362) (\MAILOBJ.PUT.FILE 21364 . 23029) (\MAILOBJ.VIEW 23031 .
25968) (\MAILOBJ.MUNGE.NAME 25970 . 26234) (\MAILOBJ.COPY.BODY 26236 . 26550) (\MAILOBJ.EXPAND 26552
. 28273) (\MAILOBJ.COPY.CHILD 28275 . 29632) (\MAILOBJ.COPY.SEQUENCE 29634 . 30002) (
\MAILOBJ.EXTRACT.TEXT 30004 . 31065) (\MAILOBJ.PARSE.ATTRIBUTES 31067 . 31844)) (32756 33393 (
\NSMAIL.WRITE.ATTRIBUTE 32766 . 33391)) (33818 40701 (\NSMAIL.PARSE.REFERENCE 33828 . 35746) (
\NSMAIL.EXPAND.DL 35748 . 36815) (\NSMAIL.PARSE 36817 . 37078) (\NSMAIL.PARSE1 37080 . 38288) (
NS.REMOVEDUPLICATES 38290 . 38428) (\NSMAIL.GUESS.FILE.TYPE 38430 . 38931) (
COURIER.WRITE.STREAM.UNSPECIFIED 38933 . 40077) (\NSMAIL.SEND.STREAM.AS.STRING 40079 . 40699)) (41866
46243 (\NSMAIL.MESSAGE.P 41876 . 42014) (\NSMAIL.MESSAGE.FROM.SELF.P 42016 . 43715) (
\NSMAIL.MAKEANSWERFORM 43717 . 45341) (\NSMAIL.PRINT.NAMES 45343 . 46241)))))
(FILEMAP (NIL (5263 8572 (\NSMAIL.LOGIN 5273 . 5499) (NS.FINDMAILBOXES 5501 . 5958) (
\NSMAIL.MAKE.MAILSERVERS 5960 . 6754) (\NSMAIL.FIX.MAILBOX.LOCATIONS 6756 . 8570)) (8599 10821 (
\NSMAIL.CHECK.SERIALIZED.VERSION 8609 . 8922) (\NSMAIL.READ.SERIALIZED.CONTENT 8924 . 9818) (
\NSMAIL.DISCARD.SERIALIZED.CONTENT 9820 . 10267) (\NSMAIL.READ.STRING.AS.STREAM 10269 . 10819)) (10853
12473 (\NSMAIL.COURIER.OPEN 10863 . 11285) (\NSMAIL.ERRORHANDLER 11287 . 11709) (\NSMAIL.SIGNAL.ERROR
11711 . 12471)) (12673 18875 (\MAILOBJ.CREATE 12683 . 14908) (\MAILOBJ.TYPE.NAME 14910 . 15377) (
\MAILOBJ.NS.TO.LISP.NAME 15379 . 16730) (\MAILOBJ.DISPLAY 16732 . 17052) (\MAILOBJ.GET 17054 . 17877)
(\MAILOBJ.IMAGEBOX 17879 . 18007) (\MAILOBJ.PUT 18009 . 18595) (\MAILOBJ.INIT 18597 . 18873)) (18876
33772 (\MAILOBJ.BUTTONEVENTFN 18886 . 21015) (\MAILOBJ.DO.COMMAND 21017 . 21264) (\MAILOBJ.HARDCOPY
21266 . 23072) (\MAILOBJ.FB 23074 . 23288) (\MAILOBJ.PUT.FILE 23290 . 24955) (\MAILOBJ.VIEW 24957 .
27894) (\MAILOBJ.MUNGE.NAME 27896 . 28160) (\MAILOBJ.COPY.BODY 28162 . 28476) (\MAILOBJ.EXPAND 28478
. 30199) (\MAILOBJ.COPY.CHILD 30201 . 31558) (\MAILOBJ.COPY.SEQUENCE 31560 . 31928) (
\MAILOBJ.EXTRACT.TEXT 31930 . 32991) (\MAILOBJ.PARSE.ATTRIBUTES 32993 . 33770)) (35145 35782 (
\NSMAIL.WRITE.ATTRIBUTE 35155 . 35780)) (36322 43205 (\NSMAIL.PARSE.REFERENCE 36332 . 38250) (
\NSMAIL.EXPAND.DL 38252 . 39319) (\NSMAIL.PARSE 39321 . 39582) (\NSMAIL.PARSE1 39584 . 40792) (
NS.REMOVEDUPLICATES 40794 . 40932) (\NSMAIL.GUESS.FILE.TYPE 40934 . 41435) (
COURIER.WRITE.STREAM.UNSPECIFIED 41437 . 42581) (\NSMAIL.SEND.STREAM.AS.STRING 42583 . 43203)) (44526
48903 (\NSMAIL.MESSAGE.P 44536 . 44674) (\NSMAIL.MESSAGE.FROM.SELF.P 44676 . 46375) (
\NSMAIL.MAKEANSWERFORM 46377 . 48001) (\NSMAIL.PRINT.NAMES 48003 . 48901)))))
STOP

BIN
library/lafite/LAFITE-NSMAIL.LCOM Normal file
View File

Binary file not shown.

BIN
library/lafite/LAFITE-NSMAIL.TEDIT Normal file
View File

Binary file not shown.

0
library/lafite/LAFITEPRIVATEDL → library/lafite/LAFITE-PRIVATEDL
View File

73
library/lafite/LAFITESEND → library/lafite/LAFITE-SEND
View File

@@ -1,20 +1,17 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "16-Oct-2022 10:02:19" {DSK}<Users>briggs>projects>medley>library>lafite>LAFITESEND.;2 100794
(FILECREATED "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-SEND.;2 100561
:CHANGES-TO (FNS \SENDMESSAGE.RESTARTABLE)
:EDIT-BY rmk
:PREVIOUS-DATE " 7-Feb-2022 12:04:09"
{DSK}<Users>briggs>projects>medley>library>lafite>LAFITESEND.;1)
:CHANGES-TO (VARS LAFITE-SENDCOMS)
:PREVIOUS-DATE "23-Feb-2024 22:03:43" {WMEDLEY}<library>lafite>LAFITE-SEND.;1)
(* ; "
Copyright (c) 1984-1990, 1993, 1999-2000, 2021-2022 by Xerox Corporation.
")
(PRETTYCOMPRINT LAFITE-SENDCOMS)
(PRETTYCOMPRINT LAFITESENDCOMS)
(RPAQQ LAFITESENDCOMS
(RPAQQ LAFITE-SENDCOMS
((COMS (* ; "Sending mail")
(FNS DOLAFITESENDINGCOMMAND \SENDMESSAGE.INITIATE \SENDMSG.DELIVER \SENDMSG.EXIT.TEDIT
\SENDMSG.SAVE.FORM \LAFITE.HEADER.EOF \LAFITE.INSERT.REPLYTO \SENDMSG.REPLYTO
@@ -82,7 +79,7 @@ Copyright (c) 1984-1990, 1993, 1999-2000, 2021-2022 by Xerox Corporation.
RECIPIENTSSTR SUBJECTSTR LAFITE.MSG.ICON LAFITEFORMDIRECTORIES
LAFITE.SEND.FORMATTED)
(FILES (SOURCE)
LAFITEDECLS)
LAFITE-DECLS)
(LOCALVARS . T))))
@@ -1756,39 +1753,37 @@ cc: ~A
(FILESLOAD (SOURCE)
LAFITEDECLS)
LAFITE-DECLS)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
)
(PUTPROPS LAFITESEND COPYRIGHT ("Xerox Corporation" 1984 1985 1986 1987 1988 1989 1990 1993 1999 2000
2021 2022))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (5333 28310 (DOLAFITESENDINGCOMMAND 5343 . 5833) (\SENDMESSAGE.INITIATE 5835 . 7774) (
\SENDMSG.DELIVER 7776 . 8384) (\SENDMSG.EXIT.TEDIT 8386 . 8757) (\SENDMSG.SAVE.FORM 8759 . 10746) (
\LAFITE.HEADER.EOF 10748 . 11041) (\LAFITE.INSERT.REPLYTO 11043 . 11651) (\SENDMSG.REPLYTO 11653 .
12212) (\SENDMSG.CHANGE.MODE 12214 . 17790) (\SENDMSG.FIND.FIELD 17792 . 18302) (\SENDMESSAGE.PARSE
18304 . 19100) (\LAFITE.PREPARE.SEND 19102 . 21935) (\LAFITE.PREPARE.ERROR 21937 . 23119) (
\LAFITE.CHOOSE.MSG.FORMAT 23121 . 25762) (LAFITE.MAKE.PLAIN.TEXTSTREAM 25764 . 26689) (
\SENDMESSAGE.MENUPROMPT 26691 . 27554) (\SENDMESSAGE.PROMPT 27556 . 28092) (\SENDMESSAGEFAIL 28094 .
28308)) (28311 52973 (\SENDMESSAGE 28321 . 29673) (\SENDMESSAGE.RESTARTABLE 29675 . 34876) (
\SENDMESSAGE.CLEANUP 34878 . 35094) (\SENDMESSAGE.MAKEWINDOW 35096 . 41269) (MAKELAFITEDELIVERMENU
41271 . 41578) (\LAFITE.CLOSEMSG? 41580 . 42530) (\LAFITE.AFTER.DELIVER 42532 . 45851) (
\LAFITE.UNSENT.ICON 45853 . 46163) (\LAFITE.FETCH.SUBJECT 46165 . 46965) (LAFITE.SENDMESSAGE 46967 .
47860) (\SENDMESSAGE0 47862 . 50726) (LA.ASSURE.PROMPT.WINDOW 50728 . 51625) (\LAFITE.SEND.FAIL 51627
. 52098) (\LAFITE.INVALID.RECIPIENTS 52100 . 52558) (\SENDMESSAGE.ABORT 52560 . 52971)) (53005 62918
(\OUTBOX.CREATE 53015 . 54478) (\OUTBOX.RESET 54480 . 54973) (\OUTBOX.CLOSEFN 54975 . 55115) (
\OUTBOX.REPAINTFN 55117 . 55780) (\OUTBOX.RESHAPEFN 55782 . 57065) (\OUTBOX.SHADEITEM 57067 . 57740) (
\OUTBOX.BUTTONFN 57742 . 60590) (\OUTBOX.DISPLAYLINE 60592 . 61086) (\OUTBOX.ADD.ITEM 61088 . 62916))
(63214 79622 (\LAFITE.MESSAGEFORM 63224 . 67567) (MAKELAFITESUPPORTFORM 67569 . 67758) (
MAKELISPSUPPORTFORM 67760 . 67926) (MAKEXXXSUPPORTFORM 67928 . 71977) (MAKENEWMESSAGEFORM 71979 .
72935) (MAKELAFITEPRIVATEFORMSITEMS 72937 . 73365) (\LAFITE.UNCACHE.MESSAGEFORM 73367 . 73820) (
\LAFITE.DELETE.MESSAGEFORM 73822 . 74423) (\LAFITE.SELECT.FORM 74425 . 74780) (
\LAFITE.DELETE.FORM.INTERNAL 74782 . 75926) (\LAFITE.READ.FORM 75928 . 78665) (\LAFITE.FIND.TEMPLATE
78667 . 79620)) (79646 87377 (\LAFITE.ANSWER 79656 . 80061) (\LAFITE.ANSWER.PROC 80063 . 81957) (
MAKEANSWERFORM 81959 . 84489) (LA.PRINT.COMMA.LIST 84491 . 84977) (LAFITE.FILL.IN.ANSWER.FORM 84979 .
87375)) (87402 93598 (\LAFITE.FORWARD 87412 . 87820) (\LAFITE.FORWARD.PROC 87822 . 89811) (
MAKEFORWARDFORM 89813 . 93596)))))
(FILEMAP (NIL (5214 28191 (DOLAFITESENDINGCOMMAND 5224 . 5714) (\SENDMESSAGE.INITIATE 5716 . 7655) (
\SENDMSG.DELIVER 7657 . 8265) (\SENDMSG.EXIT.TEDIT 8267 . 8638) (\SENDMSG.SAVE.FORM 8640 . 10627) (
\LAFITE.HEADER.EOF 10629 . 10922) (\LAFITE.INSERT.REPLYTO 10924 . 11532) (\SENDMSG.REPLYTO 11534 .
12093) (\SENDMSG.CHANGE.MODE 12095 . 17671) (\SENDMSG.FIND.FIELD 17673 . 18183) (\SENDMESSAGE.PARSE
18185 . 18981) (\LAFITE.PREPARE.SEND 18983 . 21816) (\LAFITE.PREPARE.ERROR 21818 . 23000) (
\LAFITE.CHOOSE.MSG.FORMAT 23002 . 25643) (LAFITE.MAKE.PLAIN.TEXTSTREAM 25645 . 26570) (
\SENDMESSAGE.MENUPROMPT 26572 . 27435) (\SENDMESSAGE.PROMPT 27437 . 27973) (\SENDMESSAGEFAIL 27975 .
28189)) (28192 52854 (\SENDMESSAGE 28202 . 29554) (\SENDMESSAGE.RESTARTABLE 29556 . 34757) (
\SENDMESSAGE.CLEANUP 34759 . 34975) (\SENDMESSAGE.MAKEWINDOW 34977 . 41150) (MAKELAFITEDELIVERMENU
41152 . 41459) (\LAFITE.CLOSEMSG? 41461 . 42411) (\LAFITE.AFTER.DELIVER 42413 . 45732) (
\LAFITE.UNSENT.ICON 45734 . 46044) (\LAFITE.FETCH.SUBJECT 46046 . 46846) (LAFITE.SENDMESSAGE 46848 .
47741) (\SENDMESSAGE0 47743 . 50607) (LA.ASSURE.PROMPT.WINDOW 50609 . 51506) (\LAFITE.SEND.FAIL 51508
. 51979) (\LAFITE.INVALID.RECIPIENTS 51981 . 52439) (\SENDMESSAGE.ABORT 52441 . 52852)) (52886 62799
(\OUTBOX.CREATE 52896 . 54359) (\OUTBOX.RESET 54361 . 54854) (\OUTBOX.CLOSEFN 54856 . 54996) (
\OUTBOX.REPAINTFN 54998 . 55661) (\OUTBOX.RESHAPEFN 55663 . 56946) (\OUTBOX.SHADEITEM 56948 . 57621) (
\OUTBOX.BUTTONFN 57623 . 60471) (\OUTBOX.DISPLAYLINE 60473 . 60967) (\OUTBOX.ADD.ITEM 60969 . 62797))
(63095 79503 (\LAFITE.MESSAGEFORM 63105 . 67448) (MAKELAFITESUPPORTFORM 67450 . 67639) (
MAKELISPSUPPORTFORM 67641 . 67807) (MAKEXXXSUPPORTFORM 67809 . 71858) (MAKENEWMESSAGEFORM 71860 .
72816) (MAKELAFITEPRIVATEFORMSITEMS 72818 . 73246) (\LAFITE.UNCACHE.MESSAGEFORM 73248 . 73701) (
\LAFITE.DELETE.MESSAGEFORM 73703 . 74304) (\LAFITE.SELECT.FORM 74306 . 74661) (
\LAFITE.DELETE.FORM.INTERNAL 74663 . 75807) (\LAFITE.READ.FORM 75809 . 78546) (\LAFITE.FIND.TEMPLATE
78548 . 79501)) (79527 87258 (\LAFITE.ANSWER 79537 . 79942) (\LAFITE.ANSWER.PROC 79944 . 81838) (
MAKEANSWERFORM 81840 . 84370) (LA.PRINT.COMMA.LIST 84372 . 84858) (LAFITE.FILL.IN.ANSWER.FORM 84860 .
87256)) (87283 93479 (\LAFITE.FORWARD 87293 . 87701) (\LAFITE.FORWARD.PROC 87703 . 89692) (
MAKEFORWARDFORM 89694 . 93477)))))
STOP

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

Binary file not shown.

43
library/lafite/LAFITESORT → library/lafite/LAFITE-SORT
View File

@@ -1,20 +1,19 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "30-Sep-2021 22:58:58" 
{DSK}<USERS>KAPLAN>LOCAL>MEDLEY3.5>GIT-MEDLEY>LIBRARY>LAFITE>LAFITESORT.;1 19675
previous date%: " 7-Feb-95 13:10:22"
{DSK}<USERS>KAPLAN>LOCAL>MEDLEY3.5>GIT-MEDLEY>LIBRARY>LAFITE>LAFITESORT.;1)
(FILECREATED "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-SORT.;2 19458
:EDIT-BY rmk
:CHANGES-TO (VARS LAFITE-SORTCOMS)
:PREVIOUS-DATE "23-Feb-2024 22:07:18" {WMEDLEY}<library>lafite>LAFITE-SORT.;1)
(* ; "
Copyright (c) 1989, 1995, 2021 by Xerox Corporation.
")
(PRETTYCOMPRINT LAFITE-SORTCOMS)
(PRETTYCOMPRINT LAFITESORTCOMS)
(RPAQQ LAFITESORTCOMS
(RPAQQ LAFITE-SORTCOMS
[(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (SOURCE)
LAFITEDECLS))
LAFITE-DECLS))
(FNS LAFITE.ASSURE.DATE.FIELDS LAFITE.PARSE.DATE.FIELD LAFITE.PARSE.DATE.FIELD.ONLY
LAFITE.SORT.BY.DATE LAFITE.SORT.MESSAGES LAFITEMSG.DATE.ORDER
\LAFITE.SORT.BY.DATE.INTERACTIVE \LAFITE.SORT.BY.DATE.REGION)
@@ -35,7 +34,7 @@ Copyright (c) 1989, 1995, 2021 by Xerox Corporation.
(DECLARE%: EVAL@COMPILE DONTCOPY
(FILESLOAD (SOURCE)
LAFITEDECLS)
LAFITE-DECLS)
)
(DEFINEQ
@@ -229,14 +228,13 @@ Copyright (c) 1989, 1995, 2021 by Xerox Corporation.
(APPENDTOVAR LAFITEEXTRAMENUITEMS ("Sort by Date" '\LAFITE.SORT.BY.DATE.INTERACTIVE
"Sort all the messages in this folder by their Date: fields."
(SUBITEMS ("Sort Entire Folder"
'\LAFITE.SORT.BY.DATE.INTERACTIVE
(SUBITEMS ("Sort Entire Folder"
'\LAFITE.SORT.BY.DATE.INTERACTIVE
"Sort all the messages in this folder by their Date: fields."
)
("Sort Selected Range"
'\LAFITE.SORT.BY.DATE.REGION
)
("Sort Selected Range" '\LAFITE.SORT.BY.DATE.REGION
"Sort only the messages between the first and last selected messages."
))))
))))
@@ -325,10 +323,9 @@ Copyright (c) 1989, 1995, 2021 by Xerox Corporation.
(GLOBALVARS \TimeZoneComp \DayLightSavings)
)
)
(PUTPROPS LAFITESORT COPYRIGHT ("Xerox Corporation" 1989 1995 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2020 14676 (LAFITE.ASSURE.DATE.FIELDS 2030 . 8127) (LAFITE.PARSE.DATE.FIELD 8129 . 8766
) (LAFITE.PARSE.DATE.FIELD.ONLY 8768 . 8983) (LAFITE.SORT.BY.DATE 8985 . 9345) (LAFITE.SORT.MESSAGES
9347 . 12737) (LAFITEMSG.DATE.ORDER 12739 . 13487) (\LAFITE.SORT.BY.DATE.INTERACTIVE 13489 . 14133) (
\LAFITE.SORT.BY.DATE.REGION 14135 . 14674)) (15566 19381 (GDATE1-6 15576 . 19379)))))
(FILEMAP (NIL (1952 14608 (LAFITE.ASSURE.DATE.FIELDS 1962 . 8059) (LAFITE.PARSE.DATE.FIELD 8061 . 8698
) (LAFITE.PARSE.DATE.FIELD.ONLY 8700 . 8915) (LAFITE.SORT.BY.DATE 8917 . 9277) (LAFITE.SORT.MESSAGES
9279 . 12669) (LAFITEMSG.DATE.ORDER 12671 . 13419) (\LAFITE.SORT.BY.DATE.INTERACTIVE 13421 . 14065) (
\LAFITE.SORT.BY.DATE.REGION 14067 . 14606)) (15418 19233 (GDATE1-6 15428 . 19231)))))
STOP

BIN
library/lafite/LAFITESORT.LCOM → library/lafite/LAFITE-SORT.LCOM
View File

Binary file not shown.

31
library/lafite/LAFITETEDIT → library/lafite/LAFITE-TEDIT
View File

@@ -1,26 +1,25 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "18-Jan-2024 10:34:16" {WMEDLEY}<library>lafite>LAFITETEDIT.;33 6622
(FILECREATED "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-TEDIT.;2 6592
:EDIT-BY rmk
:CHANGES-TO (FILES LAFITEDECLS)
(FNS LA.ADJUST.FORMATTING)
:CHANGES-TO (VARS LAFITE-TEDITCOMS)
:PREVIOUS-DATE "14-Jan-2024 12:56:19" {WMEDLEY}<library>lafite>LAFITETEDIT.;32)
:PREVIOUS-DATE "23-Feb-2024 22:09:24" {WMEDLEY}<library>lafite>LAFITE-TEDIT.;1)
(PRETTYCOMPRINT LAFITETEDITCOMS)
(PRETTYCOMPRINT LAFITE-TEDITCOMS)
(RPAQQ LAFITETEDITCOMS (
(* ;; "Lafite's more explicit dependencies on %"internals%" of TEDIT")
(RPAQQ LAFITE-TEDITCOMS (
(* ;; "Lafite's more explicit dependencies on %"internals%" of TEDIT")
(FNS LA.ADJUST.FORMATTING LA.DETACH.TEDIT TEDIT.ASSURE.NO.BACKING.FILE
LA.WINDOW.FROM.TEXTSTREAM)
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (SOURCE)
LAFITEDECLS)
(GLOBALVARS *TEDIT-FILE-READTABLE*)
(LOCALVARS . T))))
(FNS LA.ADJUST.FORMATTING LA.DETACH.TEDIT TEDIT.ASSURE.NO.BACKING.FILE
LA.WINDOW.FROM.TEXTSTREAM)
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (SOURCE)
LAFITE-DECLS)
(GLOBALVARS *TEDIT-FILE-READTABLE*)
(LOCALVARS . T))))
@@ -106,7 +105,7 @@
(DECLARE%: EVAL@COMPILE DONTCOPY
(FILESLOAD (SOURCE)
LAFITEDECLS)
LAFITE-DECLS)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
@@ -119,6 +118,6 @@
)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1018 6392 (LA.ADJUST.FORMATTING 1028 . 4074) (LA.DETACH.TEDIT 4076 . 4442) (
TEDIT.ASSURE.NO.BACKING.FILE 4444 . 6110) (LA.WINDOW.FROM.TEXTSTREAM 6112 . 6390)))))
(FILEMAP (NIL (987 6361 (LA.ADJUST.FORMATTING 997 . 4043) (LA.DETACH.TEDIT 4045 . 4411) (
TEDIT.ASSURE.NO.BACKING.FILE 4413 . 6079) (LA.WINDOW.FROM.TEXTSTREAM 6081 . 6359)))))
STOP

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

Binary file not shown.

48
library/lafite/LAFITETIMEDDELETE → library/lafite/LAFITE-TIMEDDELETE
View File

@@ -1,20 +1,19 @@
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "28-Jun-89 08:53:23" {POOH/N}<POOH>MAXWELL>LISP>LAFITETIMEDDELETE;1 11153
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
changes to%: (FNS \LAFITE.DELETEEXPIRED MESSAGEAGE)
(FILECREATED "27-Feb-2024 09:28:24" {WMEDLEY}<library>lafite>LAFITE-TIMEDDELETE.;3 10989
previous date%: "13-Oct-88 11:05:53" {PHYLUM}<LISPUSERS>MEDLEY>LAFITETIMEDDELETE.;1)
:EDIT-BY rmk
:CHANGES-TO (VARS LAFITE-TIMEDDELETECOMS)
:PREVIOUS-DATE "23-Feb-2024 23:23:25" {WMEDLEY}<library>lafite>LAFITE-TIMEDDELETE.;2)
(* "
Copyright (c) 1987, 1988, 1989 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT LAFITE-TIMEDDELETECOMS)
(PRETTYCOMPRINT LAFITETIMEDDELETECOMS)
(RPAQQ LAFITETIMEDDELETECOMS
((DECLARE%: DONTCOPY EVAL@COMPILE (FILES LAFITEDECLS))
(FILES LAFITEFIND)
(RPAQQ LAFITE-TIMEDDELETECOMS
((DECLARE%: DONTCOPY EVAL@COMPILE (FILES LAFITE-DECLS))
(FILES LAFITE-FIND)
(FNS \LAFITE.TIMEDDELETE \LAFITE.SETEXPIRATIONS \LAFITE.DELETEEXPIRED)
(FNS LTD.INIT MESSAGEAGE)
(INITVARS EXPIRATIONMENU)
@@ -23,10 +22,10 @@ Copyright (c) 1987, 1988, 1989 by Xerox Corporation. All rights reserved.
(P (LTD.INIT))))
(DECLARE%: DONTCOPY EVAL@COMPILE
(FILESLOAD LAFITEDECLS)
(FILESLOAD LAFITE-DECLS)
)
(FILESLOAD LAFITEFIND)
(FILESLOAD LAFITE-FIND)
(DEFINEQ
(\LAFITE.TIMEDDELETE
@@ -207,22 +206,21 @@ Copyright (c) 1987, 1988, 1989 by Xerox Corporation. All rights reserved.
("forever" 0)))
(RPAQQ MARKDURATIONS ((1 1)
(2 2)
(3 4)
(4 7)
(5 14)
(6 30)
(7 61)
(8 122)
(9 244)))
(2 2)
(3 4)
(4 7)
(5 14)
(6 30)
(7 61)
(8 122)
(9 244)))
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS EXPIRATIONMENU EXPIRATIONMENUITEMS MARKDURATIONS)
)
(LTD.INIT)
(PUTPROPS LAFITETIMEDDELETE COPYRIGHT ("Xerox Corporation" 1987 1988 1989))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (934 8084 (\LAFITE.TIMEDDELETE 944 . 1218) (\LAFITE.SETEXPIRATIONS 1220 . 5600) (
\LAFITE.DELETEEXPIRED 5602 . 8082)) (8085 10316 (LTD.INIT 8095 . 8984) (MESSAGEAGE 8986 . 10314)))))
(FILEMAP (NIL (878 8028 (\LAFITE.TIMEDDELETE 888 . 1162) (\LAFITE.SETEXPIRATIONS 1164 . 5544) (
\LAFITE.DELETEEXPIRED 5546 . 8026)) (8029 10260 (LTD.INIT 8039 . 8928) (MESSAGEAGE 8930 . 10258)))))
STOP

BIN
library/lafite/LAFITE-TIMEDDELETE.LCOM Normal file
View File

Binary file not shown.

0
library/lafite/LAFITETIMEDDELETE.TEDIT → library/lafite/LAFITE-TIMEDDELETE.TEDIT
View File

70
library/lafite/UNIXMAIL → library/lafite/LAFITE-UNIXMAIL
View File

@@ -1,27 +1,22 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED "24-Feb-2024 10:26:07" |{DSK}<home>larry>il>medley>library>lafite>UNIXMAIL.;3| 81776
(FILECREATED "24-Feb-2024 11:57:21" |{WMEDLEY}<library>lafite>LAFITE-UNIXMAIL.;4| 81665
:EDIT-BY "lmm"
:EDIT-BY |rmk|
:CHANGES-TO (VARS UNIXMAILCOMS)
:CHANGES-TO (VARS LAFITE-UNIXMAILCOMS)
:PREVIOUS-DATE "30-Sep-2021 16:06:26" |{DSK}<home>larry>il>medley>library>lafite>UNIXMAIL.;1|
)
:PREVIOUS-DATE "24-Feb-2024 11:35:24" |{WMEDLEY}<library>lafite>LAFITE-UNIXMAIL.;3|)
; Copyright (c) 1989-1992, 1997, 1999, 1920, 2021 by ENVOS Corporation.
(PRETTYCOMPRINT LAFITE-UNIXMAILCOMS)
(PRETTYCOMPRINT UNIXMAILCOMS)
(RPAQQ UNIXMAILCOMS
(
(* |;;| " LMM 2/24/24 need LAFITE to load")
(FILES LAFITE)
(DECLARE\: DOEVAL@COMPILE DONTCOPY (FILES (SOURCE)
LAFITEDECLS NSMAIL)
(RPAQQ LAFITE-UNIXMAILCOMS
((DECLARE\: DOEVAL@COMPILE DONTCOPY (FILES (SOURCE)
LAFITE-DECLS LAFITE-NSMAIL)
(RECORDS UNIXMAILBOX UNIXMAILFILEINFO UNIXMAILPARSE))
(DECLARE\: DONTEVAL@LOAD DOCOPY (FILES (SYSLOAD)
LAFITE))
(ALISTS (LAFITEMODELST UNIX))
(* |;;| "JDS 4/6/97: CHANGE TRANSMIT SMTP INTERACTION TO put <> around mail-from name, which SMTP seems to require.")
@@ -86,18 +81,11 @@
(CDR LAFITESENDINGMENUITEMS))
'(CHANGE \\SENDMSG.CHANGE.MODE TO
\\UNIXMAIL.CHANGE.MODE)))))
(PROP FILETYPE UNIXMAIL)))
(* |;;| " LMM 2/24/24 need LAFITE to load")
(FILESLOAD LAFITE)
(PROP FILETYPE LAFITE-UNIXMAIL)))
(DECLARE\: DOEVAL@COMPILE DONTCOPY
(FILESLOAD (SOURCE)
LAFITEDECLS NSMAIL)
LAFITE-DECLS LAFITE-NSMAIL)
(DECLARE\: EVAL@COMPILE
@@ -108,6 +96,11 @@
(RECORD UNIXMAILPARSE (UNIXMAILSUBJECT UNIXFROM UNIXTO UNIXOTHER FORMATTED? UNIXBODY))
)
)
(DECLARE\: DONTEVAL@LOAD DOCOPY
(FILESLOAD (SYSLOAD)
LAFITE)
)
(ADDTOVAR LAFITEMODELST (UNIX 3 \\UNIXMAIL.SEND.PARSE \\UNIXMAIL.SEND \\UNIXMAIL.MAKEANSWERFORM
\\UNIXMAIL.AUTHENTICATE \\UNIXMAIL.MESSAGE.P
@@ -1370,20 +1363,19 @@
(CDR LAFITESENDINGMENUITEMS))
'(CHANGE \\SENDMSG.CHANGE.MODE TO \\UNIXMAIL.CHANGE.MODE))))
(PUTPROPS UNIXMAIL FILETYPE :COMPILE-FILE)
(PUTPROPS UNIXMAIL COPYRIGHT ("ENVOS Corporation" 1989 1990 1991 1992 1997 1999 1920 2021))
(PUTPROPS LAFITE-UNIXMAIL FILETYPE :COMPILE-FILE)
(DECLARE\: DONTCOPY
(FILEMAP (NIL (7090 25515 (UNIX.POLLNEWMAIL 7100 . 9050) (UNIX.NEXTMESSAGE 9052 . 9228) (
UNIXMAILER.OPENMAILBOX 9230 . 13626) (UNIXMAILER.RETRIEVEMESSAGE 13628 . 14835) (
UNIXMAILER.CLOSEMAILBOX 14837 . 15862) (UNIXSPOOL.OPENMAILBOX 15864 . 22081) (
UNIXSPOOL.RETRIEVEMESSAGE 22083 . 24164) (UNIXSPOOL.CLOSEMAILBOX 24166 . 25513)) (25563 56053 (
UNIX.FLUSH.STREAM 25573 . 26154) (UNIX.RETRIEVE.LINE 26156 . 27345) (\\UNIXMAIL.SEND 27347 . 37641) (
\\UNIXMAIL.SEND.WRAPLINES 37643 . 41273) (\\SMTP-DUMP 41275 . 42545) (\\UNIXMAIL.SEND.PARSE 42547 .
45791) (\\UNIXMAIL.CHECK.ABORT 45793 . 46621) (\\UNIXMAIL.MUNG.RECIPIENTS 46623 . 51491) (
\\UNIXMAIL.SMTP 51493 . 52098) (\\UNIXMAIL.SMTP.FLUSH 52100 . 54577) (\\UNIXMAIL.CHANGE.MODE 54579 .
56051)) (56141 59147 (\\UNIXMAIL.SMTP.TCP.STREAMS 56141 . 59147)) (59226 80798 (
\\UNIXMAIL.AUTHENTICATE 59236 . 60927) (\\UNIXMAIL.LOGIN 60929 . 61274) (\\UNIXMAIL.PARSENAMES 61276
. 63594) (\\UNIXMAIL.MAKEANSWERFORM 63596 . 68478) (\\UNIXMAIL.MESSAGE.FROM.SELF.P 68480 . 69609) (
\\UNIXMAIL.MESSAGE.P 69611 . 69930) (\\UNIXMAIL.REALADDRESS 69932 . 73976) (\\UNIXMAIL.FQNAME 73978 .
74583) (\\UNIXMAIL.FIXMICROSOFT 74585 . 80796)))))
(FILEMAP (NIL (7064 25489 (UNIX.POLLNEWMAIL 7074 . 9024) (UNIX.NEXTMESSAGE 9026 . 9202) (
UNIXMAILER.OPENMAILBOX 9204 . 13600) (UNIXMAILER.RETRIEVEMESSAGE 13602 . 14809) (
UNIXMAILER.CLOSEMAILBOX 14811 . 15836) (UNIXSPOOL.OPENMAILBOX 15838 . 22055) (
UNIXSPOOL.RETRIEVEMESSAGE 22057 . 24138) (UNIXSPOOL.CLOSEMAILBOX 24140 . 25487)) (25537 56027 (
UNIX.FLUSH.STREAM 25547 . 26128) (UNIX.RETRIEVE.LINE 26130 . 27319) (\\UNIXMAIL.SEND 27321 . 37615) (
\\UNIXMAIL.SEND.WRAPLINES 37617 . 41247) (\\SMTP-DUMP 41249 . 42519) (\\UNIXMAIL.SEND.PARSE 42521 .
45765) (\\UNIXMAIL.CHECK.ABORT 45767 . 46595) (\\UNIXMAIL.MUNG.RECIPIENTS 46597 . 51465) (
\\UNIXMAIL.SMTP 51467 . 52072) (\\UNIXMAIL.SMTP.FLUSH 52074 . 54551) (\\UNIXMAIL.CHANGE.MODE 54553 .
56025)) (56115 59121 (\\UNIXMAIL.SMTP.TCP.STREAMS 56115 . 59121)) (59200 80772 (
\\UNIXMAIL.AUTHENTICATE 59210 . 60901) (\\UNIXMAIL.LOGIN 60903 . 61248) (\\UNIXMAIL.PARSENAMES 61250
. 63568) (\\UNIXMAIL.MAKEANSWERFORM 63570 . 68452) (\\UNIXMAIL.MESSAGE.FROM.SELF.P 68454 . 69583) (
\\UNIXMAIL.MESSAGE.P 69585 . 69904) (\\UNIXMAIL.REALADDRESS 69906 . 73950) (\\UNIXMAIL.FQNAME 73952 .
74557) (\\UNIXMAIL.FIXMICROSOFT 74559 . 80770)))))
STOP

BIN
library/lafite/LAFITE-UNIXMAIL.DFASL Normal file
View File

Binary file not shown.

0
library/lafite/UNIXMAIL.TEDIT → library/lafite/LAFITE-UNIXMAIL.TEDIT
View File

BIN
library/lafite/LAFITE.LCOM
View File

Binary file not shown.

BIN
library/lafite/LAFITEFIND.LCOM
View File

Binary file not shown.

BIN
library/lafite/LAFITETIMEDDELETE.LCOM
View File

Binary file not shown.

BIN
library/lafite/MAILSHARE.LCOM
View File

Binary file not shown.

BIN
library/lafite/MIME.LCOM
View File

Binary file not shown.

BIN
library/lafite/NEWNSMAIL.LCOM
View File

Binary file not shown.

1
library/lafite/NOXNSPATCH
View File

File diff suppressed because one or more lines are too long

BIN
library/lafite/NOXNSPATCH.LCOM
View File

Binary file not shown.

BIN
library/lafite/NSMAIL.LCOM
View File

Binary file not shown.

BIN
library/lafite/NSMAIL.TEDIT
View File

Binary file not shown.

BIN
library/lafite/UNIXMAIL.DFASL
View File

Binary file not shown.

119
library/tedit/TEDIT-PAGE
View File

@@ -1,12 +1,14 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 7-Mar-2024 09:55:14" {WMEDLEY}<library>TEDIT>TEDIT-PAGE.;154 111276
(FILECREATED "13-Mar-2024 17:12:34" {WMEDLEY}<library>TEDIT>TEDIT-PAGE.;163 112427
:EDIT-BY rmk
:CHANGES-TO (FNS TEDIT.FORMAT.HARDCOPY)
:CHANGES-TO (FNS TEDIT.FORMATBOX \TEDIT.FORMAT.FOOTNOTE)
(RECORDS PAGEFORMATTINGSTATE PAGEREGION)
(MACROS GETPFS SETPFS)
:PREVIOUS-DATE " 7-Mar-2024 00:14:19" {WMEDLEY}<library>TEDIT>TEDIT-PAGE.;152)
:PREVIOUS-DATE "13-Mar-2024 10:28:14" {WMEDLEY}<library>tedit>TEDIT-PAGE.;157)
(PRETTYCOMPRINT TEDIT-PAGECOMS)
@@ -559,7 +561,7 @@
(TEDIT.FORMAT.HARDCOPY
[LAMBDA (TEXTSTREAM FILE DONTSEND BREAKPAGETITLE SERVER PRINTOPTIONS IMAGETYPE FIRSTPG# STARTPG
ENDPG) (* ; "Edited 7-Mar-2024 09:55 by rmk")
ENDPG) (* ; "Edited 7-Mar-2024 12:34 by rmk")
(* ; "Edited 19-Jan-2024 23:39 by rmk")
(* ; "Edited 24-Dec-2023 14:10 by rmk")
(* ; "Edited 15-Nov-2023 23:56 by rmk")
@@ -577,9 +579,9 @@
(SETQ TEXTSTREAM (if (TEXTSTREAM TEXTSTREAM T)
elseif (TEDIT.FORMATTEDFILEP TEXTSTREAM)
then (CL:UNLESS (\GETSTREAM TEXTSTREAM 'INPUT T)
[RESETSAVE (SETQ TEXTSTREAM (OPENSTREAM TEXTSTREAM 'INPUT))
[RESETSAVE (SETQ TEXTSTREAM (OPENTEXTSTREAM TEXTSTREAM))
`(PROGN (CLOSEF? OLDVALUE])
(OPENTEXTSTREAM TEXTSTREAM)
TEXTSTREAM
else (ERROR TEXTSTREAM "is not a Tedit stream")))
(PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TEXTSTREAM))
[FORMATTINGSTATE (create PAGEFORMATTINGSTATE
@@ -705,6 +707,7 @@
(TEDIT.FORMATBOX
[LAMBDA (TEXTOBJ PRSTREAM STARTINGCHNO PAGEREGION FORMATTINGSTATE)
(* ; "Edited 13-Mar-2024 17:09 by rmk")
(* ; "Edited 20-Jan-2024 12:16 by rmk")
(* ; "Edited 28-Jun-2023 15:54 by rmk")
(* ; "Edited 22-Jun-2023 21:50 by rmk")
@@ -820,32 +823,36 @@
 "For now, draw a box around it, too.")
)
NIL)
(for LINE in LINES when LINE do (* ;
(for LINE LTEXTOBJ in LINES when LINE do (* ;
 "Run thru the lines displaying them all.")
(BLOCK)
(CL:WHEN (OR (NOT (GETPFS FORMATTINGSTATE MINPAGE#))
(IGEQ (GETPFS FORMATTINGSTATE PAGE#)
(GETPFS FORMATTINGSTATE MINPAGE#)))
(BLOCK)
(SETQ LTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ)
of (FGETLD LINE LTEXTSTREAM)))
(CL:WHEN (OR (NOT (GETPFS FORMATTINGSTATE MINPAGE#)
)
(IGEQ (GETPFS FORMATTINGSTATE PAGE#)
(GETPFS FORMATTINGSTATE MINPAGE#
)))
(* ;
 "We're beyond the min page number -- go ahead and print the line")
(\TEDIT.HARDCOPY.DISPLAYLINE (GETLD LINE LTEXTOBJ)
LINE
(SCALEREGION (DSPSCALE NIL PRSTREAM)
REGION)
PRSTREAM FORMATTINGSTATE))
(CL:WHEN (EQ TEXTOBJ (GETLD LINE LTEXTOBJ))
(\TEDIT.HARDCOPY.DISPLAYLINE
LTEXTOBJ LINE (SCALEREGION (DSPSCALE NIL
PRSTREAM)
REGION)
PRSTREAM FORMATTINGSTATE))
(CL:WHEN (EQ TEXTOBJ LTEXTOBJ)
(* ;;
(* ;;
 "This line refers back to the main text, so update the current-char pointer.")
(* ;;
(* ;;
 "[NB that footnotes could cause the count to be non-monotonic; hence the IMAX.]")
[SETQ CHNO (IMAX (OR CHNO 0)
(ADD1 (GETLD LINE LCHARLIM])
(push (GETPFS FORMATTINGSTATE PAGELINECACHE)
LINE)
(SETLD LINE LTEXTOBJ NIL))
[SETQ CHNO (IMAX (OR CHNO 0)
(ADD1 (FGETLD LINE LCHARLIM])
(push (GETPFS FORMATTINGSTATE PAGELINECACHE)
LINE)
(FSETLD LINE LTEXTSTREAM NIL))
(COND
(LAST-CHNO (* ;
 "We got a definite last chno from FORMATTEXTBOX.")
@@ -855,7 +862,8 @@
(SETPFS FORMATTINGSTATE CHNO CHNO])
(TEDIT.FORMATHEADING
[LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE PAGEREGION) (* ; "Edited 6-Mar-2024 13:09 by rmk")
[LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE PAGEREGION) (* ; "Edited 13-Mar-2024 09:00 by rmk")
(* ; "Edited 6-Mar-2024 13:09 by rmk")
(* ; "Edited 15-Feb-2024 22:02 by rmk")
(* ; "Edited 19-Jan-2024 23:20 by rmk")
(* ; "Edited 9-Sep-2023 22:17 by rmk")
@@ -868,15 +876,17 @@
(LET ((REGION (SCALEREGION (DSPSCALE NIL PRSTREAM)
(fetch (PAGEREGION REGIONSPEC) of PAGEREGION)))
(LOCALINFO (fetch (PAGEREGION REGIONLOCALINFO) of PAGEREGION))
HEADINGTEXTOBJ FORCENEXTPAGE HEADING)
HEADINGTEXTOBJ HEADINGSTREAM FORCENEXTPAGE HEADING)
(CL:WHEN [AND (for FORM inside (LISTGET LOCALINFO 'PRECONDITIONS) always (EVAL FORM))
(SETQ HEADING (LISTGET (GETPFS FORMATTINGSTATE PAGEHEADINGS)
(LISTGET LOCALINFO 'HEADINGTYPE]
[SETQ HEADINGTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ)
of (OPENTEXTSTREAM
NIL NIL NIL NIL
`(PARALOOKS ,(PPARALOOKS (fetch (SELPIECES SPFIRST)
of HEADING]
(* ;; "Bind the stream to make sure it isn't collected.")
[SETQ HEADINGSTREAM (OPENTEXTSTREAM NIL NIL NIL NIL
`(PARALOOKS ,(PPARALOOKS (fetch (SELPIECES SPFIRST)
of HEADING]
(SETQ HEADINGTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of HEADINGSTREAM))
(* ;; "Insert the heading pieces into HEADINGTEXTOBJ")
@@ -912,7 +922,8 @@
LINE))])
(TEDIT.FORMATPAGE
[LAMBDA (TEXTOBJ PRSTREAM CHNO PAGEREGION FORMATTINGSTATE) (* ; "Edited 19-Jan-2024 23:10 by rmk")
[LAMBDA (TEXTOBJ PRSTREAM CHNO PAGEREGION FORMATTINGSTATE) (* ; "Edited 13-Mar-2024 10:28 by rmk")
(* ; "Edited 19-Jan-2024 23:10 by rmk")
(* ; "Edited 11-Dec-2023 22:02 by rmk")
(* ; "Edited 13-Nov-2023 00:15 by rmk")
(* ; "Edited 22-Sep-2023 20:37 by rmk")
@@ -997,7 +1008,7 @@
(* ;; "We now fill up the next complete page. Afterwards, we either continue to the next page (DPSNEWPAGE) or finish up. TEDIT.FORMATBOX is responsible for setting up NEWPAGEBEFORFE and NEWPAGEAFTER")
(SETPFS FORMATTINGSTATE CHNO CHNO with CHNO)
(SETPFS FORMATTINGSTATE CHNO CHNO)
(for SUBREGION in (fetch (PAGEREGION REGIONSUBBOXES) of PAGEREGION)
while (ILEQ (GETPFS FORMATTINGSTATE CHNO)
TEXTLEN) do
@@ -1269,7 +1280,8 @@
FORMATTINGSTATE FINAL-CHNO)))])
(TEDIT.FORMATFOLIO
[LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE PAGEREGION) (* ; "Edited 19-Jan-2024 23:28 by rmk")
[LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE PAGEREGION) (* ; "Edited 13-Mar-2024 09:00 by rmk")
(* ; "Edited 19-Jan-2024 23:28 by rmk")
(* ; "Edited 18-Jan-2024 17:04 by rmk")
(* ; "Edited 13-Nov-2023 00:24 by rmk")
(* ; "Edited 1-Jun-2023 00:12 by rmk")
@@ -1281,7 +1293,7 @@
(LET ((REGION (SCALEREGION (DSPSCALE NIL PRSTREAM)
(fetch (PAGEREGION REGIONSPEC) of PAGEREGION)))
(FOLIOINFO (fetch (PAGEREGION REGIONLOCALINFO) of PAGEREGION))
FOLIOTEXTOBJ PAGE# FOLIOFORMAT PRETEXT POSTTEXT INFOLIST)
FOLIOSTREAM FOLIOTEXTOBJ PAGE# FOLIOFORMAT PRETEXT POSTTEXT INFOLIST)
(CL:UNLESS (AND (GETPFS FORMATTINGSTATE FIRSTPAGE)
(LISTGET FOLIOINFO 'NOFIRSTPAGE)) (* ;
 "If this isn't the first page, OR we want a page # on the first page, go ahead and format it.")
@@ -1300,10 +1312,14 @@
(UPPERROMAN (ROMANNUMERALS (GETPFS FORMATTINGSTATE PAGE#)
T))
(MKSTRING (GETPFS FORMATTINGSTATE PAGE#]
[SETQ FOLIOTEXTOBJ (TEXTOBJ (OPENTEXTSTREAM NIL NIL NIL NIL
`(PARALOOKS ,(LISTGET FOLIOINFO 'PARALOOKS)
LOOKS
,(LISTGET FOLIOINFO 'CHARLOOKS]
(* ;; "Bind the stream to make sure it isn't collected.")
[SETQ FOLIOSTREAM (OPENTEXTSTREAM NIL NIL NIL NIL
`(PARALOOKS ,(LISTGET FOLIOINFO 'PARALOOKS)
LOOKS
,(LISTGET FOLIOINFO 'CHARLOOKS]
(SETQ FOLIOTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of FOLIOSTREAM))
(TEDIT.INSERT FOLIOTEXTOBJ (CONCAT PRETEXT PAGE# POSTTEXT)
1 NIL T)
(bind LINE YBOT FORCENEXTPAGE (TEXTLEN _ (TEXTLEN FOLIOTEXTOBJ))
@@ -1745,7 +1761,8 @@
(DEFINEQ
(\TEDIT.FORMAT.FOOTNOTE
[LAMBDA (TEXTOBJ PRSTREAM LINE REGION FORMATTINGSTATE) (* ; "Edited 19-Jan-2024 23:30 by rmk")
[LAMBDA (TEXTOBJ PRSTREAM LINE REGION FORMATTINGSTATE) (* ; "Edited 13-Mar-2024 17:00 by rmk")
(* ; "Edited 19-Jan-2024 23:30 by rmk")
(* ; "Edited 6-May-2023 20:38 by rmk")
(* ; "Edited 7-Mar-2023 13:11 by rmk")
(* ; "Edited 30-May-91 12:52 by jds")
@@ -1766,8 +1783,6 @@
REGION PRSTREAM FORMATTINGSTATE))
(* ;
 "Format the line, noting any form-feeds")
(SETLD LINE LTEXTOBJ TEXTOBJ) (* ;
 "And remember the document it came from.")
(add (FGETLD LINE LEFTMARGIN)
LEFT)
(add (FGETLD LINE RIGHTMARGIN)
@@ -1780,14 +1795,14 @@
(RETURN (DREMOVE NIL $$VAL])
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (11921 15254 (\TEDIT.PARSE.PAGEFRAMES 11931 . 13431) (\TEDIT.PUT.PAGEFRAMES 13433 .
14257) (\TEDIT.UNPARSE.PAGEFRAMES 14259 . 15252)) (15317 31779 (TEDIT.SINGLE.PAGEFORMAT 15327 . 25545)
(TEDIT.COMPOUND.PAGEFORMAT 25547 . 26526) (TEDIT.PAGEFORMAT 26528 . 31777)) (31866 90148 (
TEDIT.FORMAT.HARDCOPY 31876 . 42886) (TEDIT.FORMATBOX 42888 . 55048) (TEDIT.FORMATHEADING 55050 .
58664) (TEDIT.FORMATPAGE 58666 . 66869) (TEDIT.FORMATTEXTBOX 66871 . 81654) (TEDIT.FORMATFOLIO 81656
. 86040) (\TEDIT.FORMAT.FOUNDBOX? 86042 . 88081) (TEDIT.SKIP.SPECIALCOND 88083 . 90146)) (90228 92509
(TEDIT.HARDCOPY.PAGEHEADINGS 90238 . 92507)) (92618 99801 (TEDIT.HARDCOPY-COLUMN-END 92628 . 99799))
(99846 104787 (SCALEPAGEUNITS 99856 . 100997) (SCALEPAGEXUNITS 100999 . 101769) (SCALEPAGEYUNITS
101771 . 102542) (\TEDIT.PAPERHEIGHT 102544 . 103479) (\TEDIT.PAPERWIDTH 103481 . 104785)) (105203
108771 (ROMANNUMERALS 105213 . 108769)) (108807 111253 (\TEDIT.FORMAT.FOOTNOTE 108817 . 111251)))))
(FILEMAP (NIL (12038 15371 (\TEDIT.PARSE.PAGEFRAMES 12048 . 13548) (\TEDIT.PUT.PAGEFRAMES 13550 .
14374) (\TEDIT.UNPARSE.PAGEFRAMES 14376 . 15369)) (15434 31896 (TEDIT.SINGLE.PAGEFORMAT 15444 . 25662)
(TEDIT.COMPOUND.PAGEFORMAT 25664 . 26643) (TEDIT.PAGEFORMAT 26645 . 31894)) (31983 91368 (
TEDIT.FORMAT.HARDCOPY 31993 . 42983) (TEDIT.FORMATBOX 42985 . 55757) (TEDIT.FORMATHEADING 55759 .
59542) (TEDIT.FORMATPAGE 59544 . 67846) (TEDIT.FORMATTEXTBOX 67848 . 82631) (TEDIT.FORMATFOLIO 82633
. 87260) (\TEDIT.FORMAT.FOUNDBOX? 87262 . 89301) (TEDIT.SKIP.SPECIALCOND 89303 . 91366)) (91448 93729
(TEDIT.HARDCOPY.PAGEHEADINGS 91458 . 93727)) (93838 101021 (TEDIT.HARDCOPY-COLUMN-END 93848 . 101019)
) (101066 106007 (SCALEPAGEUNITS 101076 . 102217) (SCALEPAGEXUNITS 102219 . 102989) (SCALEPAGEYUNITS
102991 . 103762) (\TEDIT.PAPERHEIGHT 103764 . 104699) (\TEDIT.PAPERWIDTH 104701 . 106005)) (106423
109991 (ROMANNUMERALS 106433 . 109989)) (110027 112404 (\TEDIT.FORMAT.FOOTNOTE 110037 . 112402)))))
STOP

BIN
library/tedit/TEDIT-PAGE.LCOM
View File

Binary file not shown.

71
library/tedit/TEDIT-SCREEN
View File

@@ -1,12 +1,17 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 4-Mar-2024 22:50:24" {WMEDLEY}<library>tedit>TEDIT-SCREEN.;612 184763
(FILECREATED "14-Mar-2024 12:53:18" {WMEDLEY}<library>tedit>TEDIT-SCREEN.;618 186031
:EDIT-BY rmk
:CHANGES-TO (FNS \TEDIT.MARK.LINES.DIRTY)
:CHANGES-TO (FNS \FORMATLINE \TEDIT.CREATEPLINE)
(I.S.OPRS inlines backlines incharslots backcharslots)
(RECORDS THISLINE LINECACHE LINEDESCRIPTOR CHARSLOT)
(MACROS GETLD FGETLD SETLD FSETLD SETYPOS LINKLD HCSCALE HCUNSCALE CHAR CHARW
PREVCHARSLOT PREVCHARSLOT! NEXTCHARSLOT FIRSTCHARSLOT NTHCHARSLOT
LASTCHARSLOT FILLCHARSLOT BACKCHARS PUSHCHAR POPCHAR CHARSLOTP DIACRITICP)
:PREVIOUS-DATE " 2-Mar-2024 07:40:06" {WMEDLEY}<library>tedit>TEDIT-SCREEN.;611)
:PREVIOUS-DATE "13-Mar-2024 14:40:10" {WMEDLEY}<library>tedit>TEDIT-SCREEN.;613)
(PRETTYCOMPRINT TEDIT-SCREENCOMS)
@@ -146,7 +151,7 @@
NEXTLINE (* ; "Next line chain pointer")
(PREVLINE FULLXPOINTER) (* ; "Previous line chain pointer")
LMARK (* ; "One of SOLID, GREY, NIL. Tells what kind of special-line marker should be put in the left margin for this paragraph. (For hardcopy, can also be an indicator for special processing?)")
LTEXTOBJ (* ; "A cached TEXTOBJ that this line took its text from. Used only in hardcopy to disambiguate when chno's should be updated.")
LTEXTSTREAM (* ; "A cached textstream that this line took its text from. Filled in by \TEDIT.FORMATLINE only in hardcopy, used temporarily and the cleared by \TEDIT.FORMATBOX to avoid the circularity.")
NIL (* ; "Was CACHE: A cached THISLINE, for keeping hardcopy info around while we crunch with the line descriptors to make things fit. Now: THISLINE comes from TEXTOBJ")
NIL (* ;
 "Was LDOBJ: The object which lies behind this line of text, for updating, etc.")
@@ -616,6 +621,7 @@
(\FORMATLINE
[LAMBDA (TEXTOBJ CH#1 LINE REGION IMAGESTREAM FORMATTINGSTATE)
(* ; "Edited 14-Mar-2024 12:53 by rmk")
(* ; "Edited 2-Mar-2024 07:39 by rmk")
(* ; "Edited 5-Feb-2024 09:35 by rmk")
(* ; "Edited 26-Jan-2024 11:01 by rmk")
@@ -1072,6 +1078,14 @@
(* ;;
 "Ran out of TEXTLEN (and paragraph). Back up and force a break. Are ASCENT/DESCENT correct?")
(CL:WHEN (AND (EQ PREVSP (PREVCHARSLOT CHARSLOT))
(NULL (CHAR PREVSP)))
(* ;; "The line ended in a space that needs to be resolved. If we coded the end of a space-chain as (CHARCODE SPACE) instead of NIL, maybe this wouldn't be necessary.")
(FILLCHARSLOT PREVSP (CHARCODE SPACE)
(CHARW PREVSP))
(SETQ PREVSP NIL))
(SETQ CHARSLOT (PREVCHARSLOT! CHARSLOT))
(add CHNO -1)
(SETQ DX 0) (* ; "TX is already correct")
@@ -1142,10 +1156,13 @@
(* ;; "")
(FSETLD LINE LFMTSPEC FMTSPEC)
(FSETLD LINE LTEXTOBJ TEXTOBJ) (* ;
 "XPOINTER, valid if TEXTOBJ is held")
(CL:WHEN (EQ LINETYPE 'TRUEHARDCOPY)
(* ;; "Used temporarily and cleared by \TEDIT.FORMATBOX; not an XPOINTER")
(FSETLD LINE LTEXTSTREAM TSTREAM))
(freplace (THISLINE DESC) of THISLINE with LINE)
(\TEDIT.FORMATLINE.VERTICAL LINE TEXTOBJ)
(\TEDIT.FORMATLINE.VERTICAL LINE TSTREAM)
(\TEDIT.FORMATLINE.HORIZONTAL LINE THISLINE PREVSP SPACELEFT OVERHANG LINETYPE)
(* ;; "Finally translate to the left edge, perhsps a specialx if true hardcopy.")
@@ -2347,7 +2364,8 @@
(FSETTOBJ TEXTOBJ TXTNEEDSUPDATE NIL))])
(\TEDIT.CREATEPLINE
[LAMBDA (TEXTOBJ PANE FIRSTLINE) (* ; "Edited 21-Feb-2024 23:36 by rmk")
[LAMBDA (TEXTOBJ PANE FIRSTLINE) (* ; "Edited 13-Mar-2024 17:02 by rmk")
(* ; "Edited 21-Feb-2024 23:36 by rmk")
(* ; "Edited 2-Jan-2024 13:04 by rmk")
(* ; "Edited 29-Dec-2023 15:48 by rmk")
@@ -2377,8 +2395,7 @@
LTRUEDESCENT _ 0
LFMTSPEC _ TEDIT.DEFAULT.FMTSPEC
1STLN _ NIL
LSTLN _ NIL
LTEXTOBJ _ TEXTOBJ))
LSTLN _ NIL))
(replace (TEXTWINDOW PLINES) of PANE with DUMMYLINE)(* ; "Install PANE's new dummy line")
(LINKLD DUMMYLINE FIRSTLINE) (* ; "Link the possible first line")
DUMMYLINE])
@@ -2928,21 +2945,21 @@
(SETQ TAILLINE NIL))))])
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (24320 25729 (\TEDIT.LINEDESCRIPTOR.DEFPRINT 24330 . 25727)) (33226 109797 (\FORMATLINE
33236 . 67170) (\FORMATLINE.SETUP 67172 . 70557) (\TEDIT.FORMATLINE.HORIZONTAL 70559 . 74834) (
\TEDIT.FORMATLINE.VERTICAL 74836 . 76805) (\FORMATLINE.JUSTIFY 76807 . 82741) (\FORMATLINE.TABS 82743
. 90224) (\FORMATLINE.SCALETABS 90226 . 91223) (\FORMATLINE.PURGE.SPACES 91225 . 92529) (
\FORMATLINE.EMPTY 92531 . 97234) (\FORMATLINE.UPDATELOOKS 97236 . 104181) (\FORMATLINE.LASTLEGAL
104183 . 107659) (\FORMATBLOCK 107661 . 109795)) (109914 112220 (\CLEARTHISLINE 109924 . 110593) (
\TLVALIDATE 110595 . 112218)) (112414 132131 (\DISPLAYLINE 112424 . 124536) (\DISPLAYLINE.TABS 124538
. 127155) (\TEDIT.LINECACHE 127157 . 127885) (\TEDIT.CREATE.LINECACHE 127887 . 128723) (
\TEDIT.BLTCHAR 128725 . 131246) (\TEDIT.DIACRITIC.SHIFT 131248 . 132129)) (132746 184740 (
TEDIT.UPDATE.SCREEN 132756 . 134395) (\BACKFORMAT 134397 . 136151) (\TEDIT.PREVIOUS.LINEBREAK 136153
. 138341) (\FILLPANE 138343 . 140662) (\TEDIT.UPDATE.LINES 140664 . 145543) (\TEDIT.CREATEPLINE
145545 . 147315) (\TEDIT.FIND.DIRTYCHARS 147317 . 149329) (\TEDIT.FORMATLINES 149331 . 152680) (
\FORMAT.GAP.LINES 152682 . 156546) (\TEDIT.LOWER.LINES 156548 . 160800) (\TEDIT.RAISE.LINES 160802 .
164127) (\TEDIT.VALID.LINES 164129 . 173413) (\TEDIT.CLEARPANE.BELOW.LINE 173415 . 174733) (
\TEDIT.INSERTLINE 174735 . 175993) (\TEDIT.INSURE.TRAILING.LINE 175995 . 177183) (
\TEDIT.MARK.LINES.DIRTY 177185 . 179896) (\TEDIT.LINE.BOTTOM 179898 . 182738) (\TEDIT.NCONC.LINES
182740 . 184738)))))
(FILEMAP (NIL (24822 26231 (\TEDIT.LINEDESCRIPTOR.DEFPRINT 24832 . 26229)) (33728 110992 (\FORMATLINE
33738 . 68365) (\FORMATLINE.SETUP 68367 . 71752) (\TEDIT.FORMATLINE.HORIZONTAL 71754 . 76029) (
\TEDIT.FORMATLINE.VERTICAL 76031 . 78000) (\FORMATLINE.JUSTIFY 78002 . 83936) (\FORMATLINE.TABS 83938
. 91419) (\FORMATLINE.SCALETABS 91421 . 92418) (\FORMATLINE.PURGE.SPACES 92420 . 93724) (
\FORMATLINE.EMPTY 93726 . 98429) (\FORMATLINE.UPDATELOOKS 98431 . 105376) (\FORMATLINE.LASTLEGAL
105378 . 108854) (\FORMATBLOCK 108856 . 110990)) (111109 113415 (\CLEARTHISLINE 111119 . 111788) (
\TLVALIDATE 111790 . 113413)) (113609 133326 (\DISPLAYLINE 113619 . 125731) (\DISPLAYLINE.TABS 125733
. 128350) (\TEDIT.LINECACHE 128352 . 129080) (\TEDIT.CREATE.LINECACHE 129082 . 129918) (
\TEDIT.BLTCHAR 129920 . 132441) (\TEDIT.DIACRITIC.SHIFT 132443 . 133324)) (133941 186008 (
TEDIT.UPDATE.SCREEN 133951 . 135590) (\BACKFORMAT 135592 . 137346) (\TEDIT.PREVIOUS.LINEBREAK 137348
. 139536) (\FILLPANE 139538 . 141857) (\TEDIT.UPDATE.LINES 141859 . 146738) (\TEDIT.CREATEPLINE
146740 . 148583) (\TEDIT.FIND.DIRTYCHARS 148585 . 150597) (\TEDIT.FORMATLINES 150599 . 153948) (
\FORMAT.GAP.LINES 153950 . 157814) (\TEDIT.LOWER.LINES 157816 . 162068) (\TEDIT.RAISE.LINES 162070 .
165395) (\TEDIT.VALID.LINES 165397 . 174681) (\TEDIT.CLEARPANE.BELOW.LINE 174683 . 176001) (
\TEDIT.INSERTLINE 176003 . 177261) (\TEDIT.INSURE.TRAILING.LINE 177263 . 178451) (
\TEDIT.MARK.LINES.DIRTY 178453 . 181164) (\TEDIT.LINE.BOTTOM 181166 . 184006) (\TEDIT.NCONC.LINES
184008 . 186006)))))
STOP

BIN
library/tedit/TEDIT-SCREEN.LCOM
View File

Binary file not shown.

260
library/tedit/TEDIT-STRESS Normal file
View File

@@ -0,0 +1,260 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "14-Mar-2024 15:16:05" {WMEDLEY}<library>tedit>TEDIT-STRESS.;49 12388
:EDIT-BY rmk
:CHANGES-TO (FNS STRESSHC)
:PREVIOUS-DATE "13-Mar-2024 00:24:06" {WMEDLEY}<library>tedit>TEDIT-STRESS.;48)
(PRETTYCOMPRINT TEDIT-STRESSCOMS)
(RPAQQ TEDIT-STRESSCOMS ( (* ; "Preload typical image objects")
(FILES SKETCH DATEFORMAT-EDITOR)
(FNS STRESSHC STRESSRAND STRESSPUT STRESSOPEN STRESSREAD)
(FNS EQTEXTSTREAM SYSOUTRING COPYTOCORE)))
(* ; "Preload typical image objects")
(FILESLOAD SKETCH DATEFORMAT-EDITOR)
(DEFINEQ
(STRESSHC
[LAMBDA (FILES NSYSOUTS REPS NOERROR SEPARATEOUT PDF SYSOUTNAME SINGLESTEP)
(* ; "Edited 14-Mar-2024 15:15 by rmk")
(* ; "Edited 13-Mar-2024 00:23 by rmk")
(DECLARE (SPECVARS SINGLESTEP))
(* ;; "If all arguments are defaulted, runs through all TEDIT files in the current directory until it fails, doing SAVEVM before each file. The HC files are made as {CORE}FOO.PS.")
(CL:UNLESS FILES
(SETQ FILES (FILDIR '*.TEDIT;)))
(SETQ REPS (SELECTQ REPS
(NIL MAX.SMALLP)
REPS))
(SETQ NOERROR T)
(CL:UNLESS NSYSOUTS
(SETQ NSYSOUTS 'SAVEVM))
[SETQ SYSOUTNAME (PACKFILENAME 'VERSION NIL 'BODY (OR SYSOUTNAME (PACKFILENAME 'DIRECTORY
MEDLEYDIR 'NAME
"STRESSHC" 'EXTENSION
'SYSOUT]
(PRINTOUT T REPS " reps of " (LENGTH FILES)
" files saving "
(if (EQ NSYSOUTS 0)
then "no sysouts"
elseif (EQ NSYSOUTS 'SAVEVM)
then " the virtual memory"
else (PRINTOUT NIL NSYSOUTS " sysouts on " 3)
SYSOUTNAME)
T)
(PRINTOUT T "First file is " (CAR FILES)
T T)
(BKSYSBUF " ")
(for R SYSOUTS (ITYPE _ (CL:IF PDF
'pdf
'ps))
(N _ 0) from 1 to REPS
do (PRINTOUT T "Rep " R T)
(if (EQ NSYSOUTS 'SAVEVM)
then (SAVEVM)
else (SETQ SYSOUTS (SYSOUTRING NSYSOUTS SYSOUTNAME SYSOUTS)))
[for F TS HCFILE inside FILES
do (PROMPTPRINT F)
(SETQ HCFILE (CL:IF SEPARATEOUT
(OUTFILEP (PACKFILENAME 'EXTENSION ITYPE 'VERSION 1 'BODY F))
(CL:IF PDF
"{CORE}FOO.PDF;1"
"{CORE}FOO.PS;1")))
(if [if NOERROR
then [NLSETQ (SETQ TS (OPENTEXTSTREAM F))
(TEDIT.FORMAT.HARDCOPY TS HCFILE T NIL NIL NIL
(CL:IF PDF
'PDF
'POSTSCRIPT)]
else (SETQ TS (OPENTEXTSTREAM F))
(TEDIT.FORMAT.HARDCOPY TS HCFILE T NIL NIL NIL (CL:IF PDF
'PDF
'POSTSCRIPT)]
then (add N 1)
else (PRINTOUT T " Error for " (PACKFILENAME 'HOST NIL 'DIRECTORY NIL 'BODY F)
T))
(CLOSEF? TS)
(CL:WHEN SINGLESTEP
(HELP (CONCAT "Just hardcopied " F " to " HCFILE)))]
(PRINTOUT T " Hardcopied " N " files without failure" T)
finally (RETURN (LIST R N])
(STRESSRAND
[LAMBDA (FILES REPS NOERROR PROBESPERFILE) (* ; "Edited 12-Mar-2024 09:47 by rmk")
(* ;; "Opens, fetches random characters")
(CL:UNLESS FILES
(SETQ FILES (FILDIR '*.TEDIT;)))
(SETQ REPS (SELECTQ REPS
(T MAX.SMALLP)
(NIL 1)
REPS))
(CL:UNLESS PROBESPERFILE (SETQ PROBESPERFILE 100))
(PRINTOUT T REPS " reps of " (LENGTH FILES)
" files with " PROBESPERFILE " probes per file" T)
(for R (N _ 0) from 1 to REPS
do (PRINTOUT T R " ")
(for F TS inside FILES
do (if [if NOERROR
then [NLSETQ (SETQ TS (OPENTEXTSTREAM F))
(for I (LEN _ (TEDIT.NCHARS TS)) from 1 to PROBESPERFILE
do (TEDIT.NTHCHARCODE TS (RAND 1 LEN]
else (SETQ TS (OPENTEXTSTREAM F))
(for I (LEN _ (TEDIT.NCHARS TS)) from 1 to PROBESPERFILE
do (TEDIT.NTHCHARCODE TS (RAND 1 LEN]
then (CLOSEF TS)
(add N 1)
else (PRINTOUT T T "Error for " (PACKFILENAME 'HOST NIL 'DIRECTORY NIL 'BODY F)
T))) finally (RETURN (LIST R N])
(STRESSPUT
[LAMBDA (FILES REPS NOERROR CHECKEQUIV STOP) (* ; "Edited 12-Mar-2024 09:48 by rmk")
(* ;; "Opens, puts, reopens and tests for equivalence")
(CL:UNLESS FILES
(SETQ FILES (FILDIR '*.TEDIT;)))
(SETQ REPS (SELECTQ REPS
(T MAX.SMALLP)
(NIL 1)
REPS))
(PRINTOUT T REPS " reps of " (LENGTH FILES)
" files" T)
(for R (N _ 0) from 1 to REPS
do (PRINTOUT T R " ")
(for F TS TSP inside FILES
do (if (if NOERROR
then (NLSETQ (SETQ TS (OPENTEXTSTREAM F))
(TEDIT.PUT TS "{CORE}FOO.TEDIT;1")
(SETQ TSP (OPENTEXTSTREAM "{CORE}FOO.TEDIT;1"))
(CL:WHEN (AND CHECKEQUIV (NOT (EQTEXTSTREAM TS TSP STOP)))
(HELP "Get of put not equivalent" F))
(CLOSEF TSP))
else (SETQ TS (OPENTEXTSTREAM F))
(TEDIT.PUT TS "{CORE}FOO.TEDIT;1")
(SETQ TSP (OPENTEXTSTREAM "{CORE}FOO.TEDIT;1"))
(CL:WHEN (AND CHECKEQUIV (NOT (EQTEXTSTREAM TS TSP STOP)))
(HELP "Get of put not equivalent" F))
(CLOSEF TSP))
then (CLOSEF TS)
(add N 1)
else (PRINTOUT T T "Error for " (PACKFILENAME 'HOST NIL 'DIRECTORY NIL 'BODY F)
T))) finally (RETURN (LIST R N])
(STRESSOPEN
[LAMBDA (FILES REPS NOERROR) (* ; "Edited 12-Mar-2024 09:48 by rmk")
(* ; "Edited 11-Mar-2024 09:15 by rmk")
(CL:UNLESS FILES
(SETQ FILES (FILDIR '*.TEDIT;)))
(SETQ REPS (SELECTQ REPS
(T MAX.SMALLP)
(NIL 1)
REPS))
(PRINTOUT T REPS " reps of " (LENGTH FILES)
" files" T)
(for R (N _ 0) from 1 to REPS
do (PRINTOUT T R " ")
(for F TS inside FILES do (if (if NOERROR
then (NLSETQ (SETQ TS (OPENTEXTSTREAM F)))
else (SETQ TS (OPENTEXTSTREAM F)))
then (CLOSEF TS)
(add N 1)
else (PRINTOUT T T "Error for " (PACKFILENAME 'HOST NIL
'DIRECTORY NIL
'BODY F)
T))) finally (RETURN (LIST R N])
(STRESSREAD
[LAMBDA (FILES REPS NOERROR) (* ; "Edited 12-Mar-2024 09:48 by rmk")
(* ; "Edited 11-Mar-2024 09:13 by rmk")
(CL:UNLESS FILES
(SETQ FILES (FILDIR '*.TEDIT;)))
(SETQ REPS (SELECTQ REPS
(T MAX.SMALLP)
(NIL 1)
REPS))
(PRINTOUT T REPS " reps of " (LENGTH FILES)
" files" T)
(for R (N _ 0) from 1 to REPS
do (PRINTOUT T R " ")
(for F TS inside FILES
do (if (if NOERROR
then (NLSETQ (SETQ TS (OPENTEXTSTREAM F))
(for I from 1 while (TEDIT.NTHCHARCODE TS I)))
else (SETQ TS (OPENTEXTSTREAM F))
(for I from 1 while (TEDIT.NTHCHARCODE TS I)))
then (CLOSEF TS)
(add N 1)
else (PRINTOUT T T "Error for " (PACKFILENAME 'HOST NIL 'DIRECTORY NIL 'BODY F)
T))) finally (RETURN (LIST R N])
)
(DEFINEQ
(EQTEXTSTREAM
[LAMBDA (TS1 TS2 STOP) (* ; "Edited 11-Mar-2024 16:53 by rmk")
(AND (IEQP (TEDIT.NCHARS TS1)
(TEDIT.NCHARS TS2))
(OR (for I C1 C2 from 1 to (TEDIT.NCHARS TS1) eachtime (SETQ C1 (TEDIT.NTHCHARCODE TS1 I))
(SETQ C2 (TEDIT.NTHCHARCODE TS2 I))
unless (OR (EQ C1 C2)
(AND (EQ C1 10)
(EQ C2 13))
(AND (EQ C1 13)
(EQ C2 10))
(AND (IMAGEOBJP C1)
(IMAGEOBJP C2)
(EQUALALL C1 C2))) do (CL:WHEN STOP
(HELP "Different characters: "
(LIST I C1 C2)))
(RETURN NIL) finally (RETURN T])
(SYSOUTRING
[LAMBDA (NSYSOUTS SYSOUTNAME SYSOUTS) (* ; "Edited 12-Mar-2024 17:52 by rmk")
(* ;; "SYSOUTS is the list of names of sysouts that currently exist.")
(DECLARE (USEDFREE SINGLESTEP))
(CL:WHEN (IGREATERP NSYSOUTS 0) (* ;
 "Keep NSYSOUT sysouts with increasing versions")
(CL:WHEN (IGEQ (LENGTH SYSOUTS)
NSYSOUTS)
(DELFILE (pop SYSOUTS))) (* ;
 "Drop the firstr (oldest), new one goes at the end")
(SETQ SYSOUTNAME (SYSOUT SYSOUTNAME))
(CL:WHEN (LISTP SYSOUTNAME) (* ; "Restarting")
(SETQ SINGLESTEP T))
(NCONC1 SYSOUTS SYSOUTNAME))])
(COPYTOCORE
[LAMBDA (FILES NORECLAIM) (* ; "Edited 12-Mar-2024 22:45 by rmk")
(* ;; "Copy FILES to {CORE}, defaulting to TEDIT files in connected directory")
(CL:UNLESS (LISTP FILES)
(SETQ FILES (FILDIR (OR FILES "*.TEDIT;"))))
(PRINTOUT T "Copying " (LENGTH FILES)
" files to {CORE} "
(CL:IF NORECLAIM
"without "
"with ")
"reclaiming" T)
(for F in FILES collect (COPYFILE F (PACKFILENAME 'HOST 'CORE 'DIRECTORY NIL 'BODY F))
finally (CL:UNLESS NORECLAIM (RECLAIM])
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (742 9789 (STRESSHC 752 . 4159) (STRESSRAND 4161 . 5577) (STRESSPUT 5579 . 7289) (
STRESSOPEN 7291 . 8579) (STRESSREAD 8581 . 9787)) (9790 12365 (EQTEXTSTREAM 9800 . 10851) (SYSOUTRING
10853 . 11733) (COPYTOCORE 11735 . 12363)))))
STOP

BIN
library/tedit/TEDIT-STRESS.LCOM Normal file
View File

Binary file not shown.

102
lispusers/GREP
View File

@@ -1,32 +1,33 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "19-Jul-2022 22:26:08" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GREP.;11 4725
(FILECREATED "16-Mar-2024 11:16:38" {WMEDLEY}<lispusers>GREP.;31 6115
:EDIT-BY rmk
:CHANGES-TO (FNS DOGREP)
:PREVIOUS-DATE "26-Jun-2022 14:36:21"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GREP.;9)
:PREVIOUS-DATE "15-Mar-2024 16:28:09" {WMEDLEY}<lispusers>GREP.;29)
(* ; "
Copyright (c) 1984-1986 by Xerox Corporation.
")
(PRETTYCOMPRINT GREPCOMS)
(RPAQQ GREPCOMS ((FNS DOGREP GREP PHONE)
(INITVARS (PHONELISTFILES))))
(RPAQQ GREPCOMS [(FNS DOGREP GREP TGREP)
(P (MOVD? 'NILL 'TEDIT.FORMATTEDFILEP))
(COMS (FNS PHONE)
(INITVARS (PHONELISTFILES])
(DEFINEQ
(DOGREP
[LAMBDA (STRS FILES OUTSTREAM)
(* ;; "Edited 16-Mar-2024 11:16 by rmk")
(* ;; "Edited 20-Jan-2024 13:12 by rmk")
(* ;; "Edited 19-Jul-2022 22:26 by rmk")
(* ;; "Edited 26-Jun-2022 14:36 by rmk")
(* ;; "Edited 18-Jun-2022 10:38 by rmk: Search for linebreaks directly, without calling BFILEPOS or FILEPOS just for EOL character. Also now compatible with external formats (if FFILEPOS is), and upgraded to full directory specification")
(* Newman "14-May-86 08:04")
(* Newman "14-May-86 08:04")
(* ;;; "Originally coded by Larry Masinter.")
@@ -46,50 +47,81 @@ Copyright (c) 1984-1986 by Xerox Corporation.
(STREAM (OR (FINDFILE FILES T)
FILES)
:DIRECTION :INPUT)
(bind FOUND for STR inside STRS first (SETFILEINFO STREAM 'ENDOFSTREAMOP
(FUNCTION NILL))
(for STR FOUND FILENAME inside STRS first (SETQ FILENAME (FULLNAME STREAM))
(CL:WHEN (TEDIT.FORMATTEDFILEP STREAM)
[SETQ STREAM (OPENTEXTSTREAM
STREAM NIL NIL NIL
'(OBJECTBYTE 0])
(SETFILEINFO STREAM 'ENDOFSTREAMOP
(FUNCTION NILL))
do (SETFILEPTR STREAM 0)
(bind POS while (SETQ POS (FFILEPOS STR STREAM NIL NIL NIL NIL UPPERCASEARRAY))
do (OR FOUND (PROGN (PRINTOUT OUTSTREAM T .FONT COMMENTFONT "(from "
(FULLNAME STREAM)
")" .FONT DEFAULTFONT T)
(SETQ FOUND T)))
(bind POS STARTPOS while (SETQ POS (FFILEPOS STR STREAM NIL NIL NIL NIL
UPPERCASEARRAY))
do (CL:UNLESS FOUND
(PRINTOUT OUTSTREAM T T .FONT BOLDFONT "(from " FILENAME ")" .FONT
DEFAULTFONT T)
(SETQ FOUND T))
(* ;; "Copying from the beginning of this line. Originally this used BFILEPOS (backwards FILEPOS?), which did repeated calls to forward FFILEPOS in what appears to be a binary set of probes. But FFILEPOS is really SLOW-POS for a single character, and the last line-start is presumaby not that far back. So just walk backwards.")
(COPYCHARS STREAM OUTSTREAM (DO (SELCHARQ (\BACKCCODE.EOLC STREAM
'ANY)
(EOL (\INCCODE.EOLC STREAM)
(RETURN (GETFILEPTR STREAM)))
(NIL (RETURN 0))
NIL))
POS)
(SETQ STARTPOS (DO (SELCHARQ (\BACKCCODE.EOLC STREAM 'ANY)
(EOL (\INCCODE.EOLC STREAM)
(RETURN (GETFILEPTR STREAM)))
(NIL (RETURN 0))
NIL)))
(FOR I C FROM 1 TO (IDIFFERENCE POS STARTPOS)
DO (SETQ C (\INCCODE.EOLC STREAM 'ANY))
(CL:UNLESS (ILESSP C (CHARCODE TAB))
(PRINTCCODE C OUTSTREAM)))
(DSPFONT BOLDFONT OUTSTREAM)
(COPYCHARS STREAM OUTSTREAM POS (ADD POS (NCHARS STR)))
(DSPFONT DEFAULTFONT OUTSTREAM)
(* ;; "Copying to the end of this line (or end of file)")
(BIND C DO (SELCHARQ (SETQ C (\INCCODE.EOLC STREAM 'ANY))
[BIND C DO (SELCHARQ (SETQ C (\INCCODE.EOLC STREAM 'ANY))
((EOL NIL)
(RETURN))
(PRINTCCODE C OUTSTREAM)))
(CL:UNLESS (ILESSP C (CHARCODE TAB))
(PRINTCCODE C OUTSTREAM]
(TERPRI OUTSTREAM])
(GREP
[LAMBDA (STRS FILES OUTSTREAM)
(* ;; "Edited 14-Oct-2023 14:43 by rmk")
(* ;; "Edited 1-Sep-2023 00:16 by rmk")
(* ;; "Edited 23-Jul-2023 19:55 by rmk")
(* ;; "Edited 26-Jun-2022 13:28 by rmk: added OUTSTREAM")
(* ;; "Edited 26-Jun-2022 13:25 by rmk")
(* ;; "Edited 18-Jun-2022 09:50 by rmk")
(CL:UNLESS OUTSTREAM (SETQ OUTSTREAM T)) (* lmm " 1-Apr-85 15:27")
(* lmm " 1-Apr-85 15:27")
(* lmm " 1-Apr-85 15:27")
(RESETLST
[SELECTQ OUTSTREAM
(NIL (SETQ OUTSTREAM T))
(T)
(CL:UNLESS (GETSTREAM OUTSTREAM 'OUTPUT T)
[RESETSAVE (SETQ OUTSTREAM (OPENSTREAM OUTSTREAM 'OUTPUT 'NEW))
`(PROGN (CLOSEF? OLDVALUE])]
[RESETSAVE NIL `(PROGN (DSPFONT ,(DSPFONT NIL OUTSTREAM)
,OUTSTREAM]
(DOGREP STRS FILES T OUTSTREAM))])
[RESETSAVE (LINELENGTH T OUTSTREAM)
`(PROGN (LINELENGTH OLDVALUE ,OUTSTREAM]
(DOGREP STRS FILES OUTSTREAM)
OUTSTREAM)])
(TGREP
[LAMBDA (STRS FILES) (* ; "Edited 20-Jan-2024 14:14 by rmk")
(TEXTSTREAM (TEDIT (GREP STRS FILES (OPENTEXTSTREAM))
'TGREP NIL '(READONLY T])
)
(MOVD? 'NILL 'TEDIT.FORMATTEDFILEP)
(DEFINEQ
(PHONE
[LAMBDA (NAME) (* lmm " 5-Mar-86 12:14")
@@ -97,7 +129,7 @@ Copyright (c) 1984-1986 by Xerox Corporation.
)
(RPAQ? PHONELISTFILES )
(PUTPROPS GREP COPYRIGHT ("Xerox Corporation" 1984 1985 1986))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (518 4610 (DOGREP 528 . 3944) (GREP 3946 . 4423) (PHONE 4425 . 4608)))))
(FILEMAP (NIL (496 5830 (DOGREP 506 . 4544) (GREP 4546 . 5596) (TGREP 5598 . 5828)) (5868 6063 (PHONE
5878 . 6061)))))
STOP

BIN
lispusers/GREP.LCOM
View File

Binary file not shown.

BIN
lispusers/GREP.TEDIT
View File

Binary file not shown.

74
sources/ADIR
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "13-Nov-2023 20:28:57" {WMEDLEY}<sources>ADIR.;31 67473
(FILECREATED " 9-Mar-2024 10:24:39" {WMEDLEY}<sources>ADIR.;38 67777
:EDIT-BY rmk
:CHANGES-TO (FNS UNPACKFILENAME.STRING)
:CHANGES-TO (FNS UNPACKFILENAME.STRING FILENAMEFIELD FILENAMEFIELD.STRING \UPF.DIRECTORY)
:PREVIOUS-DATE "14-Sep-2023 23:20:17" {WMEDLEY}<sources>ADIR.;30)
:PREVIOUS-DATE "13-Nov-2023 20:28:57" {WMEDLEY}<sources>ADIR.;31)
(PRETTYCOMPRINT ADIRCOMS)
@@ -317,7 +317,8 @@
(DEFINEQ
(UNPACKFILENAME.STRING
[LAMBDA (FILE ONEFIELDFLG DIRFLG OSTYPE PACKFLG CLFLG) (* ; "Edited 13-Nov-2023 20:28 by rmk")
[LAMBDA (FILE ONEFIELDFLG DIRFLG OSTYPE PACKFLG CLFLG) (* ; "Edited 9-Mar-2024 10:23 by rmk")
(* ; "Edited 13-Nov-2023 20:28 by rmk")
(* ; "Edited 28-Apr-2022 11:40 by rmk")
(* ; "Edited 24-Apr-2022 14:11 by rmk")
@@ -367,6 +368,12 @@
(* ;; "")
(* ;; "These coercions were formerly in FILENAMEFIELD and FILENAMEFIELD.STRING. But they presumably should work everywhere.")
(SELECTQ ONEFIELDFLG
(STRUCTURE (SETQ ONEFIELDFLG 'DEVICE))
(GENERATION (SETQ ONEFIELDFLG 'VERSION))
NIL)
(PROG NIL
(COND
((NULL FILE)
@@ -386,6 +393,9 @@
FILE)
(LIST 'NAME FILE))]
(T (\ILLEGAL.ARG FILE)))
(CL:WHEN (EQ (NCHARS FILE)
0)
(RETURN NIL))
(* ;;
 "Parse the string to find marker positions. The format (parens mean optional, [ ] group, | disjoins")
@@ -583,11 +593,12 @@
(* ;; "")
(* ;; " DIRFLG is RETURN on calls (\UPFDirectoryNameP CL:USER-HOMEDIR-PATHNAME) where FILE is known to have no more than a directory, but the directory might not end with / or > (e.g. %"{DSK}/Users/kaplan%". If we don't do something, %"kaplan%" would be seen as the NAME. ")
(* ;; " DIRFLG is RETURN on calls (\UFSDirectoryNameP CL:USER-HOMEDIR-PATHNAME) where FILE is known to have no more than a directory, but the directory might not end with / or > (e.g. %"{DSK}/Users/kaplan%". If we don't do something, %"kaplan%" would be seen as the NAME. ")
(CL:WHEN [AND (EQ DIRFLG 'RETURN)
(NOT (FMEMB (\GETBASECHAR $$FATP $$BASE $$END)
(CHARCODE (> / <]
(OR (ILESSP $$END $$OFFSET)
(NOT (FMEMB (\GETBASECHAR $$FATP $$BASE $$END)
(CHARCODE (> / <]
(SETQ DIRSTART STARTPOS)
(SETQ DIREND (ADD1 $$END))
(SETQ DIRDIRTY T)
@@ -651,7 +662,8 @@
(PUSH $$VAL F FVAL])
(\UPF.DIRECTORY
[LAMBDA (DIRSTART DIREND DIRDIRTY $$BASE $$FATP $$READONLY)(* ; "Edited 28-Apr-2022 09:15 by rmk")
[LAMBDA (DIRSTART DIREND DIRDIRTY $$BASE $$FATP $$READONLY)(* ; "Edited 8-Mar-2024 23:03 by rmk")
(* ; "Edited 28-Apr-2022 09:15 by rmk")
(* ; "Edited 27-Apr-2022 08:50 by rmk")
(* ; "Edited 23-Apr-2022 17:09 by rmk")
@@ -666,9 +678,9 @@
NIL)))
(IF (EQ DIREND DIRSTART)
THEN
(* ;; "If EQ, the directory is just the bracket, the rest is must be the name.")
(* ;; "If EQ, the directory is is empty.")
BRACKET
(MKSTRING "")
ELSE (CL:WHEN BRACKET (* ; "Skip the < or /")
(ADD DIRSTART 1))
@@ -753,25 +765,15 @@
(RETURN RESULT])
(FILENAMEFIELD
[LAMBDA (FILE FIELDNAME) (* ; "Edited 6-Mar-90 19:38 by nm")
(UNPACKFILENAME.STRING FILE (SELECTQ FIELDNAME
((VERSION GENERATION)
'VERSION)
((DEVICE STRUCTURE)
'DEVICE)
FIELDNAME)
'FIELD NIL T])
[LAMBDA (FILE FIELDNAME) (* ; "Edited 9-Mar-2024 10:24 by rmk")
(* ; "Edited 6-Mar-90 19:38 by nm")
(UNPACKFILENAME.STRING FILE FIELDNAME 'FIELD NIL T])
(FILENAMEFIELD.STRING
[LAMBDA (FILE FIELDNAME) (* ; "Edited 26-Mar-2022 09:38 by rmk")
[LAMBDA (FILE FIELDNAME) (* ; "Edited 9-Mar-2024 10:24 by rmk")
(* ; "Edited 26-Mar-2022 09:38 by rmk")
(* ; "Edited 6-Mar-90 19:38 by nm")
(UNPACKFILENAME.STRING FILE (SELECTQ FIELDNAME
((VERSION GENERATION)
'VERSION)
((DEVICE STRUCTURE)
'DEVICE)
FIELDNAME)
'FIELD])
(UNPACKFILENAME.STRING FILE FIELDNAME 'FIELD])
(PACKFILENAME
[LAMBDA N (* bvm%: " 5-Jul-85 15:40")
@@ -1252,14 +1254,14 @@
(ADDTOVAR LAMA PACKFILENAME.STRING PACKFILENAME)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3119 15776 (DELFILE 3129 . 3290) (FULLNAME 3292 . 3659) (INFILE 3661 . 3920) (INFILEP
3922 . 4057) (IOFILE 4059 . 4310) (OPENFILE 4312 . 4615) (OPENSTREAM 4617 . 8957) (OUTFILE 8959 . 9221
) (OUTFILEP 9223 . 9359) (RENAMEFILE 9361 . 9667) (SIMPLE.FINDFILE 9669 . 10079) (VMEMSIZE 10081 .
10248) (\COPYSYS 10250 . 14495) (\FLUSHVM 14497 . 15569) (\LOGOUT0 15571 . 15774)) (16234 38302 (
UNPACKFILENAME.STRING 16244 . 35681) (\UPF.DIRECTORY 35683 . 38300)) (39830 42502 (UNPACKFILENAME
39840 . 40026) (LASTCHPOS 40028 . 40722) (FILENAMEFIELD 40724 . 41209) (FILENAMEFIELD.STRING 41211 .
41790) (PACKFILENAME 41792 . 42135) (PACKFILENAME.STRING 42137 . 42500)) (56972 57885 (
FILEDIRCASEARRAY 56982 . 57883)) (58052 65232 (LOGOUT 58062 . 58979) (MAKESYS 58981 . 60610) (SYSOUT
60612 . 62164) (SAVEVM 62166 . 62966) (HERALD 62968 . 63128) (INTERPRET.REM.CM 63130 . 64855) (
\USEREVENT 64857 . 65230)) (65414 67141 (USERNAME 65424 . 66380) (SETUSERNAME 66382 . 67139)))))
(FILEMAP (NIL (3169 15826 (DELFILE 3179 . 3340) (FULLNAME 3342 . 3709) (INFILE 3711 . 3970) (INFILEP
3972 . 4107) (IOFILE 4109 . 4360) (OPENFILE 4362 . 4665) (OPENSTREAM 4667 . 9007) (OUTFILE 9009 . 9271
) (OUTFILEP 9273 . 9409) (RENAMEFILE 9411 . 9717) (SIMPLE.FINDFILE 9719 . 10129) (VMEMSIZE 10131 .
10298) (\COPYSYS 10300 . 14545) (\FLUSHVM 14547 . 15619) (\LOGOUT0 15621 . 15824)) (16284 38972 (
UNPACKFILENAME.STRING 16294 . 36274) (\UPF.DIRECTORY 36276 . 38970)) (40500 42806 (UNPACKFILENAME
40510 . 40696) (LASTCHPOS 40698 . 41392) (FILENAMEFIELD 41394 . 41688) (FILENAMEFIELD.STRING 41690 .
42094) (PACKFILENAME 42096 . 42439) (PACKFILENAME.STRING 42441 . 42804)) (57276 58189 (
FILEDIRCASEARRAY 57286 . 58187)) (58356 65536 (LOGOUT 58366 . 59283) (MAKESYS 59285 . 60914) (SYSOUT
60916 . 62468) (SAVEVM 62470 . 63270) (HERALD 63272 . 63432) (INTERPRET.REM.CM 63434 . 65159) (
\USEREVENT 65161 . 65534)) (65718 67445 (USERNAME 65728 . 66684) (SETUSERNAME 66686 . 67443)))))
STOP

BIN
sources/ADIR.LCOM
View File

Binary file not shown.

54
sources/CMLSPECIALFORMS
View File

@@ -1,20 +1,20 @@
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "LISP")
(IL:FILECREATED "16-May-90 14:43:08" IL:|{DSK}<usr>local>lde>lispcore>sources>CMLSPECIALFORMS.;2| 20313
(DEFINE-FILE-INFO PACKAGE "LISP" READTABLE "XCL" BASE 10)
IL:|changes| IL:|to:| (IL:VARS IL:CMLSPECIALFORMSCOMS)
(IL:FILECREATED "15-Mar-2024 20:39:04" IL:|{DSK}<home>larry>il>medley>sources>CMLSPECIALFORMS.;4| 19873
IL:|previous| IL:|date:| "13-Jun-88 18:25:25"
IL:|{DSK}<usr>local>lde>lispcore>sources>CMLSPECIALFORMS.;1|)
:EDIT-BY "lmm"
:CHANGES-TO (IL:VARS IL:CMLSPECIALFORMSCOMS)
:PREVIOUS-DATE "15-Mar-2024 10:39:44" IL:|{DSK}<home>larry>il>medley>sources>CMLSPECIALFORMS.;2|
)
; Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990 by Venue & Xerox Corporation. All rights reserved.
(IL:PRETTYCOMPRINT IL:CMLSPECIALFORMSCOMS)
(IL:RPAQQ IL:CMLSPECIALFORMSCOMS
((IL:COMS (IL:FUNCTIONS LOOP)
(IL:COMS (IL:FUNCTIONS IDENTITY)
(XCL:OPTIMIZERS IDENTITY))
((IL:COMS (IL:COMS (IL:FUNCTIONS IDENTITY)
(XCL:OPTIMIZERS IDENTITY))
(IL:FUNCTIONS UNLESS WHEN))
(IL:FUNCTIONS FLET LABELS IL:SELECTQ)
(IL:COMS
@@ -31,8 +31,7 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>CMLSPECIALFORMS.;1|)
(IL:COMS
(IL:* IL:|;;|
 "Hacks for Interlisp NLAMBDAs that should look like functions")
(IL:* IL:|;;| "Hacks for Interlisp NLAMBDAs that should look like functions")
(IL:PROP IL:MACRO IL:FRPTQ IL:SETN IL:SUB1VAR IL:*))
(IL:COMS (IL:FNS IL:BQUOTIFY)
@@ -53,13 +52,6 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>CMLSPECIALFORMS.;1|)
(IL:NLAML)
(IL:LAMA)))))
(DEFMACRO LOOP (&REST FORMS)
(LET ((TAG (GENSYM)))
`(PROG NIL
,TAG
,@FORMS
(GO ,TAG))))
(DEFUN IDENTITY (THING)
(IL:* IL:|;;| "Returns what was passed to it. Default for :key options.")
@@ -67,7 +59,7 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>CMLSPECIALFORMS.;1|)
THING)
(XCL:DEFOPTIMIZER IDENTITY (X)
X)
X)
(DEFMACRO UNLESS (TEST &BODY BODY)
`(COND
@@ -223,10 +215,10 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>CMLSPECIALFORMS.;1|)
(DEFMACRO DO (VARS END-TEST &BODY BODY &ENVIRONMENT ENV)
(%DO-TRANSLATE VARS END-TEST BODY NIL ENV))
(%DO-TRANSLATE VARS END-TEST BODY NIL ENV))
(DEFMACRO DO* (BINDS END-TEST &REST BODY &ENVIRONMENT ENV)
(%DO-TRANSLATE BINDS END-TEST BODY T ENV))
(%DO-TRANSLATE BINDS END-TEST BODY T ENV))
(DEFUN %DO-TRANSLATE (VARS END-TEST BODY SEQUENTIALP ENV)
(LET ((VARS-AND-INITIAL-VALUES (MAPCAR #'(LAMBDA (X)
@@ -263,7 +255,7 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>CMLSPECIALFORMS.;1|)
(GO ,TAG)))))
(DEFMACRO DOLIST ((VAR LISTFORM &OPTIONAL RESULTFORM)
&BODY BODY &ENVIRONMENT ENV)
&BODY BODY &ENVIRONMENT ENV)
(LET ((TAIL (GENSYM)))
(MULTIPLE-VALUE-BIND
(BODY DECL)
@@ -278,7 +270,7 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>CMLSPECIALFORMS.;1|)
(SETQ ,TAIL (CDR ,TAIL)))))))
(DEFMACRO DOTIMES ((VAR COUNTFORM &OPTIONAL RESULTFORM)
&BODY BODY &ENVIRONMENT ENV)
&BODY BODY &ENVIRONMENT ENV)
(LET ((MAX (GENSYM)))
(MULTIPLE-VALUE-BIND (BODY DECLS)
(XCL:PARSE-BODY BODY ENV)
@@ -298,7 +290,7 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>CMLSPECIALFORMS.;1|)
(CLAUSES
(MAPCAR
#'(LAMBDA
(CASE)
(CASE)
(LET ((KEY-LIST (CAR CASE))
(CONSEQUENTS (OR (CDR CASE)
(LIST NIL))))
@@ -341,10 +333,10 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>CMLSPECIALFORMS.;1|)
(IL:PUTPROPS IL:SETN IL:MACRO (= . IL:SETQ))
(IL:PUTPROPS IL:SUB1VAR IL:MACRO ((IL:X)
(IL:SETQ IL:X (IL:SUB1 IL:X))))
(IL:SETQ IL:X (IL:SUB1 IL:X))))
(IL:PUTPROPS IL:* IL:MACRO ((IL:X . IL:Y)
'IL:X))
'IL:X))
(IL:DEFINEQ
(il:bquotify
@@ -479,9 +471,11 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>CMLSPECIALFORMS.;1|)
(IL:ADDTOVAR IL:LAMA )
)
(IL:PUTPROPS IL:CMLSPECIALFORMS IL:COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987
1988 1990))
(IL:DECLARE\: IL:DONTCOPY
(IL:FILEMAP (NIL (13354 18024 (IL:BQUOTIFY 13367 . 18022)) (19227 19633 (IL:CLEAR-CLISPARRAY 19240 .
19631)))))
(IL:FILEMAP (NIL (2492 2613 (IDENTITY 2492 . 2613)) (2681 2773 (UNLESS 2681 . 2773)) (2775 2845 (WHEN
2775 . 2845)) (2847 4614 (FLET 2847 . 4614)) (4616 6669 (LABELS 4616 . 6669)) (6671 8466 (IL:SELECTQ
6671 . 8466)) (8513 8624 (DO 8513 . 8624)) (8626 8738 (DO* 8626 . 8738)) (8740 10291 (%DO-TRANSLATE
8740 . 10291)) (10293 10883 (DOLIST 10293 . 10883)) (10885 11388 (DOTIMES 10885 . 11388)) (11390 12562
(CASE 11390 . 12562)) (13026 17696 (IL:BQUOTIFY 13039 . 17694)) (18899 19305 (IL:CLEAR-CLISPARRAY
18912 . 19303)))))
IL:STOP

BIN
sources/CMLSPECIALFORMS.LCOM
View File

Binary file not shown.

154
sources/PACKAGE-STARTUP
View File

@@ -1,24 +1,24 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10 FORMAT XCCS)
(FILECREATED " 1-Aug-2021 18:08:23" 
|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>PACKAGE-STARTUP.;9| 36725
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|changes| |to:| (FUNCTIONS PACKAGE-ENABLE)
(FILECREATED "16-Mar-2024 08:28:55" |{DSK}<home>larry>il>medley>sources>PACKAGE-STARTUP.;2| 36546
|previous| |date:| "29-Jul-2021 20:33:07"
|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>PACKAGE-STARTUP.;8|)
:EDIT-BY "lmm"
:CHANGES-TO (VARIABLES CMLSYMBOLS.MACROS)
:PREVIOUS-DATE " 1-Aug-2021 18:08:23" |{DSK}<home>larry>il>medley>sources>PACKAGE-STARTUP.;1|
)
; Copyright (c) 1986-1988, 1990-1991, 2021 by Venue & Xerox Corporation.
(PRETTYCOMPRINT PACKAGE-STARTUPCOMS)
(RPAQQ PACKAGE-STARTUPCOMS
(
(* |;;;| "Initialize the package system (LLPACKAGE must be loaded)")
(* |;;;| "Initialize the package system (LLPACKAGE must be loaded)")
(* |;;| "Simple definitions for the init. Improved in CMLPACKAGE")
(* |;;| "Simple definitions for the init. Improved in CMLPACKAGE")
(FUNCTIONS RETURN-FIRST-OF-THREE ERROR-MISSING-EXTERNAL-SYMBOL)
(P (MOVD? 'ERROR-MISSING-EXTERNAL-SYMBOL 'RESOLVE-MISSING-EXTERNAL-SYMBOL)
@@ -29,20 +29,20 @@
(MOVD? 'ERROR 'RESOLVE-IMPORT-CONFLICT)
(MOVD? 'ERROR 'RESOLVE-UNINTERN-CONFLICT)
(MOVD? 'RETURN-FIRST-OF-THREE 'RESOLVE-READER-CONFLICT)
(* \;
 "In pre-package init all symbols are prefixed, thus the INTERLISP symbol is always default")
(* \;
 "In pre-package init all symbols are prefixed, thus the INTERLISP symbol is always default")
)
(* |;;| "Reader changes")
(* |;;| "Reader changes")
(FUNCTIONS CHECK-SYMBOL-NAMESTRING \\NEW.READ.SYMBOL \\NEW.MKATOM)
(VARIABLES LITATOM-PACKAGE-CONVERSION-ENABLED)
(* |;;| "Initialization tables and functions")
(* |;;| "Initialization tables and functions")
(VARIABLES CMLSYMBOLS.VARS CMLSYMBOLS.FNNAMES CMLSYMBOLS.DECLARATORS CMLSYMBOLS.TYPENAMES
CMLSYMBOLS.MACROS CMLSYMBOLS.SPECIALFORMS CMLSYMBOLS.LAMBDA.LIST.KEYWORDS)
(VARIABLES (* \; "Be very careful with this.")
(VARIABLES (* \; "Be very careful with this.")
CMLSYMBOLS.SHARED)
(FUNCTIONS LITATOM.EXISTS)
(VARIABLES LITATOM-PACKAGE-CONVERSION-TABLE)
@@ -51,13 +51,13 @@
(FUNCTIONS PACKAGE-INIT PACKAGE-CLEAR PACKAGE-MAKE PACKAGE-HIERARCHY-INIT PACKAGE-ENABLE
PACKAGE-DISABLE)
(* |;;| "A hack for initialization")
(* |;;| "A hack for initialization")
(FUNCTIONS ID)
(PROP (FILETYPE MAKEFILE-ENVIRONMENT)
PACKAGE-STARTUP)
(* |;;| "Initialize package system, plus functions needed in llpackage at init time")
(* |;;| "Initialize package system, plus functions needed in llpackage at init time")
(DECLARE\: DONTEVAL@LOAD DOCOPY (P (MOVD? 'EQ 'EQL)
(MOVD? 'LENGTH 'CL:LENGTH)
@@ -98,8 +98,8 @@
(MOVD? 'RETURN-FIRST-OF-THREE 'RESOLVE-READER-CONFLICT)
(* \;
 "In pre-package init all symbols are prefixed, thus the INTERLISP symbol is always default")
(* \;
 "In pre-package init all symbols are prefixed, thus the INTERLISP symbol is always default")
@@ -126,12 +126,12 @@
(CL:DEFUN \\NEW.READ.SYMBOL (BASE OFFSET LEN FATP PACKAGE EXTERNALP NONNUMERICP)
"Read a number or symbol from the string defined by BASE OFFSET LEN FATP PACKAGE is NIL if no package was specified, a package object or a string if an unknown package was typed (causes error). EXTERNALP is true if symbol was typed with one colon, which requires that the symbol exist and be external (unless it was a keyword). NONNUMERICP is true if we know the symbol is not a number, e.g., some characters in it were escaped."
(DECLARE (CL:SPECIAL LITATOM-PACKAGE-CONVERSION-ENABLED *READTABLE* FILERDTBL CODERDTBL
*PACKAGE* *LISP-PACKAGE* *INTERLISP-PACKAGE*))
(DECLARE (CL:SPECIAL LITATOM-PACKAGE-CONVERSION-ENABLED *READTABLE* FILERDTBL CODERDTBL *PACKAGE*
*LISP-PACKAGE* *INTERLISP-PACKAGE*))
(OR (AND (NOT NONNUMERICP)
(\\PARSE.NUMBER BASE OFFSET LEN FATP))
(AND
(* |;;| "The reader conversion feature is contained in this expression")
(* |;;| "The reader conversion feature is contained in this expression")
LITATOM-PACKAGE-CONVERSION-ENABLED
(NULL PACKAGE)
@@ -142,13 +142,13 @@
(FIND-SYMBOL* BASE OFFSET LEN FATP *LISP-PACKAGE*)
(LET ((ILSYM (FIND-SYMBOL* BASE OFFSET LEN FATP *INTERLISP-PACKAGE*)))
(COND
((NULL ILSYM) (* \; "No IL symbol, try CL")
((NULL ILSYM) (* \; "No IL symbol, try CL")
CLSYM)
((NULL CLSYM) (* \; "No CL symbol, use IL")
((NULL CLSYM) (* \; "No CL symbol, use IL")
ILSYM)
((EQ ILSYM CLSYM) (* \; "SAME")
((EQ ILSYM CLSYM) (* \; "SAME")
ILSYM)
(T (* \; "Both symbols exist, resolve. During the INIT where packages are turned off this is defined to return its first argument.")
(T (* \; "Both symbols exist, resolve. During the INIT where packages are turned off this is defined to return its first argument.")
(RESOLVE-READER-CONFLICT ILSYM CLSYM CLSYMWHERE)))))))
(COND
((STRINGP PACKAGE)
@@ -164,8 +164,8 @@
(COND
((EQ ACCESSIBLE :EXTERNAL)
CL:SYMBOL)
((CL::%PACKAGE-EXTERNAL-ONLY PACKAGE) (* \;
 "External only packages don't error creating external symbols on read")
((CL::%PACKAGE-EXTERNAL-ONLY PACKAGE) (* \;
 "External only packages don't error creating external symbols on read")
(INTERN* BASE OFFSET LEN FATP (\\FATCHARSEENP BASE OFFSET LEN FATP)
(OR PACKAGE *PACKAGE*)
T))
@@ -182,20 +182,20 @@
(UNLESSRDSYS (COND
((AND (EQ LEN 1)
(ILEQ FIRSTCHAR \\MAXTHINCHAR)
|\\OneCharAtomBase|) (* \;
 "The one-character atoms live in well known places, no need to hash")
|\\OneCharAtomBase|) (* \;
 "The one-character atoms live in well known places, no need to hash")
(RETURN (COND
((IGREATERP FIRSTCHAR (CHARCODE "9"))
(\\ADDBASE |\\OneCharAtomBase| (IDIFFERENCE FIRSTCHAR 10)))
((IGEQ FIRSTCHAR (CHARCODE "0"))
(* \;
 "These one-character atoms are integers")
(* \;
 "These one-character atoms are integers")
(IDIFFERENCE FIRSTCHAR (CHARCODE "0")))
(T (\\ADDBASE |\\OneCharAtomBase| FIRSTCHAR)))))
((AND (ILEQ FIRSTCHAR (CHARCODE "9"))
(SETQ TEMP (\\PARSE.NUMBER BASE OFFST LEN FATP)))
(* |;;| "\\PARSE.NUMBER returns a number or NIL")
(* |;;| "\\PARSE.NUMBER returns a number or NIL")
(RETURN TEMP))))
(RETURN (CL:VALUES (INTERN* BASE OFFST LEN FATP FATCHARSEENP *INTERLISP-PACKAGE* T)))))
@@ -312,7 +312,7 @@
"WRITE-STRING" "WRITE-TO-STRING" "Y-OR-N-P" "YES-OR-NO-P" "ZEROP"))
(CL:DEFPARAMETER CMLSYMBOLS.DECLARATORS '("DECLARATION" "FTYPE" "FUNCTION" "IGNORE" "INLINE"
"NOTINLINE" "OPTIMIZE" "SPECIAL" "TYPE"))
"NOTINLINE" "OPTIMIZE" "SPECIAL" "TYPE"))
(CL:DEFPARAMETER CMLSYMBOLS.TYPENAMES
'("ARRAY" "ATOM" "BIGNUM" "BIT" "BIT-VECTOR" "CHARACTER" "COMMON" "COMPILED-FUNCTION" "COMPLEX"
@@ -326,20 +326,19 @@
'("AND" "ASSERT" "CASE" "CCASE" "CHECK-TYPE" "COND" "CTYPECASE" "DECF" "DEFCONSTANT"
"DEFINE-MODIFY-MACRO" "DEFINE-SETF-METHOD" "DEFMACRO" "DEFPARAMETER" "DEFSETF" "DEFSTRUCT"
"DEFTYPE" "DEFUN" "DEFVAR" "DO" "DO*" "DO-ALL-SYMBOLS" "DO-EXTERNAL-SYMBOLS" "DO-SYMBOLS"
"DOLIST" "DOTIMES" "ECASE" "ETYPECASE" "INCF" "LOCALLY" "LOOP" "MULTIPLE-VALUE-BIND"
"MULTIPLE-VALUE-LIST" "MULTIPLE-VALUE-SETQ" "OR" "POP" "PROG" "PROG*" "PROG1" "PROG2"
"PSETF" "PSETQ" "PUSH" "PUSHNEW" "REMF" "RETURN" "ROTATEF" "SETF" "SHIFTF" "STEP" "TIME"
"TRACE" "TYPECASE" "UNLESS" "UNTRACE" "WHEN" "WITH-INPUT-FROM-STRING" "WITH-OPEN-FILE"
"WITH-OPEN-STREAM" "WITH-OUTPUT-TO-STRING"))
"DOLIST" "DOTIMES" "ECASE" "ETYPECASE" "INCF" "LOCALLY" "LOOP" "LOOP-FINISH"
"MULTIPLE-VALUE-BIND" "MULTIPLE-VALUE-LIST" "MULTIPLE-VALUE-SETQ" "OR" "POP" "PROG"
"PROG*" "PROG1" "PROG2" "PSETF" "PSETQ" "PUSH" "PUSHNEW" "REMF" "RETURN" "ROTATEF" "SETF"
"SHIFTF" "STEP" "TIME" "TRACE" "TYPECASE" "UNLESS" "UNTRACE" "WHEN"
"WITH-INPUT-FROM-STRING" "WITH-OPEN-FILE" "WITH-OPEN-STREAM" "WITH-OUTPUT-TO-STRING"))
(CL:DEFPARAMETER CMLSYMBOLS.SPECIALFORMS
'("BLOCK" "CATCH" "COMPILER-LET" "DECLARE" "EVAL-WHEN" "FLET" "FUNCTION" "GO" "IF" "LABELS"
"LAMBDA" "LET" "LET*" "MACROLET" "MULTIPLE-VALUE-CALL" "MULTIPLE-VALUE-PROG1" "PROGN"
"PROGV" "QUOTE" "RETURN-FROM" "SETQ" "TAGBODY" "THE" "THROW" "UNWIND-PROTECT"))
(CL:DEFPARAMETER CMLSYMBOLS.LAMBDA.LIST.KEYWORDS '("&ALLOW-OTHER-KEYS" "&AUX" "&BODY"
"&ENVIRONMENT" "&KEY" "&OPTIONAL"
"&REST" "&WHOLE"))
(CL:DEFPARAMETER CMLSYMBOLS.LAMBDA.LIST.KEYWORDS '("&ALLOW-OTHER-KEYS" "&AUX" "&BODY" "&ENVIRONMENT"
"&KEY" "&OPTIONAL" "&REST" "&WHOLE"))
(CL:DEFPARAMETER CMLSYMBOLS.SHARED
'("+" "-" "/" "<" "<=" "=" ">" ">=" "&ALLOW-OTHER-KEYS" "&AUX" "&BODY" "&ENVIRONMENT" "&KEY"
@@ -361,7 +360,7 @@
"RPLACA" "RPLACD" "SATISFIES" "SEQUENCE" "SET" "STRING" "STRING-EQUAL" "STREAM" "STREAMP"
"T" "TAILP" "THE" "TIME" "TRACE" "TYPE" "TYPEP" "UNTRACE" "WRITE")
(* |;;;| "Symbols shared by the Interlisp and Lisp packages.")
(* |;;;| "Symbols shared by the Interlisp and Lisp packages.")
)
@@ -388,7 +387,7 @@
(CL:DEFUN NAMESTRING-CONVERSION-CLAUSE (BASE OFFSET LEN FATP)
(* |;;;| "Check whether a given namestring has a prefix that would indicate membership in a package. If so, return the first clause out of the conversion table that matched. Otherwise, return NIL.")
(* |;;;| "Check whether a given namestring has a prefix that would indicate membership in a package. If so, return the first clause out of the conversion table that matched. Otherwise, return NIL.")
(DECLARE (CL:SPECIAL LITATOM-PACKAGE-CONVERSION-TABLE))
(CL:DOLIST (CONVERSION-LIST LITATOM-PACKAGE-CONVERSION-TABLE NIL)
@@ -399,13 +398,13 @@
(COND
((AND (IGREATERP LEN PREFIX-LENGTH)
(\\STRING-EQUALBASE PREFIX BASE OFFSET PREFIX-LENGTH FATP)
(NOT (|for| X |in| EXCEPTIONS
|suchthat| (\\STRING-EQUALBASE X BASE OFFSET LEN FATP))))
(NOT (|for| X |in| EXCEPTIONS |suchthat| (\\STRING-EQUALBASE X BASE OFFSET LEN
FATP))))
(RETURN CONVERSION-LIST))))))
(CL:DEFUN CONVERT-LITATOM (ATOM)
(* |;;| "Conditionally move an INTERLISP litatom into a package based on the naming conventions in LITATOM-PACKAGE-CONVERSION-TABLE.")
(* |;;| "Conditionally move an INTERLISP litatom into a package based on the naming conventions in LITATOM-PACKAGE-CONVERSION-TABLE.")
(LET* ((BASE (|ffetch| (CL:SYMBOL PNAMEBASE) |of| ATOM))
(LEN (|ffetch| (CL:SYMBOL PNAMELENGTH) |of| ATOM))
@@ -417,17 +416,17 @@
(WHERE (CL:FOURTH CLAUSE))
(PREFIX-LENGTH (|ffetch| (STRINGP LENGTH)
PREFIX)))
(\\LITATOM.EATCHARS ATOM PREFIX-LENGTH) (* \; "Take off the pseudo-package prefix. This makes the symbol inaccessible in INTERLISP (because not rehashed).")
(\\LITATOM.EATCHARS ATOM PREFIX-LENGTH) (* \; "Take off the pseudo-package prefix. This makes the symbol inaccessible in INTERLISP (because not rehashed).")
(COND
(CL:PACKAGE-NAME (* \;
 " Symbol is interned, put it in the package.")
(CL:PACKAGE-NAME (* \;
 " Symbol is interned, put it in the package.")
(INTERN-LITATOM ATOM (CL:FIND-PACKAGE CL:PACKAGE-NAME)
:WHERE WHERE)))
T))
(CL:DEFUN CONCOCT-SYMBOL (STRING)
(* |;;| "Create a symbol in the LISP package. Conflicting symbols must already have been converted and defined by CONVERT-LITATOM. Given a string, if a symbol by that name exists in INTERLISP (and doesn't conflict) we INTERN-LITATOM it into the LISP package, making that its home. Otherwise, we create a new one.")
(* |;;| "Create a symbol in the LISP package. Conflicting symbols must already have been converted and defined by CONVERT-LITATOM. Given a string, if a symbol by that name exists in INTERLISP (and doesn't conflict) we INTERN-LITATOM it into the LISP package, making that its home. Otherwise, we create a new one.")
(DECLARE (CL:SPECIAL *LISP-PACKAGE* *INTERLISP-PACKAGE* CMLSYMBOLS.SHARED))
(LET (ILSYM CLSYM)
@@ -437,27 +436,27 @@
(CL:WHEN (EQ WHERE :INTERNAL)
(EXPORT SYM *LISP-PACKAGE*))
(SETQ CLSYM SYM)
WHERE) (* \;
 "The CL symbol already exists. Make it external. If the symbol is shared, import it into IL.")
WHERE) (* \;
 "The CL symbol already exists. Make it external. If the symbol is shared, import it into IL.")
(CL:WHEN (CL:MEMBER STRING CMLSYMBOLS.SHARED :TEST 'STREQUAL)
(IMPORT CLSYM *INTERLISP-PACKAGE*)))
(* |;;| "From this point down, the CL symbol doesn't yet exist.")
(* |;;| "From this point down, the CL symbol doesn't yet exist.")
((CL:MEMBER STRING CMLSYMBOLS.SHARED :TEST 'STREQUAL)
(* \; "The symbol is shared. Create it in CL and import it to IL. NOTE that the symbol should never be found in IL.")
(* \; "The symbol is shared. Create it in CL and import it to IL. NOTE that the symbol should never be found in IL.")
(COND
((CL:FIND-SYMBOL STRING *INTERLISP-PACKAGE*)
(CL:ERROR "Shared symbol found in IL: ~S" STRING)
(* |;;| "(intern-litatom ilsym *lisp-package* :where :external)")
(* |;;| "(intern-litatom ilsym *lisp-package* :where :external)")
)
(T (LET ((SYM (CL:INTERN STRING *LISP-PACKAGE*)))
(EXPORT SYM *LISP-PACKAGE*)
(IMPORT SYM *INTERLISP-PACKAGE*)))))
(T (* \;
 "Symbol doesn't exist, so just create it in LISP.")
(T (* \;
 "Symbol doesn't exist, so just create it in LISP.")
(EXPORT (CL:INTERN STRING *LISP-PACKAGE*)
*LISP-PACKAGE*)))))
@@ -491,8 +490,8 @@
(COND
((|fetch| (LITATOM FATPNAMEP) |of| LITATOM)
(ERROR (CONCAT "Can't move fat LITATOM |" LITATOM "| into LISP package")))
(T (|for| I |from| 0 |to| LEN |as| J |from| N
|do| (\\PUTBASETHIN PNBASE I (\\GETBASETHIN PNBASE J)))))
(T (|for| I |from| 0 |to| LEN |as| J |from| N |do| (\\PUTBASETHIN PNBASE I
(\\GETBASETHIN PNBASE J)))))
(|replace| (PNAMEBASE PNAMELENGTH) |of| PNBASE |with| LEN))
LITATOM)
@@ -507,7 +506,7 @@
(CL:DEFUN PACKAGE-CLEAR ()
"Clear the global package data (used by FIND-PACKAGE) and reset the globals that hold the existing packages."
(DECLARE (CL:SPECIAL *PACKAGE-FROM-NAME* *PACKAGE-FROM-INDEX* *PACKAGE* *LISP-PACKAGE*
*KEYWORD-PACKAGE* *INTERLISP-PACKAGE*))
*KEYWORD-PACKAGE* *INTERLISP-PACKAGE*))
(CLRHASH *PACKAGE-FROM-NAME*)
(CL:DOTIMES (I (ADD1 *TOTAL-PACKAGES-LIMIT*))
(CL:SETF (CL:AREF *PACKAGE-FROM-INDEX* I)
@@ -521,7 +520,7 @@
(CL:DEFUN PACKAGE-MAKE ()
"Create, but do not fill with symbols, the base packages that need to exist. Also enables the package qualifier characters in the readtables and saves the old definitions of \\READ.SYMBOL and \\MKATOM."
(DECLARE (CL:SPECIAL *LISP-PACKAGE* *KEYWORD-PACKAGE* *INTERLISP-PACKAGE* *PACKAGE*
HASHTABLE-SIZE-LIMIT))
HASHTABLE-SIZE-LIMIT))
(SETQ *INTERLISP-PACKAGE* (CL:MAKE-PACKAGE "INTERLISP" :USE NIL :NICKNAMES '("IL")
:PREFIX-NAME "IL" :EXTERNAL-ONLY T :EXTERNAL-SYMBOLS 32749))
(SETQ *LISP-PACKAGE* (CL:MAKE-PACKAGE "LISP" :USE NIL :NICKNAMES '("CL" "COMMON-LISP")
@@ -545,20 +544,20 @@
(CL:DEFUN PACKAGE-HIERARCHY-INIT (&OPTIONAL (CONVERT? NIL))
(* |;;;| "Fill all the initial system packages with their proper symbols, moving litatoms into appropriate places and such. If convert? is non-nil then symbols whose pnames have fake package qualifiers, like cl:length, will be converted IN PLACE to remove the qualifier. If conversion takes place you cannot fully disable the package system.")
(* |;;;| "Fill all the initial system packages with their proper symbols, moving litatoms into appropriate places and such. If convert? is non-nil then symbols whose pnames have fake package qualifiers, like cl:length, will be converted IN PLACE to remove the qualifier. If conversion takes place you cannot fully disable the package system.")
(DECLARE (CL:SPECIAL *INTERLISP-PACKAGE* *KEYWORD-PACKAGE* CMLSYMBOLS.LAMBDA.LIST.KEYWORDS
CMLSYMBOLS.SPECIALFORMS CMLSYMBOLS.MACROS CMLSYMBOLS.TYPENAMES
CMLSYMBOLS.FNNAMES CMLSYMBOLS.DECLARATORS CMLSYMBOLS.VARS))
CMLSYMBOLS.SPECIALFORMS CMLSYMBOLS.MACROS CMLSYMBOLS.TYPENAMES CMLSYMBOLS.FNNAMES
CMLSYMBOLS.DECLARATORS CMLSYMBOLS.VARS))
(* |;;| "Fill the INTERLISP package with its symbols.")
(* |;;| "Fill the INTERLISP package with its symbols.")
(MAPATOMS #'(CL:LAMBDA (ATOM)
(CL:IF (OR (NULL CONVERT?)
(NULL (CONVERT-LITATOM ATOM)))
(INTERN-LITATOM ATOM *INTERLISP-PACKAGE* :WHERE :EXTERNAL))))
(* |;;| "Fill the LISP package with its symbols.")
(* |;;| "Fill the LISP package with its symbols.")
(CL:DOLIST (I (APPEND CMLSYMBOLS.VARS CMLSYMBOLS.FNNAMES CMLSYMBOLS.DECLARATORS
CMLSYMBOLS.TYPENAMES CMLSYMBOLS.MACROS CMLSYMBOLS.SPECIALFORMS
@@ -569,7 +568,7 @@
(CL:DEFUN PACKAGE-ENABLE (&OPTIONAL (PACKAGE *INTERLISP-PACKAGE*))
"Turn on the package system, making PACKAGE the current one and redefining \\READ.SYMBOL and \\MKATOM appropriatly."
(DECLARE (CL:SPECIAL *INTERLISP-PACKAGE* *PACKAGE* *OLD-INTERLISP-READ-ENVIRONMENT*
*PER-EXEC-VARIABLES*))
*PER-EXEC-VARIABLES*))
(|replace| REPACKAGE |of| *OLD-INTERLISP-READ-ENVIRONMENT* |with| *INTERLISP-PACKAGE*)
(|replace| REPACKAGE |of| *DEFINE-FILE-INFO-ENV* |with| *INTERLISP-PACKAGE*)
(COND
@@ -643,16 +642,15 @@
(PACKAGE-INIT)
)
(PUTPROPS PACKAGE-STARTUP COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1991 2021))
(DECLARE\: DONTCOPY
(FILEMAP (NIL (3123 3218 (RETURN-FIRST-OF-THREE 3123 . 3218)) (3220 3358 (
ERROR-MISSING-EXTERNAL-SYMBOL 3220 . 3358)) (3963 4931 (CHECK-SYMBOL-NAMESTRING 3963 . 4931)) (4933
8094 (\\NEW.READ.SYMBOL 4933 . 8094)) (8096 9802 (\\NEW.MKATOM 8096 . 9802)) (23600 23682 (
LITATOM.EXISTS 23600 . 23682)) (24362 25328 (NAMESTRING-CONVERSION-CLAUSE 24362 . 25328)) (25330 26579
(CONVERT-LITATOM 25330 . 26579)) (26581 28650 (CONCOCT-SYMBOL 26581 . 28650)) (28652 28946 (
TRANSFER-SYMBOL 28652 . 28946)) (28948 29656 (INTERN-LITATOM 28948 . 29656)) (29658 30285 (
\\LITATOM.EATCHARS 29658 . 30285)) (30287 30564 (PACKAGE-INIT 30287 . 30564)) (30566 31143 (
PACKAGE-CLEAR 30566 . 31143)) (31145 32540 (PACKAGE-MAKE 31145 . 32540)) (32542 33863 (
PACKAGE-HIERARCHY-INIT 32542 . 33863)) (33865 35478 (PACKAGE-ENABLE 33865 . 35478)) (35480 36123 (
PACKAGE-DISABLE 35480 . 36123)) (36170 36196 (ID 36170 . 36196)))))
(FILEMAP (NIL (3015 3110 (RETURN-FIRST-OF-THREE 3015 . 3110)) (3112 3250 (
ERROR-MISSING-EXTERNAL-SYMBOL 3112 . 3250)) (3857 4825 (CHECK-SYMBOL-NAMESTRING 3857 . 4825)) (4827
7985 (\\NEW.READ.SYMBOL 4827 . 7985)) (7987 9697 (\\NEW.MKATOM 7987 . 9697)) (23437 23519 (
LITATOM.EXISTS 23437 . 23519)) (24199 25205 (NAMESTRING-CONVERSION-CLAUSE 24199 . 25205)) (25207 26462
(CONVERT-LITATOM 25207 . 26462)) (26464 28537 (CONCOCT-SYMBOL 26464 . 28537)) (28539 28833 (
TRANSFER-SYMBOL 28539 . 28833)) (28835 29543 (INTERN-LITATOM 28835 . 29543)) (29545 30224 (
\\LITATOM.EATCHARS 29545 . 30224)) (30226 30503 (PACKAGE-INIT 30226 . 30503)) (30505 31078 (
PACKAGE-CLEAR 30505 . 31078)) (31080 32471 (PACKAGE-MAKE 31080 . 32471)) (32473 33785 (
PACKAGE-HIERARCHY-INIT 32473 . 33785)) (33787 35396 (PACKAGE-ENABLE 33787 . 35396)) (35398 36041 (
PACKAGE-DISABLE 35398 . 36041)) (36088 36114 (ID 36088 . 36114)))))
STOP

BIN
sources/PACKAGE-STARTUP.LCOM
View File

Binary file not shown.

1465
sources/XCL-LOOP Normal file
View File

File diff suppressed because it is too large Load Diff

BIN
sources/XCL-LOOP.DFASL Normal file
View File

Binary file not shown.