-
-
Notifications
You must be signed in to change notification settings - Fork 25
/
Copy pathSETDEFAULTPRINTER
172 lines (120 loc) · 7.44 KB
/
SETDEFAULTPRINTER
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED " 7-Jun-93 15:34:58" {DSK}<project>medley2.0>lispusers>SETDEFAULTPRINTER.;7 7525
changes to%: (VARS SETDEFAULTPRINTERCOMS)
(FNS \sdp.menu.subitems)
previous date%: "29-May-93 15:44:06" {DSK}<project>medley2.0>lispusers>SETDEFAULTPRINTER.;6)
(* ; "
Copyright (c) 1985, 1986, 1987, 1993 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT SETDEFAULTPRINTERCOMS)
(RPAQQ SETDEFAULTPRINTERCOMS
(
(* ;;; "the regular DEFAULTSUBITEMFN modified to recognize EVAL as a key to EVAL the CADR of the list to get the subitems")
(FILES DEFAULTSUBITEMFN)
(* ;;; "the setdefaultprinter functions")
(FNS \sdp.menu.subitems \sdp.set.printer)
(* ;;; "SDP.PRINTERINFO is the place to look up things like printer location, it also looks on the name of the printer for a LOCATION property")
(INITVARS (SDP.PRINTERINFO NIL))
(* ;;; "insinuate self into background menu")
[ADDVARS (BackgroundMenuCommands ("Set Default Printer" (\sdp.set.printer (
GetNewPrinterFromUser
))
"Asks for (new) default printer name. <cr> without entering name aborts change."
(EVAL (\sdp.menu.subitems]
(* ;;; "reset the background menu so our change takes effect, and remove space from the separators when reading printer names")
(P (SETQ BackgroundMenu))))
(* ;;;
"the regular DEFAULTSUBITEMFN modified to recognize EVAL as a key to EVAL the CADR of the list to get the subitems"
)
(FILESLOAD DEFAULTSUBITEMFN)
(* ;;; "the setdefaultprinter functions")
(DEFINEQ
(\sdp.menu.subitems
[LAMBDA NIL (* ; "Edited 7-Jun-93 15:30 by rmk:")
(* N.H.Briggs "24-Mar-86 16:09")
(NCONC1 [FOR P PNAME INSIDE DEFAULTPRINTINGHOST
COLLECT (LIST (IF (NLISTP P)
THEN P
ELSEIF (CADDR P)
THEN (CONCAT (CADR P)
" "
(CADDR P))
ELSE (CADR P))
(LIST '\sdp.set.printer (KWOTE P))
(OR (GETPROP (U-CASE P)
'LOCATION)
(CDR (ASSOC (U-CASE P)
SDP.PRINTERINFO]
(LIST "Other..." '(\sdp.set.printer (GetNewPrinterFromUser))
"Asks for (new) default printer name. <cr> without entering name aborts change."])
(\sdp.set.printer
[LAMBDA (PRINTER) (* ; "Edited 29-May-93 15:11 by rmk:")
(* N.H.Briggs " 8-Jul-86 12:29")
(* ;; "CANONICAL.HOSTNAME is NIL except for XNS hosts")
(SETQ DEFAULTPRINTINGHOST (MKLIST DEFAULTPRINTINGHOST))
[IF PRINTER
THEN
(* ;; "Convert to canonical name")
(SETQ PRINTER (IF (LISTP PRINTER)
THEN (LIST (CAR PRINTER)
(OR (CANONICAL.HOSTNAME (CADR PRINTER))
(CADR PRINTER))
(CADDR PRINTER))
ELSE (OR (CANONICAL.HOSTNAME PRINTER)
PRINTER)))
(LET ((TOP (CAR DEFAULTPRINTINGHOST))
(CANONICALPRINTERNAME (IF (LISTP PRINTER)
THEN (CADR PRINTER)
ELSE PRINTER)))
(IF (IF (LISTP PRINTER)
THEN [AND (LISTP TOP)
(EQ (CAR TOP)
(CAR PRINTER))
(EQ (CADDR TOP)
(CADDR PRINTER))
(STRING-EQUAL CANONICALPRINTERNAME (OR (CANONICAL.HOSTNAME
(CADR TOP))
(CADR TOP]
ELSE (AND (NLISTP TOP)
(STRING-EQUAL (OR (CANONICAL.HOSTNAME TOP)
TOP)
CANONICALPRINTERNAME)))
THEN (PROMPTPRINT "default printer not changed")
ELSE [SETQ DEFAULTPRINTINGHOST
(CONS PRINTER
(IF (LISTP PRINTER)
THEN (FOR P IN DEFAULTPRINTINGHOST
UNLESS [AND (LISTP P)
(EQ (CAR P)
(CAR PRINTER))
(EQ (CADDR P)
(CADDR PRINTER))
(STRING-EQUAL
CANONICALPRINTERNAME
(OR (CANONICAL.HOSTNAME (CADR P))
(CADR P] COLLECT P)
ELSE (FOR P IN DEFAULTPRINTINGHOST
UNLESS (AND (NLISTP P)
(STRING-EQUAL CANONICALPRINTERNAME
(OR (CANONICAL.HOSTNAME P)
P))) COLLECT P]
(PROMPTPRINT "default printer set to " PRINTER]
NIL])
)
(* ;;;
"SDP.PRINTERINFO is the place to look up things like printer location, it also looks on the name of the printer for a LOCATION property"
)
(RPAQ? SDP.PRINTERINFO NIL)
(* ;;; "insinuate self into background menu")
(ADDTOVAR BackgroundMenuCommands ("Set Default Printer" (\sdp.set.printer (GetNewPrinterFromUser)
)
"Asks for (new) default printer name. <cr> without entering name aborts change."
(EVAL (\sdp.menu.subitems))))
(* ;;;
"reset the background menu so our change takes effect, and remove space from the separators when reading printer names"
)
(SETQ BackgroundMenu)
(PUTPROPS SETDEFAULTPRINTER COPYRIGHT ("Xerox Corporation" 1985 1986 1987 1993))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1960 6625 (\sdp.menu.subitems 1970 . 3132) (\sdp.set.printer 3134 . 6623)))))
STOP