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
177
178
179
|
;;;;
;;;; help for Euslisp command
;;;;
;;;; 02-Oct-1994 Programmed by H.Nakagaki
;;;; May-1995 port to Solaris by T.Matsui
;;;;
(eval-when (compile eval)
(unless (find-package "HELP")
(make-package "HELP" :nicknames '("HLP"))))
(in-package "HELP")
;; helpsub.o is needed
;;(load "clib/helpsub")
(export '(help help-method load-help))
(defconstant *type-CLASS* 0)
(defconstant *type-METHOD* 1)
(defconstant *type-FUNC* 2)
(defconstant *type-MACRO* 3)
(defconstant *type-CONST* 4)
(defconstant *type-VAR* 5)
(defconstant *type-SPEC* 6)
(defvar *help-hash* nil)
(defvar *method-hash-list*)
(defparameter *eus-tex-dir* (format nil "~a/doc/~a/" *eusdir*
(if (or (substringp "JA" (unix:getenv "LANG"))
(substringp "JP" (unix:getenv "LANG")))
"jlatex" "latex")
))
(defvar *method-list*)
(defclass help-item
:slots (type fname seek count clas mhash))
(defmethod help-item
(:init (typ fna see n &optional (c nil))
(setf type typ)
(setf fname fna)
(setf seek see)
(setf count n)
(if (eq typ *type-METHOD*)
(setf clas c))
(if (eq typ *type-CLASS*)
(progn (setf mhash (make-hash-table :test #'string-equal :rehash-size 1.4))
(setq *method-list* (cons mhash *method-list*))))
)
(:read-help()
(let ((fp (open (make-pathname
:directory (pathname-directory (pathname *eus-tex-dir*))
:name fname :type "tex") :direction :input))
(param1 "")
(param2 "")
(param3 ""))
(flet ((trim-read-tex (file off)
(string-trim (list #\space) (read-tex file off))))
(setf param1 (trim-read-tex fp seek))
(if (> count 2) (setf param2 (trim-read-tex fp -1)))
(if (> count 3) (setf param3 (trim-read-tex fp -1))))
(close fp)
(list param1 param2 param3)))
)
(defun help (&optional (cmd nil)(class nil) (hs t)) ;hs=help stream
(unless *help-hash*
(setq *help-hash*
(make-hash-table :test #'string-equal :size 1000 :rehash-size 1.6))
(load-help (format nil "~a/euslisp.hlp" *eus-tex-dir*)))
(let (param-list item citem)
(setf cmd (format nil "~a" cmd))
(if (or (string-equal cmd "nil") (string-equal cmd "help"))
(help-usage hs)
(if (eq class nil)
(if (eq (aref cmd 0) #\:)
(help-method-list cmd hs)
(if (eq (setf item (gethash cmd *help-hash*)) nil)
(progn (format hs "~a command not found. Commands alike are:~%" cmd)
(pprint (apropos-list cmd) hs))
(progn (format hs "NAME~% ~a~%TYPE~% " cmd)
(setf param-list (send item :read-help))
(case (help-item-type item)
(0 ;*type-CLASS*
(format hs "class~%")
(print-class item param-list hs))
(2 ;*type-FUNC*
(format hs "function~%")
(print-item cmd item param-list hs))
(3 ;*type-MACRO*
(format hs "macro~%")
(print-item cmd item param-list hs))
(4 ;*type-CONST*
(format hs "constant~%")
(print-item2 cmd item param-list hs))
(5 ;*type-VAR*
(format hs "variable~%")
(print-item2 cmd item param-list hs))
(6 ;*type-SPEC*
(format hs "special~%")
(print-item cmd item param-list hs))))))
(if (eq (setf citem (gethash (format nil "~a" class) *help-hash*)) nil)
(format hs "~a class is not found!" class)
(if (eq (setf item (gethash cmd (help-item-mhash citem))) nil)
(format hs "~a method is not found in this class, but super-class may have.~%" cmd)
(progn (format hs "NAME~% ~a~%TYPE~% " cmd)
(format hs "method~%CLASS~% ~a ~%" class)
(setf param-list (send item :read-help))
(print-item cmd item param-list hs))))))))
(defun print-item(cmd item param-list hs)
(format hs "SYNOPSIS~% ~a ~a ~%" cmd (first param-list))
(format hs "DESCRIPTION~% ~a ~%" (second param-list)))
(defun print-item2(cmd item param-list hs)
(format hs "DESCRIPTION~% ~a ~%" (first param-list)))
(defun print-class( item param-list hs)
(format hs "SUPER-CLASS~% ~a ~%" (first param-list))
(format hs "SLOTS~% ~a ~%" (second param-list))
(format hs "DESCRIPTION~% ~a ~%" (third param-list)))
(defun help-method(class hs)
(let (param-list citem method-list name n max)
(if (eq (setf citem (gethash (format nil "~a" class) *help-hash*)) nil)
(format hs "~a class is not found~%" class)
(if (eq (help-item-type citem) *type-CLASS*)
(progn (format hs "CLASS NAME : ~a ~%METHOD-LIST : " class)
(setf method-list (hash-table-key (help-item-mhash citem)))
(dotimes(i (length method-list))
(setf name (aref method-list i))
(if (stringp name)
(format t ";~a~% " name))))
(format hs "~a is not class.~%" class)))))
(defun help-usage(hs)
(format hs "Usage : help &optional cmd class~%~%")
(format hs " cmd is a string that you wan to search. if you want to search method, you must specify class. but if you do not specify class, prints list of class that includes this method.~%"))
(defun help-method-list(cmd hs)
(let (item)
(format hs "This method is defined in classes as follows.~%" )
(dotimes (i (length *method-list*))
(if (not (eq (setq item (gethash cmd (nth i *method-list*))) nil))
(format hs "~a ~a~%" (help-item-clas item) cmd))))))
(defun load-help(helpfile)
(let (fp name type fname seek args class)
(unless *help-hash*
(setq *help-hash*
(make-hash-table :test #'string-equal :size 1000 :rehash-size 1.6)))
; (dotimes(i (length lisp::*load-path*))
; (setq fname (concatenate string (elt lisp::*load-path* i) helpfile))
; (if (probe-file fname) (return)))
(setq fp (open helpfile))
; (setq *eus-tex-dir* (read fp)) *eus-tex-dir* is set by eusrt.l
(read fp) ; 1 read
(loop (setq name (read fp nil))
(if (eq name nil) (return))
(setq type (read fp))
(setq fname (read fp))
(setq seek (read fp))
(setq args (read fp))
(if (eq type *type-CLASS*) (setq class name))
(if (eq type *type-METHOD*)
(sethash name (help-item-mhash (gethash class *help-hash*)) (instance help-item :init type fname seek args class))
(sethash name *help-hash* (instance help-item :init type fname seek args)))
)
(close fp)))
(in-package "USER")
(use-package "HELP")
(provide :eushelp "@(#)$Id$")
|
