-
-
Notifications
You must be signed in to change notification settings - Fork 24
/
Copy pathARMODES
176 lines (124 loc) · 6.89 KB
/
ARMODES
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
173
174
175
176
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP")
(FILECREATED "29-Nov-88 15:06:14" {PHYLUM}<BURWELL>LISP>ARMODES.\;10 6915
|changes| |to:| (RECORDS AR.ENVIRONMENT)
(VARS ARMODESCOMS)
(FNS AR.MODE AR.ADD.TO.BACKGROUND.MENU AR.MODE.SUBITEMS)
|previous| |date:| "29-Nov-88 14:40:17" {PHYLUM}<BURWELL>LISP>ARMODES.\;9)
; Copyright (c) 1988 by Xerox Corporation. All rights reserved.
(PRETTYCOMPRINT ARMODESCOMS)
(RPAQQ ARMODESCOMS
(
(* |;;| "provide a mechanism for change the database which the AR system uses")
(* |;;| "the interface to switch modes")
(FNS AR.MODE)
(GLOBALVARS AR.MODE)
(* |;;| "things for the background menu interface to mode changes")
(FNS AR.ADD.TO.BACKGROUND.MENU AR.MODE.SUBITEMS)
(FILES DEFAULTSUBITEMFN)
(VARS (AR.MODE.SUBITEMS)
(\\AR.ENVIRONMENTS))
(GLOBALVARS AR.MODE.SUBITEMS \\AR.ENVIRONMENTS)
(* |;;| "the ar environment -- everything you need to switch modes")
(RECORDS AR.ENVIRONMENT)
(GLOBALVARS AR.ENVIRONMENTS)
(* |;;| "installation")
(P (AR.ADD.TO.BACKGROUND.MENU)
(* |;;|
"if there's nothing set up already assume it's the Lisp mode and construct the environment")
(|if| (NOT (BOUNDP 'AR.ENVIRONMENTS))
|then|
(LET ((ORIGINALENVIRONMENT (|create| AR.ENVIRONMENT)))
(|for| FIELD |in| (RECORDFIELDNAMES 'AR.ENVIRONMENT)
|do|
(RECORDACCESS FIELD ORIGINALENVIRONMENT (RECLOOK 'AR.ENVIRONMENT)
'REPLACE
(EVAL FIELD)))
(SETQ AR.ENVIRONMENTS (LIST 'LISP ORIGINALENVIRONMENT)))
(AR.MODE 'LISP)))))
(* |;;| "provide a mechanism for change the database which the AR system uses")
(* |;;| "the interface to switch modes")
(DEFINEQ
(AR.MODE
(LAMBDA (MODE) (* \; "Edited 5-Aug-88 18:22 by Burwell")
(|if| (NULL MODE)
|then| (PROMPTPRINT "AR mode is " AR.MODE)
AR.MODE
|else| (LET ((ENVIRONMENT.FOR.MODE (LISTGET AR.ENVIRONMENTS MODE)))
(|if| ENVIRONMENT.FOR.MODE
|then| (|if| (OR (FIND.PROCESS 'AR.QUERY.FORM.TEMP)
(FIND.PROCESS 'AR.FORM.TEMP)
(FIND.PROCESS 'AR.FORM.MENU)
(FIND.PROCESS 'AR.FORM)
(FIND.PROCESS 'AR.QUERY.FORM))
|then| (PROMPTPRINT
"Please close open AR windows before changing modes."
)
|else| (SETQ AR.MODE MODE)
(|for| VAR |in| (RECORDFIELDNAMES
'AR.ENVIRONMENT)
|do| (SET VAR (RECORDACCESS VAR
ENVIRONMENT.FOR.MODE
(RECLOOK 'AR.ENVIRONMENT))))
(PROMPTPRINT "AR mode set to " MODE))
|else| (PROMPTPRINT "AR mode " MODE " not recognized."))))))
)
(DECLARE\: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS AR.MODE)
)
(* |;;| "things for the background menu interface to mode changes")
(DEFINEQ
(AR.ADD.TO.BACKGROUND.MENU
(LAMBDA NIL (* \; "Edited 2-Aug-88 15:58 by Burwell")
(|if| (NOT (|for| E |in| |BackgroundMenuCommands|
|thereis| (EQUAL "AR Mode" (AND (LISTP E)
(CAR E)))))
|then| (|push| |BackgroundMenuCommands| `("AR Mode" '(AR.MODE)
"Displays current AR mode."
(EVAL (AR.MODE.SUBITEMS))))
(SETQ |BackgroundMenu| NIL))))
(AR.MODE.SUBITEMS
(LAMBDA NIL (* \; "Edited 2-Aug-88 15:56 by Burwell")
(|if| (EQUAL AR.ENVIRONMENTS \\AR.ENVIRONMENTS)
|then| AR.MODE.SUBITEMS
|else| (LET ((MODES (|for| MODE |in| AR.ENVIRONMENTS |by| (CDDR MODE)
|collect| MODE)))
(SETQ AR.MODE.SUBITEMS (|for| MODE |in| MODES
|collect|
`(,MODE '(AR.MODE ',MODE)
,(CONCAT "Set AR mode to " MODE))))
(SETQ \\AR.ENVIRONMENTS (COPY AR.ENVIRONMENTS))
AR.MODE.SUBITEMS))))
)
(FILESLOAD DEFAULTSUBITEMFN)
(RPAQQ AR.MODE.SUBITEMS NIL)
(RPAQQ \\AR.ENVIRONMENTS NIL)
(DECLARE\: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS AR.MODE.SUBITEMS \\AR.ENVIRONMENTS)
)
(* |;;| "the ar environment -- everything you need to switch modes")
(DECLARE\: EVAL@COMPILE
(RECORD AR.ENVIRONMENT
(AR.NO.MESSAGE.FLG AR.INDEX.DEFAULT.FILE.NAME AR.INFO.FILE.NAME AR.DIRECTORY AR.FORM.FORMAT
AR.FORM.SPECS AR.SUBMIT.NUM.FILE.NAME AR.DISPLAY.FIELDS AR.SUMMARY.FIELDS
AR.CLEANUP.SORT.ORDER AR.SORT.SPEC.ITEMS AR.QUERY.SPEC.ITEMS AR.INDEX.CACHE.FILE.NAME
AR.IDENTIFICATION.STRING AR.INTERESTING.SUBMIT.FIELDS))
)
(DECLARE\: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS AR.ENVIRONMENTS)
)
(* |;;| "installation")
(AR.ADD.TO.BACKGROUND.MENU)
(* |;;| "if there's nothing set up already assume it's the Lisp mode and construct the environment")
(|if| (NOT (BOUNDP 'AR.ENVIRONMENTS))
|then| (LET ((ORIGINALENVIRONMENT (|create| AR.ENVIRONMENT)))
(|for| FIELD |in| (RECORDFIELDNAMES 'AR.ENVIRONMENT)
|do| (RECORDACCESS FIELD ORIGINALENVIRONMENT (RECLOOK 'AR.ENVIRONMENT)
'REPLACE
(EVAL FIELD)))
(SETQ AR.ENVIRONMENTS (LIST 'LISP ORIGINALENVIRONMENT)))
(AR.MODE 'LISP))
(PUTPROPS ARMODES COPYRIGHT ("Xerox Corporation" 1988))
(DECLARE\: DONTCOPY
(FILEMAP (NIL (2120 3819 (AR.MODE 2130 . 3817)) (3955 5410 (AR.ADD.TO.BACKGROUND.MENU 3965 . 4620) (
AR.MODE.SUBITEMS 4622 . 5408)))))
STOP