source: trunk/source/contrib/foy/cl-documentation-cm/cl-documentation.lisp @ 12717

Last change on this file since 12717 was 12717, checked in by gfoy, 11 years ago

Four New Tools.

File size: 24.4 KB
Line 
1;;;-*-Mode: LISP; Package: CL-DOCUMENTATION -*-
2
3;;; ----------------------------------------------------------------------------
4;;;
5;;;      cl-documentation.lisp
6;;;
7;;;      copyright © 2009 Glen Foy
8;;;      (Permission is granted to Clozure Associates to distribute this file.)
9;;;
10;;;      This code is moronically simple, but surprisingly useful.
11;;;      It adds a documentation tool for CL functions to the Context-Menu mechanism.
12;;;      Right-Click displays a list of submenus.  The submenus are functional groups.
13;;;      Popping the submenu displays entries for all CL functions belonging to that
14;;;      functional group.  Selecting a function open a documentation dialog.
15;;;
16;;;      This software is offered "as is", without warranty of any kind.
17;;;
18;;;      Mod History, most recent first:
19;;;      8/31/9  version 0.1b1
20;;;              First cut.
21;;;
22;;; ----------------------------------------------------------------------------
23
24(defpackage "CL-DOCUMENTATION" (:nicknames "CLDOC") (:use :cl :ccl))
25(in-package "CL-DOCUMENTATION")
26
27(require :context-menu-cm)
28(cmenu:check-hyperspec-availability "CL-Documentation-CM")
29
30(defparameter *cl-documentation-menu* nil "The cl-documentation-menu instance.")
31
32
33;;; ----------------------------------------------------------------------------
34;;;
35(defClass CL-DOCUMENTATION-MENU (ns:ns-menu) 
36  ((tool-menu :initform nil :accessor tool-menu)
37   (doc-path :initform (merge-pathnames ";ReadMe.rtf" cl-user::*cl-documentation-directory*) :reader doc-path)
38   (text-view :initform nil :accessor text-view))
39  (:documentation "A menu containing CL functions sorted into functional groups.")
40  (:metaclass ns:+ns-object))
41
42(objc:defmethod (#/clDocumentationAction: :void) ((m cl-documentation-menu) (sender :id))
43  (display-cl-doc (item-symbol sender) (text-view m)))
44
45(objc:defmethod (#/update :void) ((m cl-documentation-menu))
46  (cmenu:update-tool-menu m (tool-menu m))
47  (call-next-method))
48
49(defmethod initialize-instance :after ((m cl-documentation-menu) &key)
50  (setf (tool-menu m) (cmenu:add-default-tool-menu m :doc-file (doc-path m))))
51
52(defun display-cl-doc (symbol text-view)
53  "Display the documentation for SYMBOL."
54  ;; If Hemlock-Commands is loaded, this will be
55  ;; redefined there to use the documentation dialog.
56  (gui::lookup-hyperspec-symbol symbol text-view))
57
58(setq *cl-documentation-menu* (make-instance 'cl-documentation-menu))
59
60;;; ----------------------------------------------------------------------------
61;;;
62(defClass CL-CATEGORY-MENU-ITEM (ns:ns-menu-item) 
63  ((symbol :initform nil :accessor item-symbol))
64  (:documentation "Support for the documentation menu.")
65  (:metaclass ns:+ns-object))
66
67(defun populate-submenu (menu symbol-list)
68  "Create and add menu-items for each functional group in SYMBOL-LIST."
69  (dolist (sym symbol-list)
70    (let ((menu-item (make-instance 'cl-category-menu-item))
71          (attributed-string (#/initWithString:attributes:
72                              (#/alloc ns:ns-attributed-string) 
73                              (ccl::%make-nsstring (string-downcase (string sym)))
74                              cmenu:*hemlock-menu-dictionary*)))
75      (#/setAttributedTitle: menu-item attributed-string)
76      (#/setAction: menu-item (ccl::@selector "clDocumentationAction:"))
77      (#/setTarget: menu-item  *cl-documentation-menu*)
78      (setf (item-symbol menu-item) sym)
79      (#/addItem: menu menu-item))))
80
81(defun make-submenu-item (title symbol-list)
82  "Create a menu-item with a submenu and populate the submenu based on SYMBOL-LIST."
83  (let ((menu-item (make-instance ns:ns-menu-item))
84        (attributed-string (#/initWithString:attributes:
85                            (#/alloc ns:ns-attributed-string) 
86                            (ccl::%make-nsstring title)
87                            cmenu:*hemlock-menu-dictionary*))
88        (submenu (make-instance ns:ns-menu)))
89    (#/setAttributedTitle: menu-item attributed-string)
90    (#/setSubmenu: menu-item submenu)
91    (populate-submenu submenu symbol-list)
92    menu-item))
93
94;;; ----------------------------------------------------------------------------
95;;;
96(defParameter *evaluation-and-compilation-symbol-list*
97  (list 'compile 'compiler-macro-function 'constantp 'declaim 'declare 'define-compiler-macro 
98        'define-symbol-macro 'defmacro 'eval 'eval-when 'lambda 'load-time-value 'locally 
99        'macroexpand 'macroexpand-1 'macro-function 'proclaim 'special-operator-p 'symbol-macrolet
100        'the 'quote))
101
102(defParameter *evaluation-and-compilation*
103  (make-submenu-item "evaluation and compilation" *evaluation-and-compilation-symbol-list*))
104
105;;; ----------------------------------------------------------------------------
106;;;
107(defParameter *types-and-classes-symbol-list*
108  (list 'coerce 'deftype 'subtypep 'type-error-datum 'type-error-expected-type 'type-of 'typep))
109
110(defParameter *types-and-classes*
111  (make-submenu-item "types and classes" *types-and-classes-symbol-list*))
112
113;;; ----------------------------------------------------------------------------
114;;;
115(defParameter *control-and-data-flow-symbol-list*
116  (list 'and 'apply 'block 'case 'catch 'ccase 'compiled-function-p 'complement 'cond 
117        'constantly 'ctypecase 'defconstant 'define-modify-macro 'define-setf-expander 
118        'defparameter 'defsetf 'defun 'defvar 'destructuring-bind 'ecase 'eq 'eql 'equal 'equalp 
119        'etypecase 'every 'fboundp 'fdefinition 'flet 'fmakunbound 'funcall 'function 
120        'function-lambda-expression 'functionp 'labels 'get-setf-expansion 'go 'identity 'if 
121        'let 'let* 'macrolet 'multiple-value-bind 'multiple-value-call 'multiple-value-list 
122        'multiple-value-prog1 'multiple-value-setq 'not 'notany 'notevery 'nth-value 'or 'prog 
123        'prog* 'prog1 'prog2 'progn 'progv 'psetf 'psetq 'return 'return-from 'rotatef 'setf 
124        'setq 'shiftf 'some 'tagbody 'throw 'typecase 'unless 'unwind-protect 'values 
125        'values-list 'when))
126
127(defParameter *control-and-data-flow*
128  (make-submenu-item "control and data flow" *control-and-data-flow-symbol-list*))
129
130;;; ----------------------------------------------------------------------------
131;;;
132(defParameter *iteration-symbol-list*
133  (list 'do 'do* 'dolist 'dotimes 'loop))
134
135(defParameter *iteration*
136  (make-submenu-item "iteration" *iteration-symbol-list*))
137
138;;; ----------------------------------------------------------------------------
139;;;
140(defParameter *objects-symbol-list*
141  (list 'add-method 'allocate-instance 'call-method 'call-next-method 'change-class 'class-name 
142        'class-of 'compute-applicable-methods 'defclass 'defgeneric 'define-method-combination 
143        'defmethod 'ensure-generic-function 'find-class 'find-method 'function-keywords 
144        'initialize-instance 'make-instance 'make-instances-obsolete 'make-load-form 
145        'make-load-form-saving-slots 'method-qualifiers 'next-method-p 'no-applicable-method 
146        'no-next-method 'reinitialize-instance 'remove-method 'shared-initialize 'slot-boundp 
147        'slot-exists-p 'slot-makunbound 'slot-missing 'slot-unbound 'slot-value 'with-accessors 
148        'with-slots 'unbound-slot-instance 'update-instance-for-different-class 
149        'update-instance-for-redefined-class))
150
151(defParameter *objects*
152  (make-submenu-item "objects" *objects-symbol-list*))
153
154;;; ----------------------------------------------------------------------------
155;;;
156(defParameter *structures-symbol-list*
157  (list 'copy-structure 'defstruct))
158
159(defParameter *structures*
160  (make-submenu-item "structures" *structures-symbol-list*))
161
162;;; ----------------------------------------------------------------------------
163;;;
164(defParameter *conditions-symbol-list*
165  (list 'abort 'assert 'break 'cell-error-name 'cerror 'check-type 'compute-restarts 'continue 
166        'define-condition 'error 'find-restart 'handler-bind 'handler-case 'ignore-errors 
167        'invalid-method-error 'invoke-debugger 'invoke-restart 'invoke-restart-interactively 
168        'make-condition 'method-combination-error 'muffle-warning 'restart-bind 'restart-case 
169        'restart-name 'signal 'simple-condition-format-arguments 'simple-condition-format-control 
170        'store-value 'use-value 'warn 'with-condition-restarts 'with-simple-restart))
171
172(defParameter *conditions*
173  (make-submenu-item "conditions" *conditions-symbol-list*))
174
175;;; ----------------------------------------------------------------------------
176;;;
177(defParameter *symbols-symbol-list*
178  (list 'boundp 'copy-symbol 'gensym 'gentemp 'get 'keywordp 'make-symbol 'makunbound 'set 
179        'symbol-function 'symbol-name 'symbolp 'symbol-package 'symbol-plist 'symbol-value 
180        'remprop))
181
182(defParameter *symbols*
183  (make-submenu-item "symbols" *symbols-symbol-list*))
184
185;;; ----------------------------------------------------------------------------
186;;;
187(defParameter *packages-symbol-list*
188  (list 'defpackage 'delete-package 'do-all-symbols 'do-external-symbols 'do-symbols 'export 
189        'find-all-symbols 'find-package 'find-symbol 'import 'in-package 'intern 
190        'list-all-packages 'make-package 'package-error-package 'package-name 'package-nicknames 
191        'packagep 'package-shadowing-symbols 'package-used-by-list 'package-use-list 
192        'rename-package 'shadow 'shadowing-import 'unexport 'unintern 'unuse-package 
193        'with-package-iterator))
194
195(defParameter *packages*
196  (make-submenu-item "packages" *packages-symbol-list*))
197
198;;; ----------------------------------------------------------------------------
199;;;
200(defParameter *numbers-symbol-list*
201  (list 'abs 'acos 'acosh 'arithmetic-error-operands 'arithmetic-error-operation 'ash 'asin 
202        'asinh 'atan 'atanh 'boole 'byte 'byte-position 'byte-size 'ceiling 'cis 'complex 
203        'complexp 'conjugate 'cos 'cosh 'decf 'decode-float 'denominator 'deposit-field 'dpb 
204        'evenp 'exp 'expt 'fceiling 'ffloor 'float 'float-digits 'floatp 'float-precision 
205        'float-radix 'float-sign 'floor 'fround 'ftruncate 'gcd 'imagpart 'incf 
206        'integer-decode-float 'integer-length 'integerp 'isqrt 'lcm 'ldb 'ldb-test 'log 'logand 
207        'logandc1 'logandc2 'logbitp 'logcount 'logeqv 'logior 'lognand 'lognor 'lognot 'logorc1 
208        'logorc2 'logtest 'logxor 'make-random-state 'mask-field 'max 'min 'minusp 'mod 'numberp 
209        'numerator 'oddp 'parse-integer 'phase 'plusp 'random 'random-state-p 'rational 
210        'rationalize 'rationalp 'realp 'realpart 'rem 'round 'scale-float 'signum 'sin 'sinh 
211        'sqrt 'tan 'tanh 'truncate 'upgraded-complex-part-type 'zerop '= '/= '> '< '<= '>= '* 
212        '+ '- '/ '1+ '1- ))
213
214(defParameter *numbers*
215  (make-submenu-item "numbers" *numbers-symbol-list*))
216
217;;; ----------------------------------------------------------------------------
218;;;
219(defParameter *characters-symbol-list*
220  (list 'alpha-char-p 'both-case-p 'alphanumericp 'character 'characterp 'char-code 
221        'char-downcase 'char-greaterp 'char-equal 'char-int 'char-lessp 'char-name 
222        'char-not-greaterp 'char-not-equal 'char-not-lessp 'char-upcase 'char= 'char/= 
223        'char> 'char< 'char<= 'char>= 'code-char 'digit-char 'digit-char-p 'graphic-char-p 
224        'lower-case-p 'name-char 'standard-char-p 'upper-case-p))
225
226(defParameter *characters*
227  (make-submenu-item "characters" *characters-symbol-list*))
228
229;;; ----------------------------------------------------------------------------
230;;;
231(defParameter *conses-symbol-list*
232  (list 'acons 'adjoin 'append 'assoc 'assoc-if 'assoc-if-not 'atom 'butlast 'nbutlast 'car 'cdr 
233        'cons 'consp 'copy-alist 'copy-list 'copy-tree 'endp 'first 'getf 'get-properties 
234        'intersection 'nintersection 'last 'ldiff 'list 'list-length 'listp 'make-list 'mapc 
235        'mapcan 'mapcar 'mapcon 'mapl 'maplist 'member 'member-if 'member-if-not 'nconc 'nth 
236        'nthcdr 'null 'pairlis 'pop 'push 'pushnew 'rassoc 'rassoc-if 'rassoc-if-not 'remf 'rest 
237        'revappend 'nreconc 'rplaca 'rplacd 'set-difference 'nset-difference 'set-exclusive-or 
238        'nset-exclusive-or 'sublis 'nsublis 'subsetp 'subst 'nsubst 'subst-if 'nsubst-if 
239        'subst-if-not 'nsubst-if-not 'tailp 'tree-equal 'union 'nunion))
240
241(defParameter *conses*
242  (make-submenu-item "conses" *conses-symbol-list*))
243
244;;; ----------------------------------------------------------------------------
245;;;
246(defParameter *arrays-symbol-list*
247  (list  'adjustable-array-p 'adjust-array 'aref 'array-dimension 'array-dimensions 
248         'array-displacement 'array-element-type 'array-has-fill-pointer-p 'array-in-bounds-p 
249         'arrayp 'array-rank 'array-row-major-index 'array-total-size 'bit 'bit-and 'bit-andc1 
250         'bit-andc2 'bit-eqv 'bit-ior 'bit-nand 'bit-nor 'bit-not 'bit-orc1 'bit-orc2 'bit-xor 
251         'bit-vector-p 'fill-pointer 'make-array 'row-major-aref 'sbit 'simple-bit-vector-p 
252         'simple-vector-p 'svref 'upgraded-array-element-type 'vector 'vectorp 'vector-pop 
253         'vector-push 'vector-push-extend))
254
255(defParameter *arrays*
256  (make-submenu-item "arrays" *arrays-symbol-list*))
257
258;;; ----------------------------------------------------------------------------
259;;;
260(defParameter *strings-symbol-list*
261  (list 'char 'make-string 'schar 'simple-string-p 'string 'string-capitalize 'nstring-capitalize 
262        'string-downcase 'nstring-downcase 'string-equal 'string-greaterp 'string-upcase 
263        'nstring-upcase 'string-left-trim 'string-lessp 'string-not-equal 'string-not-greaterp 
264        'string-not-lessp 'stringp 'string-right-trim 'string-trim 'string= 'string/= 'string< 
265        'string> 'string<= 'string>=))
266
267(defParameter *strings*
268  (make-submenu-item "strings" *strings-symbol-list*))
269
270;;; ----------------------------------------------------------------------------
271;;;
272(defParameter *sequences-symbol-list*
273  (list 'concatenate 'copy-seq 'count 'count-if 'elt 'fill 'find 'find-if 'find-if-not 'length 
274        'make-sequence 'map 'map-into 'merge 'mismatch 'position 'position-if 'position-if-not 
275        'reduce 'remove 'delete 'remove-duplicates 'delete-duplicates 'remove-if 'delete-if 
276        'remove-if-not 'delete-if-not 'replace 'reverse 'nreverse 'search 'sort 'stable-sort 
277        'subseq 'substitute 'nsubstitute 'substitute-if 'nsubstitute-if 'substitute-if-not 
278        'nsubstitute-if-not))
279
280(defParameter *sequences*
281  (make-submenu-item "sequences" *sequences-symbol-list*))
282
283;;; ----------------------------------------------------------------------------
284;;;
285(defParameter *hash-tables-symbol-list*
286  (list 'clrhash 'gethash 'hash-table-count 'hash-table-p 'hash-table-rehash-size 'hash-table-rehash-threshold 'hash-table-size 'hash-table-test 'make-hash-table 'maphash 'remhash 'sxhash 'with-hash-table-iterator))
287
288(defParameter *hash-tables*
289  (make-submenu-item "hash tables" *hash-tables-symbol-list*))
290
291;;; ----------------------------------------------------------------------------
292;;;
293(defParameter *filenames-symbol-list*
294  (list 'directory-namestring 'enough-namestring 'file-namestring 'host-namestring 
295        'load-logical-pathname-translations 'logical-pathname 'logical-pathname-translations 
296        'make-pathname 'merge-pathnames 'namestring 'parse-namestring 'pathname 'pathname-host 
297        'pathname-device 'pathname-directory 'pathname-match-p 'pathname-name 'pathnamep 
298        'pathname-type 'pathname-version 'translate-logical-pathname 'translate-pathname 
299        'wild-pathname-p))
300
301(defParameter *filenames*
302  (make-submenu-item "filenames" *filenames-symbol-list*))
303
304;;; ----------------------------------------------------------------------------
305;;;
306(defParameter *files-symbol-list*
307  (list 'delete-file 'directory 'ensure-directories-exist 'file-author 'file-error-pathname 
308        'file-write-date 'probe-file 'rename-file 'truename))
309
310(defParameter *files*
311  (make-submenu-item "files" *files-symbol-list*))
312
313;;; ----------------------------------------------------------------------------
314;;;
315(defParameter *streams-symbol-list*
316  (list 'broadcast-stream-streams 'clear-input 'clear-output 'close 'concatenated-stream-streams 
317        'echo-stream-input-stream 'echo-stream-output-stream 'file-length 'file-position 
318        'file-string-length 'finish-output 'force-output 'fresh-line 'get-output-stream-string 
319        'input-stream-p 'interactive-stream-p 'listen 'make-broadcast-stream 
320        'make-concatenated-stream 'make-echo-stream 'make-string-input-stream 
321        'make-string-output-stream 'make-synonym-stream 'make-two-way-stream 'open 
322        'open-stream-p 'output-stream-p 'peek-char 'read-byte 'read-char 'read-char-no-hang 
323        'read-line 'read-sequence 'stream-element-type 'stream-error-stream 
324        'stream-external-format 'streamp 'synonym-stream-symbol 'terpri 
325        'two-way-stream-input-stream 'two-way-stream-output-stream 'unread-char 
326        'with-input-from-string 'with-open-file 'with-open-stream 'with-output-to-string 
327        'write-byte 'write-char 'write-line 'write-sequence 'write-string 'yes-or-no-p 'y-or-n-p))
328
329(defParameter *streams*
330  (make-submenu-item "streams" *streams-symbol-list*))
331
332;;; ----------------------------------------------------------------------------
333;;;
334(defParameter *printer-symbol-list*
335  (list 'copy-pprint-dispatch 'format 'formatter 'pprint 'pprint-dispatch 
336        'pprint-exit-if-list-exhausted 'pprint-fill 'pprint-indent 'pprint-linear 
337        'pprint-logical-block 'pprint-newline 'pprint-pop 'pprint-tab 'pprint-tabular 'princ 
338        'princ-to-string 'print 'print-object 'print-not-readable-object 'print-unreadable-object 
339        'prin1 'prin1-to-string 'set-pprint-dispatch 'write 'write-to-string))
340
341(defParameter *printer*
342  (make-submenu-item "printer" *printer-symbol-list*))
343
344;;; ----------------------------------------------------------------------------
345;;;
346(defParameter *reader-symbol-list*
347  (list 'copy-readtable 'get-dispatch-macro-character 'get-macro-character 
348        'make-dispatch-macro-character 'read 'read-delimited-list 'read-from-string 
349        'read-preserving-whitespace 'readtable-case 'readtablep 'set-dispatch-macro-character 
350        'set-macro-character 'set-syntax-from-char 'with-standard-io-syntax))
351
352(defParameter *reader*
353  (make-submenu-item "reader" *reader-symbol-list*))
354
355;;; ----------------------------------------------------------------------------
356;;;
357(defParameter *system-construction-symbol-list*
358  (list 'copy-readtable 'get-dispatch-macro-character 'get-macro-character 
359        'make-dispatch-macro-character 'read 'read-delimited-list 'read-from-string 
360        'read-preserving-whitespace 'readtable-case 'readtablep 'set-dispatch-macro-character 
361        'set-macro-character 'set-syntax-from-char 'with-standard-io-syntax))
362
363(defParameter *system-construction*
364  (make-submenu-item "system construction" *system-construction-symbol-list*))
365
366;;; ----------------------------------------------------------------------------
367;;;
368(defParameter *environment-symbol-list*
369  (list 'apropos 'apropos-list 'decode-universal-time 'describe 'describe-object 'disassemble 
370        'documentation 'dribble 'ed 'encode-universal-time 'get-decoded-time 
371        'get-internal-real-time 'get-internal-run-time 'get-universal-time 'inspect 
372        'lisp-implementation-type 'lisp-implementation-version 'long-site-name 'machine-instance 
373        'machine-type 'machine-version 'room 'short-site-name 'sleep 'software-type 
374        'software-version 'step 'time 'trace 'untrace 'user-homedir-pathname))
375
376(defParameter *environment*
377  (make-submenu-item "environment" *environment-symbol-list*))
378
379;;; ----------------------------------------------------------------------------
380;;;
381(defParameter *constants-and-variables-symbol-list*
382  (list 'array-dimension-limit 'array-rank-limit 'array-total-size 'boole-1 '*break-on-signals* 
383        'call-arguments-limit 'char-code-limit '*compile-file-pathname* '*compile-file-truename* 
384        '*compile-print* '*compile-verbose* '*debug-io* '*debugger-hook* 
385        '*default-pathname-defaults* 'short-float-epsilon 'single-float-epsilon 
386        'double-float-epsilon 'long-float-epsilon 'short-float-negative-epsilon 
387        'single-float-negative-epsilon 'double-float-negative-epsilon 
388        'long-float-negative-epsilon '*error-output* '*features* '*gensym-counter* 
389        'internal-time-units-per-second 'lambda-list-keywords 'lambda-parameters-limit 
390        'least-negative-short-float 'least-negative-single-float 'least-negative-double-float 
391        'least-negative-long-float 'least-negative-normalized-short-float 
392        'least-negative-normalized-single-float 'least-negative-normalized-double-float 
393        'least-negative-normalized-long-float 'least-positive-short-float 
394        'least-positive-single-float 'least-positive-double-float 'least-positive-long-float
395        'least-positive-normalized-short-float 'least-positive-normalized-single-float 
396        'least-positive-normalized-double-float 'least-positive-normalized-long-float
397        '*load-pathname* '*load-print* '*load-truename* '*load-verbose* '*macroexpand-hook* 
398        '*modules* 'most-negative-fixnum 'most-negative-short-float 'most-negative-single-float 
399        'most-negative-double-float 'most-negative-long-float 'most-positive-fixnum
400        'most-positive-short-float 'most-positive-single-float 'most-positive-double-float 
401        'most-positive-long-float 'multiple-values-limit 'nil '*package* 'pi '*print-array* 
402        '*print-base* '*print-case* '*print-circle* '*print-escape* '*print-gensym* 
403        '*print-length* '*print-level* '*print-lines* '*print-miser-width* 
404        '*print-pprint-dispatch* '*print-pretty* '*print-radix* '*print-readably* 
405        '*print-right-margin* '*query-io* '*random-state* '*read-base* 
406        '*read-default-float-format* '*read-eval* '*read-suppress* '*readtable* 
407        '*standard-input* '*standard-output* 't '*terminal-io* '*trace-output* 
408        '* '** '*** '+ '++ '+++ '- '/ '// '///))
409
410(defParameter *constants-and-variables*
411  (make-submenu-item "constants and variables" *constants-and-variables-symbol-list*))
412
413;;; ----------------------------------------------------------------------------
414;;;
415(defParameter *type-specifiers-symbol-list*
416  (list 'and 'array 'simple-array 'base-string 'simple-base-string 'bit-vector 'simple-bit-vector 
417        'complex 'cons 'eql 'float 'short-float 'single-float 'double-float 'long-float 'function 
418        'integer 'member 'mod 'not 'or 'rational 'real 'satisfies 'signed-byte 'string 
419        'simple-string 'unsigned-byte 'values 'vector 'simple-vector))
420
421(defParameter *type-specifiers*
422  (make-submenu-item "type specifiers" *type-specifiers-symbol-list*))
423
424;;; ----------------------------------------------------------------------------
425;;;
426(defun add-cl-documentation-submenus (menu)
427  (let ((submenus '(*evaluation-and-compilation* *types-and-classes* 
428                                                 *control-and-data-flow* *iteration* *objects* *structures* 
429                                                 *conditions* *symbols* *packages* *numbers* *characters* 
430                                                 *conses* *arrays* *strings* *sequences* *hash-tables* 
431                                                 *filenames* *files* *streams* *printer* *reader* 
432                                                 *system-construction* *environment* *constants-and-variables* 
433                                                 *type-specifiers*)))
434    (dolist (submenu submenus)
435      (#/addItem: menu (symbol-value submenu)))))
436
437;;; ----------------------------------------------------------------------------
438;;;
439(defParameter *cl-symbol-lists*
440  (list 
441   *evaluation-and-compilation-symbol-list* *types-and-classes-symbol-list* 
442   *control-and-data-flow-symbol-list* *iteration-symbol-list* *objects-symbol-list* 
443   *structures-symbol-list* *conditions-symbol-list* *symbols-symbol-list* *packages-symbol-list* 
444   *numbers-symbol-list* *characters-symbol-list* *conses-symbol-list* *arrays-symbol-list* 
445   *strings-symbol-list* *sequences-symbol-list* *hash-tables-symbol-list* *filenames-symbol-list* 
446   *files-symbol-list* *streams-symbol-list* *printer-symbol-list* *reader-symbol-list* 
447   *system-construction-symbol-list* *environment-symbol-list* 
448   *constants-and-variables-symbol-list* *type-specifiers-symbol-list*))
449
450;;; ----------------------------------------------------------------------------
451;;;
452(defun test-symbol-list (sym-list &optional package)
453  (dolist (sym (rest sym-list))
454    (unless (find-symbol (string-upcase (format nil "~A" sym)) (or package :cl))
455      (format t "~%~A" sym))))
456
457;;; (dolist (list *cl-symbol-lists*) (test-symbol-list list))
458
459(add-cl-documentation-submenus *cl-documentation-menu*)
460
461(defun get-cl-documentation-menu (view event) 
462  (declare (ignore event))
463  (setf (text-view *cl-documentation-menu*) view)
464  *cl-documentation-menu*)
465
466(cmenu:register-tool "CL-Documentation-CM" #'get-cl-documentation-menu)
Note: See TracBrowser for help on using the repository browser.