-
-
Notifications
You must be signed in to change notification settings - Fork 24
/
Copy pathBACKGROUNDMENU
163 lines (143 loc) · 7.62 KB
/
BACKGROUNDMENU
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
(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")
(FILECREATED "31-Jan-87 18:09:00" {ERIS}<LISPUSERS>LYRIC>BACKGROUNDMENU.;1 7367
previous date%: "31-Jan-86 11:36:13" {ERIS}<LISP>KOTO>LISPUSERS>BACKGROUNDMENU.;1)
(* "
Copyright (c) 1985, 1986, 1987 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT BACKGROUNDMENUCOMS)
(RPAQQ BACKGROUNDMENUCOMS ((INITVARS BackgroundMenuFixupMode BackgroundMenuSuperItem
BackgroundMenuTopLevelItems)
(FNS BkgMenu.add.item BkgMenu.fixup BkgMenu.move.item BkgMenu.remove.item
BkgMenu.rename.item BkgMenu.reorder.items BkgMenu.subitems
\BkgMenu.locate \BkgMenu.locater \BkgMenu.remove.item
\BkgMenu.scan.item.list \BkgMenu.unremove.item)))
(RPAQ? BackgroundMenuFixupMode NIL)
(RPAQ? BackgroundMenuSuperItem NIL)
(RPAQ? BackgroundMenuTopLevelItems NIL)
(DEFINEQ
(BkgMenu.add.item
[LAMBDA (item superitem atend) (* mdd "31-Jan-86 11:32")
(if (NULL superitem)
then (if atend
then (NCONC1 BackgroundMenuCommands item)
else (SETQ BackgroundMenuCommands (CONS item BackgroundMenuCommands)))
(SETQ BackgroundMenu NIL)
T
elseif (SETQ superitem (CDDAR (\BkgMenu.locate superitem)))
then [if (NULL (CDR superitem))
then (RPLACD superitem (LIST (LIST 'SUBITEMS item)))
else (if atend
then (NCONC1 (CADR superitem)
item)
else (RPLACD (CADR superitem)
(CONS item (CDADR superitem]
(SETQ BackgroundMenu NIL)
T])
(BkgMenu.fixup
[LAMBDA NIL (* mdd "23-Sep-85 19:09")
(bind stack (stacking _ (NEQ BackgroundMenuFixupMode 'bottom))
(result _ T) for x in (BkgMenu.subitems)
do [if (for i in BackgroundMenuTopLevelItems thereis (EQUAL (MKSTRING i)
(MKSTRING x)))
then (if (AND stacking (NEQ BackgroundMenuFixupMode 'top))
then (for i in stack do (OR (BkgMenu.move.item i BackgroundMenuSuperItem)
(SETQ result NIL)))
(SETQ stacking NIL))
else (if stacking
then (SETQ stack (CONS x stack))
else (OR (BkgMenu.move.item x BackgroundMenuSuperItem T)
(SETQ stacking NIL]
finally [if stacking
then (for i in stack do (OR (BkgMenu.move.item i BackgroundMenuSuperItem)
(SETQ result NIL]
(RETURN result])
(BkgMenu.move.item
[LAMBDA (item superitem atend) (* mdd "31-Jan-86 11:32")
(if (SETQ item (\BkgMenu.locate item))
then (\BkgMenu.remove.item item)
(if (BkgMenu.add.item (CAR item)
superitem atend)
then T
else (\BkgMenu.unremove.item item)
NIL])
(BkgMenu.remove.item
[LAMBDA (item) (* mdd "23-Sep-85 17:13")
(if (SETQ item (\BkgMenu.locate item))
then (\BkgMenu.remove.item item)
(SETQ BackgroundMenu NIL)
T])
(BkgMenu.rename.item
[LAMBDA (item new.name) (* mdd "23-Sep-85 16:58")
(if (SETQ item (\BkgMenu.locate item))
then (RPLACA (CAR item)
new.name)
(SETQ BackgroundMenu NIL)
T])
(BkgMenu.reorder.items
[LAMBDA (itemlist superitem atend) (* mdd "23-Sep-85 20:26")
(NOT (for i in (if atend
then itemlist
else (REVERSE itemlist)) do (OR (BkgMenu.move.item i superitem atend)
(SETQ $$VAL T])
(BkgMenu.subitems
[LAMBDA (item) (* mdd "23-Sep-85 18:33")
(if item
then (if (SETQ item (\BkgMenu.locate item))
then (MAPCAR (CDR (CADDDR (CAR item)))
(FUNCTION CAR))
else 'NotAnItem)
else (MAPCAR BackgroundMenuCommands (FUNCTION CAR])
(\BkgMenu.locate
[LAMBDA (item menu) (* mdd "23-Sep-85 20:58")
(if [AND (LISTP item)
(CDR item)
(NOT (SETQ menu (CADDDR (CAR (\BkgMenu.locate (CDR item)
menu]
then NIL
else (\BkgMenu.locater (MKSTRING (if (LISTP item)
then (CAR item)
else item))
(OR (CDR menu)
BackgroundMenuCommands)
menu])
(\BkgMenu.locater
[LAMBDA (name items preitems) (* mdd "23-Sep-85 20:44")
(bind (queue _ (CONS NIL NIL)) until (OR (SETQ $$VAL (\BkgMenu.scan.item.list name items preitems
queue))
(NULL (CAR queue)))
do (SETQ preitems (CAAR queue))
(SETQ items (CDR preitems))
(RPLACA queue (CDAR queue))
(if (NULL (CAR queue))
then (RPLACD queue NIL])
(\BkgMenu.remove.item
[LAMBDA (item) (* mdd "23-Sep-85 17:12")
(if (CDR item)
then (RPLACD (CDR item)
(CDDDR item))
else (SETQ BackgroundMenuCommands (CDR BackgroundMenuCommands])
(\BkgMenu.scan.item.list
[LAMBDA (name items preitems queue) (* mdd "23-Sep-85 15:39")
(for i in old items do (if (EQUAL (MKSTRING (CAR i))
name)
then (RETURN (CONS i preitems))
else (if (CDDDR i)
then (TCONC queue (CADDDR i)))
(SETQ preitems items])
(\BkgMenu.unremove.item
[LAMBDA (item) (* mdd "23-Sep-85 17:17")
(if (CDR item)
then (RPLACD (CDR item)
(CONS (CAR item)
(CDDR item)))
else (SETQ BackgroundMenuCommands (CONS (CAR item)
BackgroundMenuCommands])
)
(PUTPROPS BACKGROUNDMENU COPYRIGHT ("Xerox Corporation" 1985 1986 1987))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1008 7271 (BkgMenu.add.item 1018 . 1910) (BkgMenu.fixup 1912 . 3131) (BkgMenu.move.item
3133 . 3557) (BkgMenu.remove.item 3559 . 3834) (BkgMenu.rename.item 3836 . 4128) (
BkgMenu.reorder.items 4130 . 4505) (BkgMenu.subitems 4507 . 4907) (\BkgMenu.locate 4909 . 5520) (
\BkgMenu.locater 5522 . 6089) (\BkgMenu.remove.item 6091 . 6378) (\BkgMenu.scan.item.list 6380 . 6877)
(\BkgMenu.unremove.item 6879 . 7269)))))
STOP