From aad2344d823a5f739264d57ccb15eca20be2802a Mon Sep 17 00:00:00 2001 From: Larry Masinter Date: Thu, 24 Feb 2022 18:59:15 -0800 Subject: [PATCH] odds and ends -- --- lispusers/HARDCOPY-RETAIN | 122 +++++++++++++++++++++++++++++++------- lispusers/HASHBUFFER | 34 +++++------ lispusers/HISTMENU.TEDIT | Bin 3887 -> 3895 bytes 3 files changed, 117 insertions(+), 39 deletions(-) diff --git a/lispusers/HARDCOPY-RETAIN b/lispusers/HARDCOPY-RETAIN index c212948c..69ec4abe 100644 --- a/lispusers/HARDCOPY-RETAIN +++ b/lispusers/HARDCOPY-RETAIN @@ -1,26 +1,104 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10) -(filecreated "29-Sep-88 17:02:58" |{EG:PARC:XEROX}LISPUSERS>HARDCOPY-RETAIN.;3| 3423 - |changes| |to:| (vars hardcopy-retaincoms) +(FILECREATED " 8-Feb-2022 09:25:36" |{DSK}larry>medley>lispusers>HARDCOPY-RETAIN.;2| 6048 - |previous| |date:| "29-Dec-87 14:01:40" |{EG:PARC:XEROX}LISPUSERS>HARDCOPY-RETAIN.;2| + :PREVIOUS-DATE "29-Sep-88 17:02:58" |{DSK}larry>medley>lispusers>HARDCOPY-RETAIN.;1|) + + +; Copyright (c) 1987-1988, 2022 by Xerox Corporation. + +(PRETTYCOMPRINT HARDCOPY-RETAINCOMS) + +(RPAQQ HARDCOPY-RETAINCOMS ((FUNCTIONS HARDCOPYIMAGEW.TOFILE&PRINTER INSTALL-OPTION) + (DECLARE\: DONTEVAL@LOAD DOCOPY (P (INSTALL-OPTION))))) + +(CL:DEFUN HARDCOPYIMAGEW.TOFILE&PRINTER (&OPTIONAL XCL-USER::WINDOW) + "Send hardcopy of WINDOW to a printer and a file." + (LET + ((XCL-USER::RESULT (|GetImageFile|))) + (CL:WHEN XCL-USER::RESULT + (LET ((XCL-USER::PRINTER-NAME (|GetPrinterName|))) + (DESTRUCTURING-BIND + (XCL-USER::FILE . TYPE) + XCL-USER::RESULT + (HARDCOPY.SOMEHOW XCL-USER::WINDOW XCL-USER::FILE TYPE) + (CL:WHEN XCL-USER::PRINTER-NAME + (LET ((XCL-USER::FULL-NAME (PACKFILENAME.STRING + 'HOST + (CL:PATHNAME-HOST XCL-USER::FILE) + 'DEVICE + (CL:PATHNAME-DEVICE XCL-USER::FILE) + 'DIRECTORY + (CL:PATHNAME-DIRECTORY XCL-USER::FILE) + 'NAME + (CL:PATHNAME-NAME XCL-USER::FILE) + 'EXTENSION + (OR (CL:FIRST (CL:SECOND (CL:ASSOC 'EXTENSION + (CL:REST (CL:ASSOC + TYPE + PRINTFILETYPES + ))))) + TYPE) + 'BODY + (CL:NAMESTRING *DEFAULT-PATHNAME-DEFAULTS*)))) + (SEND.FILE.TO.PRINTER XCL-USER::FULL-NAME XCL-USER::PRINTER-NAME)))))))) + +(CL:DEFUN INSTALL-OPTION () + "Install the new Hardcopy option." + (CL:LABELS ((XCL-USER::GET-SUBITEMS (XCL-USER::ITEM) + (AND (EQ (CL:FIRST (CL:FOURTH XCL-USER::ITEM)) + 'SUBITEMS) + (CL:REST (CL:FOURTH XCL-USER::ITEM)))) + (XCL-USER::FIND-PLACE-WM + (XCL-USER::ITEM) + (LET ((XCL-USER::SUBITEMS (XCL-USER::GET-SUBITEMS XCL-USER::ITEM))) + (CL:WHEN XCL-USER::SUBITEMS + (CL:IF (EQ (CAR XCL-USER::ITEM) + '|Hardcopy|) + (CL:UNLESS (* \; "Install if not already there.") + (CL:FIND 'HARDCOPYIMAGEW.TOFILE&PRINTER XCL-USER::SUBITEMS :KEY + #'(CL:LAMBDA (XCL-USER::X) + (CL:SECOND (CL:SECOND XCL-USER::X))) + :TEST + #'EQ) + (NCONC XCL-USER::SUBITEMS (LIST (LIST "To a file and a printer" + ' + ' + HARDCOPYIMAGEW.TOFILE&PRINTER + + "Sends image to a printer of your choosing, retaining the printer version of the file." + )))) + (CL:MAPC #'XCL-USER::FIND-PLACE-WM XCL-USER::SUBITEMS))))) + (XCL-USER::FIND-PLACE-BM + (XCL-USER::ITEM) + (LET ((XCL-USER::SUBITEMS (XCL-USER::GET-SUBITEMS XCL-USER::ITEM))) + (CL:WHEN XCL-USER::SUBITEMS + (CL:IF (EQ (CAR XCL-USER::ITEM) + '|Hardcopy|) + (CL:UNLESS (* \; "Install if not already there.") + (CL:FIND 'HARDCOPYIMAGEW.TOFILE&PRINTER XCL-USER::SUBITEMS :KEY + #'(CL:LAMBDA (XCL-USER::X) + (CL:FIRST (CL:SECOND (CL:SECOND XCL-USER::X)))) + :TEST + #'EQ) + (NCONC XCL-USER::SUBITEMS (LIST (LIST "To a file and a printer" + ''( + HARDCOPYIMAGEW.TOFILE&PRINTER + ) + + "Sends image to a printer of your choosing, retaining the printer version of the file." + )))) + (CL:MAPC #'XCL-USER::FIND-PLACE-BM XCL-USER::SUBITEMS)))))) + (CL:MAPC #'XCL-USER::FIND-PLACE-WM |WindowMenuCommands|) + (CL:MAPC #'XCL-USER::FIND-PLACE-BM |BackgroundMenuCommands|) + (CL:SETQ |WindowMenu| NIL) + (CL:SETQ |BackgroundMenu| NIL))) +(DECLARE\: DONTEVAL@LOAD DOCOPY + +(INSTALL-OPTION) ) - - -; Copyright (c) 1987, 1988 by Xerox Corporation. All rights reserved. - -(prettycomprint hardcopy-retaincoms) - -(rpaqq hardcopy-retaincoms ((functions hardcopyimagew.tofile&printer install-option) (declare\: donteval@load docopy (p (install-option))))) - -(cl:defun hardcopyimagew.tofile&printer (&optional xcl-user::window) "Send hardcopy of WINDOW to a printer and a file." (let ((xcl-user::result (|GetImageFile|))) (cl:when xcl-user::result (let ((xcl-user::printer-name (|GetPrinterName|))) (destructuring-bind (xcl-user::file . type) xcl-user::result (hardcopy.somehow xcl-user::window xcl-user::file type) (cl:when xcl-user::printer-name (let ((xcl-user::full-name (packfilename.string (quote host) (cl:pathname-host xcl-user::file) (quote device) (cl:pathname-device xcl-user::file) (quote directory) (cl:pathname-directory xcl-user::file) (quote name) (cl:pathname-name xcl-user::file) (quote extension) (or (cl:first (cl:second (cl:assoc (quote extension) (cl:rest (cl:assoc type printfiletypes))))) type) (quote body) (cl:namestring *default-pathname-defaults*)))) (send.file.to.printer xcl-user::full-name xcl-user::printer-name)))))))) - -(cl:defun install-option nil "Install the new Hardcopy option." (cl:labels ((xcl-user::get-subitems (xcl-user::item) (and (eq (cl:first (cl:fourth xcl-user::item)) (quote subitems)) (cl:rest (cl:fourth xcl-user::item)))) (xcl-user::find-place-wm (xcl-user::item) (let ((xcl-user::subitems (xcl-user::get-subitems xcl-user::item))) (cl:when xcl-user::subitems (cl:if (eq (car xcl-user::item) (quote |Hardcopy|)) (cl:unless (* \; "Install if not already there.") (cl:find (quote hardcopyimagew.tofile&printer) xcl-user::subitems :key (cl:function (cl:lambda (xcl-user::x) (cl:second (cl:second xcl-user::x)))) :test (cl:function eq)) (nconc xcl-user::subitems (list (list "To a file and a printer" (quote (quote hardcopyimagew.tofile&printer)) "Sends image to a printer of your choosing, retaining the printer version of the file.")))) (cl:mapc (cl:function xcl-user::find-place-wm) xcl-user::subitems))))) (xcl-user::find-place-bm (xcl-user::item) (let ((xcl-user::subitems (xcl-user::get-subitems xcl-user::item))) (cl:when xcl-user::subitems (cl:if (eq (car xcl-user::item) (quote |Hardcopy|)) (cl:unless (* \; "Install if not already there.") (cl:find (quote hardcopyimagew.tofile&printer) xcl-user::subitems :key (cl:function (cl:lambda (xcl-user::x) (cl:first (cl:second (cl:second xcl-user::x))))) :test (cl:function eq)) (nconc xcl-user::subitems (list (list "To a file and a printer" (quote (quote (hardcopyimagew.tofile&printer))) "Sends image to a printer of your choosing, retaining the printer version of the file.")))) (cl:mapc (cl:function xcl-user::find-place-bm) xcl-user::subitems)))))) (cl:mapc (cl:function xcl-user::find-place-wm) |WindowMenuCommands|) (cl:mapc (cl:function xcl-user::find-place-bm) |BackgroundMenuCommands|) (cl:setq |WindowMenu| nil) (cl:setq |BackgroundMenu| nil))) -(declare\: donteval@load docopy - -(install-option) -) -(putprops hardcopy-retain copyright ("Xerox Corporation" 1987 1988)) -(declare\: dontcopy - (filemap (nil))) -stop +(PUTPROPS HARDCOPY-RETAIN COPYRIGHT ("Xerox Corporation" 1987 1988 2022)) +(DECLARE\: DONTCOPY + (FILEMAP (NIL (540 2464 (HARDCOPYIMAGEW.TOFILE&PRINTER 540 . 2464)) (2466 5894 (INSTALL-OPTION 2466 . +5894))))) +STOP diff --git a/lispusers/HASHBUFFER b/lispusers/HASHBUFFER index 9167ef9f..e52b5f9b 100644 --- a/lispusers/HASHBUFFER +++ b/lispusers/HASHBUFFER @@ -1,24 +1,23 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") -(FILECREATED "15-Sep-87 11:26:06" |{MCS:MCS:STANFORD}HASHBUFFER.;6| 6916 +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) - changes to%: (VARS HASHBUFFERCOMS) +(FILECREATED "10-Feb-2022 21:52:22" {DSK}larry>medley>lispusers>HASHBUFFER.;2 6788 - previous date%: " 3-Sep-87 17:06:23" |{MCS:MCS:STANFORD}HASHBUFFER.;5|) + :PREVIOUS-DATE "15-Sep-87 11:26:06" {DSK}larry>medley>lispusers>HASHBUFFER.;1) -(* " -Copyright (c) 1985, 1986, 1987 by Stanford University. All rights reserved. +(* ; " +Copyright (c) 1985-1987, 2022 by Stanford University. ") (PRETTYCOMPRINT HASHBUFFERCOMS) -(RPAQQ HASHBUFFERCOMS ((FNS CREATEHASHBUFFER OPENHASHBUFFER CLOSEHASHBUFFER GETHASHBUFFER - PUTHASHBUFFER) - (INITVARS (EMPTYHASHENTRYMARKER '**EMPTYHASHENTRY**)) - (GLOBALVARS EMPTYHASHENTRYMARKER) - (FNS HASHARRAY.TO.HASHFILE HASHFILE.TO.HASHARRAY) - (DECLARE%: DONTCOPY (RECORDS HASHBUFFER)) - (FILES HASH))) +(RPAQQ HASHBUFFERCOMS + ((FNS CREATEHASHBUFFER OPENHASHBUFFER CLOSEHASHBUFFER GETHASHBUFFER PUTHASHBUFFER) + (INITVARS (EMPTYHASHENTRYMARKER '**EMPTYHASHENTRY**)) + (GLOBALVARS EMPTYHASHENTRYMARKER) + (FNS HASHARRAY.TO.HASHFILE HASHFILE.TO.HASHARRAY) + (DECLARE%: DONTCOPY (RECORDS HASHBUFFER)) + (FILES HASH))) (DEFINEQ (CREATEHASHBUFFER @@ -130,10 +129,11 @@ Copyright (c) 1985, 1986, 1987 by Stanford University. All rights reserved. (RECORD HASHBUFFER (HASHARRAY HASHFILE ACCESS)) ) ) + (FILESLOAD HASH) -(PUTPROPS HASHBUFFER COPYRIGHT ("Stanford University" 1985 1986 1987)) +(PUTPROPS HASHBUFFER COPYRIGHT ("Stanford University" 1985 1986 1987 2022)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (848 4618 (CREATEHASHBUFFER 858 . 1987) (OPENHASHBUFFER 1989 . 3081) (CLOSEHASHBUFFER -3083 . 3472) (GETHASHBUFFER 3474 . 4317) (PUTHASHBUFFER 4319 . 4616)) (4745 6703 ( -HASHARRAY.TO.HASHFILE 4755 . 5690) (HASHFILE.TO.HASHARRAY 5692 . 6701))))) + (FILEMAP (NIL (714 4484 (CREATEHASHBUFFER 724 . 1853) (OPENHASHBUFFER 1855 . 2947) (CLOSEHASHBUFFER +2949 . 3338) (GETHASHBUFFER 3340 . 4183) (PUTHASHBUFFER 4185 . 4482)) (4611 6569 ( +HASHARRAY.TO.HASHFILE 4621 . 5556) (HASHFILE.TO.HASHARRAY 5558 . 6567))))) STOP diff --git a/lispusers/HISTMENU.TEDIT b/lispusers/HISTMENU.TEDIT index 50fbc19fc350878a0e0a8c1057238e665591d77a..7e3426dafcc9da6dd3e8670c205e1b55ef5d4044 100644 GIT binary patch delta 73 zcmZ24w_Q%pGp{7IC?~VHKrg>2ozufJIKSTX^c2 LSlbz_t9AhZ2Br@=