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

Hardcopy to printer (#2290)

Browse Source 
* Separate interface for imagefile creation from the send-to-printer interface
* SEND.FILE.TO.PRINTER recognizes :DEFAULTPRINTER
* Various changes to address #2414
* Move BITMAP properties from PRINTERTYPES to PRINTFILETYPES.
* Fix ShellOpen, add UNIX-TMP-FILE-NAME
* Include COERCEFONTSPEC changes in anticipation of HTML streams
* PDFSTREAM compatible with new imagefile architecture plus able to convert non-local Postscript streams
* SKETCH compatible with new imagefile/printing architecture
* TEDIT compatible with new printing architecture
* Tedit files are of type TEDIT, not TEXT, new interface function TEDIT.TO.IMAGEFILE
* ATTACHEDWINDOW:  DOATTACHEDWINDOWCOM allows menu to have a form to EVAL, like the background menu
* WINDOW: fix menus for new hardcopy architecture
* Remove FLUSHFONTSINCORE--FLUSHFONTCACHE is more general
* LOAD character names as suggested in PR #2398
* HARDCOPYW respects file extension
* VIEWER as default printinghost
* SLASHIT interprets '.
* MCCS to UTF8 conversion on printer name
* Deal with {LPT}.LOCAL and upper casing
* @ LPT printers work with exact upper/lower matching
* Using NSPRINT functions to recognize fax
* Let "UNIX" be the name of the default printer of type UNIX
This commit is contained in:
rmkaplan
2026-01-26 15:38:22 -08:00
committed by GitHub
parent 23cef354eb
commit 65df2ba6a4
63 changed files with 3435 additions and 3177 deletions
Download Patch File Download Diff File Expand all files Collapse all files

219
library/UNIXPRINT
View File

@@ -1,33 +1,26 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "20-Jan-2023 22:44:05" {DSK}<home>frank>il>medley>gmedley>library>UNIXPRINT.;4 13651
(FILECREATED "25-Jan-2026 11:09:09" {WMEDLEY}<library>UNIXPRINT.;15 11553
:CHANGES-TO (VARS UNIXPRINTCOMS)
:EDIT-BY rmk
:PREVIOUS-DATE "18-Jan-2023 13:28:36" {DSK}<home>frank>il>medley>gmedley>library>UNIXPRINT.;3
)
:CHANGES-TO (FNS UnixPrint)
:PREVIOUS-DATE "18-Jan-2026 08:44:40" {WMEDLEY}<library>UNIXPRINT.;14)
(* ; "
Copyright (c) 1990-1993, 1995, 1997, 1999, 2001, 2018, 2023 by Venue.
")
(PRETTYCOMPRINT UNIXPRINTCOMS)
(RPAQQ UNIXPRINTCOMS
[(FILES UNIXUTILS)
(FNS InstallUnixPrinter UnixPrint UnixShellQuote UnixTempFile UnixPrintCommand)
(FNS UnixPrint UnixShellQuote UnixTempFile UnixPrintCommand)
(ALISTS (PRINTERTYPES (UNIX)))
(INITVARS (UnixPrinterName NIL)
(UNIXPRINTSWITCHES " -r -s "))
(P
(* ;;
 "(InstallUnixPrinter) commented out because POSTSCRIPT indirects according to platform")
(PRIN1 "Please feel free to edit UnixPrintCommand." PROMPTWINDOW))
(P (PRIN1 "Please feel free to edit UnixPrintCommand." PROMPTWINDOW))
(PROP FILETYPE UNIXPRINT)
(DECLARE%: DONTEVAL@COMPILE DOCOPY (FNS UnixPrintCommand))
(DECLARE%: EVAL@COMPILE DOCOPY (FILES UNIXCOMM))
(DECLARE%: EVAL@COMPILE DONTCOPY (GLOBALVARS UnixPrinterName))
(GLOBALVARS UnixPrinterName)
(DECLARE%: EVAL@COMPILE (FILES UNIXCOMM))
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA])
@@ -35,39 +28,33 @@ Copyright (c) 1990-1993, 1995, 1997, 1999, 2001, 2018, 2023 by Venue.
(FILESLOAD UNIXUTILS)
(DEFINEQ
(InstallUnixPrinter
[LAMBDA (PrinterTypes) (* ; "Edited 8-Feb-97 11:33 by rmk:")
(* ;; "Set up any printers in PrinterTypes (or just Postscript by default) so that they'll be printed using the unix LPR command.")
(DECLARE (GLOBALVARS PRINTERTYPES))
(for type inside (OR PrinterTypes '(POSTSCRIPT))
do (for x in PRINTERTYPES when (EQMEMB type (CAR x))
do (LET ((PRINTERTYPE type))
(PUTASSOC 'SEND (LIST 'UnixPrint)
(CDR x])
(UnixPrint
[LAMBDA (HOST FILE PRINTOPTIONS) (* ; "Edited 7-Dec-2001 14:55 by rmk:")
[LAMBDA (HOST FILE PRINTOPTIONS) (* ; "Edited 25-Jan-2026 11:08 by rmk")
(* ; "Edited 17-Jan-2026 15:47 by rmk")
(* ; "Edited 5-Dec-2025 11:46 by rmk")
(* ; "Edited 13-Sep-2025 20:28 by rmk")
(* ; "Edited 11-Sep-2025 20:48 by rmk")
(* ; "Edited 7-Dec-2001 14:55 by rmk:")
(* ; "Edited 20-May-92 14:13 by nilsson")
(* ;; "Given a print FILE, use the Unix %"lpr%" command to spool it to a printer.")
(* ;; "")
(* ;; "The printer is named by HOST or UnixPrinterName, a Global variable.")
[LET*
((PRINTER (OR HOST UnixPrinterName))
((PRINTER (SELECTQ HOST
((NIL UNIX)
UnixPrinterName)
HOST))
(COPIES (LISTGET PRINTOPTIONS '%#COPIES))
(NAME (LISTGET PRINTOPTIONS 'DOCUMENT.NAME))
(NSIDES (LISTGET PRINTOPTIONS '%#SIDES))
(TYPE (PRINTERTYPE PRINTER)))
(* ;; "Removed redundant check (we already know it's a PS printer), JDS 2/19/92:")
(* ;; "(COND ((NULL TYPE) (ERROR (CONCAT %"Printertype unknown for %" PRINTER))) ((NOT (EQL (U-CASE TYPE) 'POSTSCRIPT)) (ERROR (CONCAT %"Printertype for %" PRINTER %" is not Postscript%"))))")
[COND
((OR (NULL NAME)
(EQ NAME 'LPT)
(STRPOS "{LPT}" NAME 1 NIL T))
(SETQ NAME "Medley Output"))
((EQ (CHCON1 NAME)
@@ -88,63 +75,63 @@ Copyright (c) 1990-1993, 1995, 1997, 1999, 2001, 2018, 2023 by Venue.
(* ;; "The temp file's name will be of the form medleyprint.<idate>, so all such files can be found for deletion on a subsequent call after a certain amount of time (2 minutes) has gone by. If we delete immediately, it may happen before lpr has done its thing. ")
(CL:MULTIPLE-VALUE-BIND (tmpstream tmpname)
(UnixTempFile 'medleyprint.)
(COND
(tmpstream
(CL:MULTIPLE-VALUE-BIND
(tmpstream tmpname)
(UnixTempFile 'medleyprint.)
(COND
(tmpstream
(* ;; "First, copy the lisp file to /tmp so lpr can find it.")
(* ;; "First, copy the lisp file to /tmp so lpr can find it.")
[CL:WITH-OPEN-STREAM
(out tmpstream)
(CL:WITH-OPEN-STREAM
(in (OPENSTREAM FILE 'INPUT))
(printout PROMPTWINDOW .TAB0 0 "Spooling output to Unix printer"
(COND
(PRINTER (CONCAT " '" PRINTER "'"))
(T ""))
"...")
(IF NSIDES
THEN
(* ;; "Have to put magic simplex/duplex stuff in the tmp file itself, after the first line, cause there is no other way to control some duplex printers.")
[CL:WITH-OPEN-STREAM
(out tmpstream)
(CL:WITH-OPEN-STREAM
(in (OPENSTREAM FILE 'INPUT))
(printout PROMPTWINDOW .TAB0 0 "Sending output to Unix printer " (OR PRINTER "")
" ")
(IF NSIDES
THEN
(* ;; "Have to put magic simplex/duplex stuff in the tmp file itself, after the first line, cause there is no other way to control some duplex printers.")
(BIND C SAWCR
DO (SETQ C (BIN in))
(IF (MEMB C (CHARCODE (CR LF)))
THEN (BOUT out C)
(SETQ SAWCR T)
ELSEIF SAWCR
THEN
(* ;; "First char of 2nd line: nonCR/LF after CR/LF")
(BIND C SAWCR
DO (SETQ C (BIN in))
(IF (MEMB C (CHARCODE (CR LF)))
THEN (BOUT out C)
(SETQ SAWCR T)
ELSEIF SAWCR
THEN
(* ;; "First char of 2nd line: nonCR/LF after CR/LF")
(* ;; "Put out simplex header, then print character in C")
(* ;; "Put out simplex header, then print character in C")
(PRINTOUT out "%%BeginSetup" T)
(PRINTOUT out "[{" T "%%%%BeginFeature: *Duplex Simplex" T
"<< /Duplex " (CL:IF (EQ NSIDES 1)
"false"
"true")
" /Tumble false >> setpagedevice" T
"%%%%EndFeature" T "} stopped cleartomark" T)
(PRINTOUT out "%%EndSetup" T)
(BOUT out C)
(COPYCHARS in out (GETFILEPTR in)
-1)
(RETURN)
ELSE (BOUT out C)))
ELSE (COPYCHARS in out 0 -1]
(PRINTOUT out "%%BeginSetup" T)
(PRINTOUT out "[{" T "%%%%BeginFeature: *Duplex Simplex" T
"<< /Duplex " (CL:IF (EQ NSIDES 1)
"false"
"true")
" /Tumble false >> setpagedevice" T "%%%%EndFeature"
T "} stopped cleartomark" T)
(PRINTOUT out "%%EndSetup" T)
(BOUT out C)
(COPYCHARS in out (GETFILEPTR in)
-1)
(RETURN)
ELSE (BOUT out C)))
ELSE (COPYCHARS in out 0 -1]
(* ;; "Now make Unix print the /tmp file.")
(* ;; "Now make Unix print the /tmp file.")
(ShellCommand (UnixPrintCommand PRINTER COPIES NAME tmpname)
PROMPTWINDOW)
(printout PROMPTWINDOW "done" T))
(T (ERROR "Couldn't create unix temp file"))))]
(ShellCommand (UnixPrintCommand PRINTER COPIES NAME tmpname)
PROMPTWINDOW)
(CL:WHEN NIL (* ; "This should be conditioned an error code--don't want to say %"done%" if it didn't happen. If we put this back, then put in ... in the Sending printout above")
(printout PROMPTWINDOW "done" T)))
(T (ERROR "Couldn't create unix temp file"]
T])
(UnixShellQuote
[LAMBDA (STRING)
(DECLARE (LOCALVARS . T)) (* ; "Edited 19-Apr-89 21:14 by TAL")
(DECLARE (LOCALVARS . T)) (* ; "Edited 18-Jan-2026 08:34 by rmk")
(* ; "Edited 19-Apr-89 21:14 by TAL")
(LET* ((X (CHCON STRING))
(CT X)
C FLG)
@@ -168,9 +155,9 @@ Copyright (c) 1990-1993, 1995, 1997, 1999, 2001, 2018, 2023 by Venue.
(CHARCODE SPACE))
(T C))
(SETQ CT (CDR CT]
(COND
(FLG (CONCATCODES X))
(T STRING])
(MTOUTF8STRING (COND
(FLG (CONCATCODES X))
(T STRING])
(UnixTempFile
[LAMBDA (Prefix DontOpen) (* ; "Edited 28-Apr-93 13:49 by rmk:")
@@ -234,66 +221,26 @@ Copyright (c) 1990-1993, 1995, 1997, 1999, 2001, 2018, 2023 by Venue.
" " TMPNAME])
)
(ADDTOVAR PRINTERTYPES ((UNIX)
(CANPRINT (PDF))
(STATUS TRUE)
(PROPERTIES NILL)
(SEND UnixPrint)))
(RPAQ? UnixPrinterName NIL)
(RPAQ? UNIXPRINTSWITCHES " -r -s ")
(* ;; "(InstallUnixPrinter) commented out because POSTSCRIPT indirects according to platform")
(PRIN1 "Please feel free to edit UnixPrintCommand." PROMPTWINDOW)
(PUTPROPS UNIXPRINT FILETYPE :COMPILE-FILE)
(DECLARE%: DONTEVAL@COMPILE DOCOPY
(DEFINEQ
(UnixPrintCommand
[LAMBDA (PRINTER COPIES NAME TMPNAME) (* ; "Edited 4-May-2018 17:17 by rmk:")
(* ; "Edited 20-May-92 14:26 by nilsson")
(* ;; "This function is called when the user wants to UNIXPRINT a file. It has to return a string that when sent to a shell prints the file tmpname. In the cub version this should look something like %"/usr/ucb/lpr tmpname%". The arguments to this function are:")
(* ;; " PRINTER - the name of the printer. Usually something like lw or plw.")
(* ;; "COPIES - how many copies of this job to be printed.")
(* ;; "NAME - the name of this job. This gets printed on the banner of your job.")
(* ;; "TMPNAME - The name of the temporary file that contains the postscript code for this job. ")
(* ;; "Note the clever function UnixShellQuote. It converts any lisp name to a string that is quoted according to /bin/sh syntax")
(* ;; "UNIXPRINTSWITCHES makes it easy for other sites to change just the lpr switches.")
(* ;; "Use raw lpr, let system decide where it is located.")
(CONCAT "lpr " (COND
((AND PRINTER (NEQ 0 (NCHARS PRINTER)))
(CONCAT "-P" (UnixShellQuote PRINTER)
" "))
(T ""))
(COND
((AND (FIXP COPIES)
(NEQ COPIES 1))
(CONCAT "-#" COPIES " "))
(T ""))
" -J"
(UnixShellQuote NAME)
" "
(OR UNIXPRINTSWITCHES "")
" " TMPNAME])
)
)
(DECLARE%: EVAL@COMPILE DOCOPY
(FILESLOAD UNIXCOMM)
)
(DECLARE%: EVAL@COMPILE DONTCOPY
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS UnixPrinterName)
)
(DECLARE%: EVAL@COMPILE
(FILESLOAD UNIXCOMM)
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
@@ -303,9 +250,7 @@ Copyright (c) 1990-1993, 1995, 1997, 1999, 2001, 2018, 2023 by Venue.
(ADDTOVAR LAMA )
)
(PUTPROPS UNIXPRINT COPYRIGHT ("Venue" 1990 1991 1992 1993 1995 1997 1999 2001 2018 2023))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1389 11216 (InstallUnixPrinter 1399 . 1991) (UnixPrint 1993 . 6875) (UnixShellQuote
6877 . 8306) (UnixTempFile 8308 . 9531) (UnixPrintCommand 9533 . 11214)) (11550 13243 (
UnixPrintCommand 11560 . 13241)))))
(FILEMAP (NIL (1046 10887 (UnixPrint 1056 . 6392) (UnixShellQuote 6394 . 7977) (UnixTempFile 7979 .
9202) (UnixPrintCommand 9204 . 10885)))))
STOP