![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to clman.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / dist-1.3 / fi|
Return to clman.el CVS log | Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / dist-1.3 / fi |
1.1 root 1: ;;
2: ;; copyright (C) 1987, 1988 Franz Inc, Berkeley, Ca.
3: ;;
4: ;; The software, data and information contained herein are the property
5: ;; of Franz, Inc.
6: ;;
7: ;; This file (or any derivation of it) may be distributed without
8: ;; further permission from Franz Inc. as long as:
9: ;;
10: ;; * it is not part of a product for sale,
11: ;; * no charge is made for the distribution, other than a tape
12: ;; fee, and
13: ;; * all copyright notices and this notice are preserved.
14: ;;
15: ;; If you have any comments or questions on this interface, please feel
16: ;; free to contact Franz Inc. at
17: ;; Franz Inc.
18: ;; Attn: Kevin Layer
19: ;; 1995 University Ave
20: ;; Suite 275
21: ;; Berkeley, CA 94704
22: ;; (415) 548-3600
23: ;; or
24: ;; emacs-info%[email protected]
25: ;; ucbvax!franz!emacs-info
26:
27: ;; $Header: clman.el,v 1.4 89/02/15 23:19:01 layer Exp $
28:
29: (defconst clman:doc-directory
30: (let ((p load-path)
31: (string "fi/manual/")
32: (done nil) res)
33: (while (and (not done) p)
34: (if (file-exists-p (setq res (concat (car p) "/" string)))
35: (setq done t)
36: (setq res nil))
37: (setq p (cdr p)))
38: res))
39:
40: (defconst clman:package-info
41: (list
42: (list "xcw-pilot"
43: (concat clman:doc-directory "winman/pages/x-specific/new-pilot/"))
44: (list "xcw" (concat clman:doc-directory "winman/pages/x-specific/"))
45: (list "cw" (concat clman:doc-directory "winman/pages/"))
46: (list "math" (concat clman:doc-directory "mathpack/pages/"))
47: (list "lisp" (concat clman:doc-directory "refman/pages/"))))
48:
49: (if (not (boundp 'clman::oblist)) (load "fi/clman-oblist.el"))
50:
51: (defvar clman:mode-map nil)
52:
53: (defvar clman:displaying-function 'clman:find-file
54: "This function will be funcalled with two arguments, the .doc file to be
55: displayed, and the buffer which is the value of clman:displaying-buffer.
56: If you wish, you can set this variable to your own displaying function.")
57:
58: (defvar clman:displaying-buffer "*CLMan*"
59: "Either nil or a string naming the buffer that the system will use for
60: displaying documentation pages. If nil, then the system will not try to
61: reuse the same buffer.")
62:
63: (defvar clman::window-configuration nil)
64:
65: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
66: ;;;; Interactive Functions
67: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
68:
69: (defun fi:clman (&optional symbol)
70: (interactive)
71: (setq clman::window-configuration (current-window-configuration))
72: (let* ((temp-info clman:package-info)(package nil)
73: (doc-page nil)(syn nil)
74: (done nil))
75: (setq sym (or symbol (clman::get-sym-to-lookup)))
76: (while (not done)
77: (setq package (car temp-info))
78: (if (not package)
79: (progn (setq done t)
80: (message "Couldn't find the doc page for %s " sym))
81: (progn
82: (setq doc-page
83: (concat (car (cdr package))
84: (clman::file-nameify sym))))
85: (if (file-exists-p doc-page)
86: (progn
87: (setq done t)
88: (clman::display-file doc-page clman:displaying-buffer))
89: (setq temp-info (cdr temp-info)))))))
90:
91: (defun fi:clman-apropos ()
92: (interactive)
93: (let* ((oblist-buffer-name "*clman-oblist*")
94: (oblist-buffer (get-buffer-create oblist-buffer-name))
95: (string (read-string "clman apropos: ")))
96: (set-buffer oblist-buffer)
97: (let ((done nil) (lis clman::oblist))
98: (while (not done)
99: (insert-string (car (car lis)))
100: (newline 1)
101: (setq lis (cdr lis))
102: (if (null lis) (setq done t))))
103: (beginning-of-buffer)
104: (with-output-to-temp-buffer "*clman-apropos*"
105: (while (re-search-forward string nil t)
106: (beginning-of-line)
107: (princ (buffer-substring (point) (progn (end-of-line) (point))))
108: (terpri)
109: (forward-line 1)))
110: (fi:clman-mode)
111:
112: ;;why was the following here?
113: ;;(beginning-of-buffer)
114: ;;(replace-string "\"" "")
115: ;;(beginning-of-buffer)
116: ;;(replace-string "(" "")
117: ;;(beginning-of-buffer)
118: ;;(replace-string ")" "")
119: ;;(beginning-of-buffer)
120: ;;(while (search-forward "if assoc" nil t)
121: ;; (beginning-of-line)
122: ;; (kill-line 1))
123: ;;(beginning-of-buffer)
124: ))
125:
126: (defun fi:clman-mode ()
127: "Major mode for getting around
128: Like Text Mode but with these additional comands:\n\\{clman:mode-map}\n"
129: (interactive)
130: (set-syntax-table text-mode-syntax-table)
131: (use-local-map clman:mode-map)
132: (setq local-abbrev-table text-mode-abbrev-table)
133: (setq major-mode 'fi:clman-mode)
134: (setq mode-name "CLMAN")
135: (run-hooks 'text-mode-hook))
136:
137: (defun clman:search-forward-see-alsos ()
138: (interactive)
139: (if (search-forward "SEE ALSO" nil t)
140: (beginning-of-line)
141: (if (search-backward "SEE ALSO" nil t)
142: (beginning-of-line))))
143:
144: (defun clman:flush-doc ()
145: (interactive)
146: (kill-buffer (current-buffer))
147: (set-window-configuration clman::window-configuration))
148:
149: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
150: ;;;; Internal stuff
151: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
152:
153: (defun clman::get-sym-to-lookup ()
154: (interactive)
155: (let* ((str nil)(sym nil)(ans nil))
156: ;; make sure we have a symbol table
157: ;; get a symbol to look up, if the user did not provide one
158: (setq str (clman::backward-copy-sexp-as-kill))
159: (setq sym (if (or (string= str "")
160: (string= (substring str 0 1) "(")
161: (string= (substring str 0 1) "."))
162: nil (read-from-string str)))
163: (if (listp (car sym))(setq str nil))
164:
165: (setq ans (completing-read
166: (concat "Symbol (" str "): ") clman::oblist))
167: (if (string= ans "")(setq ans str))
168: (setq ans (clman::strip-leading-package-name ans))
169: ans))
170:
171: (defun clman::strip-leading-package-name (str)
172: (interactive)
173: (let ((pos (string-match ":" str)))
174: (if (and pos (not (= pos 0)))
175: (substring str (+ 1 pos) (length str))
176: str)))
177:
178: (defun clman::retrieve-doc-page (str table doc-dir)
179: "Retrieve the documentation page for the string argument, which is
180: the name of a symbol that we want to look up. If the symbol is
181: not found, you will be prompted for an alternate package. If you just
182: hit return, this function returns nil."
183: (let ((name
184: (clman::man-page-lookup str table doc-dir)))
185: ;; name is the full pathname of the doc page we want
186: (bury-buffer)
187: (if name name nil)))
188:
189: (defun clman::display-file (name buf)
190: "Display name, which is an clman .doc file according to a displaying style.
191: The displaying style is the value of the global var clman:displaying-function.
192: The two built in displaying functions are 'clman:view-file, which uses 'view,
193: and clman:find-file, which inserts the .doc file into the buffer named
194: by the value of the variable clman:displaying-buffer"
195: ;; If buf is non-nil then we want to reuse the displaying buffer,
196: ;; so have to erase it first
197: (if buf
198: (if (get-buffer buf)
199: (save-excursion
200: (switch-to-buffer buf)
201: (erase-buffer))))
202: (funcall clman:displaying-function name buf)
203: (fi:clman-mode))
204:
205: (defun clman:view-file (name buf)
206: "A built-in function that you may use for the value of
207: clman:displaying-function. This function uses the function 'view-file."
208: (view-file name))
209:
210: (defun clman:find-file (name buf)
211: "A built-in function that you may use for the value of
212: clman:displaying-function. This function uses the function 'insert-file to
213: insert the file that is named by the first argument into the buffer named
214: by the second argument."
215: (if (not (string= buf (buffer-name(current-buffer))))
216: (switch-to-buffer-other-window buf))
217: (insert-file name))
218:
219: (defun clman::man-page-lookup (str table doc-dir)
220: "Lookup a string in the filename/symbol table. The system used the
221: buffer which is named by the third element in clman-current-package-info.
222: Return the full pathname of the file the symbol is in. "
223: (interactive)
224: (switch-to-buffer table)
225: (let ((buf (current-buffer))
226: (new-str (concat " " str " "))
227: (success nil))
228: (beginning-of-buffer)
229: (setq success (search-forward new-str (point-max) t))
230: (if (not success)
231: nil
232: (beginning-of-line)
233: (setq begin (point))
234: (search-forward " ")
235: (backward-char)
236: (concat doc-dir "/" (buffer-substring begin (point))))))
237:
238: (defun clman::backward-copy-sexp-as-kill ()
239: "Low level function."
240: (backward-sexp)
241: (let* ((begin (point)) end sym)
242: (forward-sexp)
243: (clman::remove-chars-from-string '(?\ ?\n)
244: (buffer-substring begin (point)))))
245:
246: (defun clman::escape-funny-chars (sym)
247: ;; the shell requires that certain chars be preceded by \
248: ;; and that entire command be surrounded by ' '
249: (let ((temp sym)
250: (star "*")
251: (circumflex "^")
252: (dollar "$")
253: (result "")
254: (leftbrack "\[")
255: (rightbrack "\]")
256: (quote "'")
257: (backquote "`")
258: (counter 1))
259: (while (not (string= temp ""))
260: (setq ch (substring temp 0 1))
261: (if (or (string= ch star)
262: (string= ch circumflex)
263: (string= ch dollar)
264: (string= ch leftbrack)
265: (string= ch rightbrack)
266: (string= ch quote)
267: (string= ch backquote))
268: (setq result (concat result "\\" ch))
269: (setq result (concat result ch)))
270: (setq temp (substring temp 1)))
271: (setq result (concat "\"" result "\""))))
272:
273: (defun clman::sub-chars-in-string (char-assoc-list string)
274: "Substitute character pairs of CHAR-ASSOC-LIST in STRING."
275: (let (pair)
276: (mapconcat '(lambda (char)
277: (if (setq pair (assq char char-assoc-list))
278: (char-to-string (cdr pair))
279: (char-to-string char)))
280: string
281: nil)))
282:
283: (defun clman::remove-chars-from-string (char-list string)
284: "Remove characters in CHAR-LIST from string STRING and return the result."
285: (mapconcat '(lambda (char)
286: (if (memq char char-list)
287: nil
288: (char-to-string char)))
289: string
290: nil))
291:
292: (defun clman::file-nameify (str)
293: (let ((result
294: (clman::sub-chars-in-string '((?* . ?S)(?~ . ?T)
295: (?< . ?L)(?> . ?G)
296: (?/ . ?D)(?& . ?A) (?: . ?C)
297: (?= . ?E)(?\\ . ?B)
298: (?$ . ?d)(?% . ?p)
299: (?\? . ?Q) (?\( . ?o)
300: (?\) . ?c)(?| . ?V)
301: (?^ . ?K)(?\[ . ?b)
302: (?\' . ?q)(?\" . ?Z)
303: (?\# . ?h)(?\` . ?b)
304: (?\; . ?s)(?- . ?H)
305: (?, . ?k)(?+ . ?a)(?\. . ?e)(?\ . ?B)
306: )
307: str)))
308: ;; (setq result (clman::remove-chars-from-string
309: ;; '(?\ ) result))
310: (concat result ".doc")))
311:
312: (if clman:mode-map
313: nil
314: (setq clman:mode-map (make-sparse-keymap))
315: (define-key clman:mode-map "\C-C\C-C" 'clman:flush-doc)
316: (define-key clman:mode-map "a" 'fi:clman-apropos)
317: (define-key clman:mode-map "m" 'fi:clman)
318: (define-key clman:mode-map "s" 'clman:search-forward-see-alsos))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.