Mercurial > hg > xemacs-beta

comparison lisp/hyper-apropos.el @ 1275:57b76886836d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2003-02-08 02:29:52 by ben] fixes to hyper-apropos, menubar-items, text-props, update-elc, lread.c; see log msg in lisp/ChangeLog
author ben
date Sat, 08 Feb 2003 02:29:55 +0000
parents a97af4f94589
children 445bd1969ed0
comparison
equal deleted inserted replaced
1274:2dcc22ec7640 1275:57b76886836d
1 ;;; hyper-apropos.el --- Hypertext emacs lisp documentation interface. 1 ;;; hyper-apropos.el --- Hypertext emacs lisp documentation interface.
2 2
3 ;; Copyright (C) 1997 Free Software Foundation, Inc. 3 ;; Copyright (C) 1997 Free Software Foundation, Inc.
4 ;; Copyright (C) 1994, 1995 Tinker Systems and INS Engineering Corp. 4 ;; Copyright (C) 1994, 1995 Tinker Systems and INS Engineering Corp.
5 ;; Copyright (C) 1995 Sun Microsystems. 5 ;; Copyright (C) 1995 Sun Microsystems.
6 ;; Copyright (C) 1996 Ben Wing. 6 ;; Copyright (C) 1996, 2003 Ben Wing.
7 7
8 ;; Author: Jonathan Stigelman <stig@xemacs.org> 8 ;; Author: Jonathan Stigelman <stig@xemacs.org>
9 ;; Maintainer: XEmacs Development Team 9 ;; Maintainer: XEmacs Development Team
10 ;; Keywords: lisp, tools, help, docs, matching 10 ;; Keywords: lisp, tools, help, docs, matching
11 11
294 'hyper-apropos-documentation) 294 'hyper-apropos-documentation)
295 (insert-face "\ 295 (insert-face "\
296 a = autoloaded, b = byte-compiled, i = internal, l = lambda, m = macro.\n\n" 296 a = autoloaded, b = byte-compiled, i = internal, l = lambda, m = macro.\n\n"
297 'hyper-apropos-documentation) 297 'hyper-apropos-documentation)
298 (insert-face "Functions and Macros:\n\n" 'hyper-apropos-major-heading) 298 (insert-face "Functions and Macros:\n\n" 'hyper-apropos-major-heading)
299 (hyper-apropos-grok-functions flist) 299 (hyper-apropos-grok-functions flist nil)
300 (insert-face "\n\nObsolete Functions and Macros:\n\n" 'hyper-apropos-major-heading)
301 (hyper-apropos-grok-functions flist t)
300 (insert-face "\n\nVariables and Constants:\n\n" 302 (insert-face "\n\nVariables and Constants:\n\n"
301 'hyper-apropos-major-heading) 303 'hyper-apropos-major-heading)
302 (hyper-apropos-grok-variables vlist) 304 (hyper-apropos-grok-variables vlist nil)
305 (insert-face "\n\nObsolete Variables and Constants:\n\n"
306 'hyper-apropos-major-heading)
307 (hyper-apropos-grok-variables vlist t)
303 (goto-char (point-min)))) 308 (goto-char (point-min))))
304 (switch-to-buffer hyper-apropos-apropos-buf) 309 (switch-to-buffer hyper-apropos-apropos-buf)
305 (hyper-apropos-mode regexp)) 310 (hyper-apropos-mode regexp))
306 311
307 (defun hyper-apropos-toggle-programming-flag () 312 (defun hyper-apropos-toggle-programming-flag ()
310 (set (make-local-variable 'hyper-apropos-programming-apropos) 315 (set (make-local-variable 'hyper-apropos-programming-apropos)
311 (not hyper-apropos-programming-apropos))) 316 (not hyper-apropos-programming-apropos)))
312 (message "Re-running apropos...") 317 (message "Re-running apropos...")
313 (hyper-apropos hyper-apropos-last-regexp nil)) 318 (hyper-apropos hyper-apropos-last-regexp nil))
314 319
315 (defun hyper-apropos-grok-functions (fns) 320 (defun hyper-apropos-grok-functions (fns obsolete-p)
316 (let (bind doc type) 321 (loop for fn in fns
317 (dolist (fn fns) 322 if (eq (function-obsolete-p fn) obsolete-p) do
318 (setq bind (symbol-function fn) 323 (let* ((bind (symbol-function fn))
319 type (cond ((subrp bind) ?i) 324 (type (cond ((subrp bind) ?i)
320 ((compiled-function-p bind) ?b) 325 ((compiled-function-p bind) ?b)
321 ((consp bind) (or (cdr 326 ((consp bind) (or (cdr
322 (assq (car bind) '((autoload . ?a) 327 (assq (car bind) '((autoload . ?a)
323 (lambda . ?l) 328 (lambda . ?l)
324 (macro . ?m)))) 329 (macro . ?m))))
325 ??)) 330 ??))
326 (t ?\ ))) 331 (t ?\ ))))
327 (insert type (if (commandp fn) "* " " ")) 332 (insert type (if (commandp fn) "* " " "))
328 (let ((e (insert-face (format "%S" fn) 'hyper-apropos-hyperlink))) 333 (let ((e (insert-face (format "%S" fn) 'hyper-apropos-hyperlink)))
329 (set-extent-property e 'mouse-face 'highlight)) 334 (set-extent-property e 'mouse-face 'highlight))
330 (insert-char ?\ (let ((l (- 30 (length (format "%S" fn))))) 335 (insert-char ?\ (let ((l (- 30 (length (format "%S" fn)))))
331 (if (natnump l) l 0))) 336 (if (natnump l) l 0)))
332 (and hyper-apropos-show-brief-docs 337 (and hyper-apropos-show-brief-docs
333 (setq doc 338 (let ((doc
334 ;; A symbol's function slot can point to an unbound symbol. 339 (if (and obsolete-p
335 ;; In that case, `documentation' will fail. 340 (symbolp fn)
336 (ignore-errors 341 (symbolp (symbol-function fn)))
337 (documentation fn))) 342 (function-obsoleteness-doc fn)
338 (if (string-match 343 ;; A symbol's function slot can point to an unbound symbol.
339 "^([^\n\t )]+[\t ]*\\([^\n)]+\\)?)\\(:[\t ]*\\|\n?\\'\\)" 344 ;; In that case, `documentation' will fail.
340 doc) 345 (ignore-errors
341 (setq doc (substring doc (match-end 0) (string-match "\n" doc))) 346 (documentation fn)))))
342 t) 347 (if (and
343 (insert-face (if doc 348 doc
344 (concat " - " 349 (string-match
345 (substring doc 0 (string-match "\n" doc))) 350 "\\`([^\n\t )]+[\t ]*\\([^\n)]+\\)?)\\(:[\t ]*\\|\n?\\'\\)"
346 " Not documented.") 351 doc))
347 'hyper-apropos-documentation)) 352 (setq doc (substring doc (match-end 0)
353 (string-match "\n" doc))))
354 ;; Skip errant newlines at beginning of doc
355 (if (and doc
356 (string-match "\\`\n+" doc))
357 (setq doc (substring doc (match-end 0))))
358 (insert-face (if doc
359 (concat " - "
360 (substring doc 0
361 (string-match "\n" doc)))
362 " - Not documented.")
363 'hyper-apropos-documentation)))
348 (insert ?\n)))) 364 (insert ?\n))))
349 365
350 (defun hyper-apropos-grok-variables (vars) 366 (defun hyper-apropos-grok-variables (vars obsolete-p)
351 (let (doc userp) 367 (loop for var in vars
352 (dolist (var vars) 368 if (eq (variable-obsolete-p var) obsolete-p) do
353 (setq userp (user-variable-p var)) 369 (let ((userp (user-variable-p var)))
354 (insert (if userp " * " " ")) 370 (insert (if userp " * " " "))
355 (let ((e (insert-face (format "%S" var) 'hyper-apropos-hyperlink))) 371 (let ((e (insert-face (format "%S" var) 'hyper-apropos-hyperlink)))
356 (set-extent-property e 'mouse-face 'highlight)) 372 (set-extent-property e 'mouse-face 'highlight))
357 (insert-char ?\ (let ((l (- 30 (length (format "%S" var))))) 373 (insert-char ?\ (let ((l (- 30 (length (format "%S" var)))))
358 (if (natnump l) l 0))) 374 (if (natnump l) l 0)))
359 (and hyper-apropos-show-brief-docs 375 (and hyper-apropos-show-brief-docs
360 (setq doc (documentation-property var 'variable-documentation)) 376 (let ((doc
361 (insert-face (if doc 377 (if (and obsolete-p (variable-alias var))
362 (concat " - " (substring doc (if userp 1 0) 378 (variable-obsoleteness-doc var)
363 (string-match "\n" doc))) 379 (documentation-property var 'variable-documentation))))
364 " - Not documented.") 380 ;; Skip errant newlines at beginning of doc
365 'hyper-apropos-documentation)) 381 (if (and doc
382 (string-match "\\`\n+" doc))
383 (setq doc (substring doc (match-end 0))))
384 (insert-face (if doc
385 (concat " - " (substring
386 doc (if userp 1 0)
387 (string-match "\n" doc)))
388 " - Not documented.")
389 'hyper-apropos-documentation)))
366 (insert ?\n)))) 390 (insert ?\n))))
367 391
368 ;; ---------------------------------------------------------------------- ;; 392 ;; ---------------------------------------------------------------------- ;;
369 393
370 (defun hyper-apropos-mode (regexp) 394 (defun hyper-apropos-mode (regexp)