Mercurial > hg > xemacs-beta

comparison lisp/hyper-apropos.el @ 219:262b8bb4a523 r20-4b8

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-4b8
author cvs
date Mon, 13 Aug 2007 10:09:35 +0200
parents d44af0c54775
children 41f2f0e326e9
comparison
equal deleted inserted replaced
218:c9f226976f56 219:262b8bb4a523
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) 1994, 1995 Tinker Systems and INS Engineering Corp. 4 ;; Copyright (C) 1994, 1995 Tinker Systems and INS Engineering Corp.
4 ;; Copyright (C) 1995 Sun Microsystems. 5 ;; Copyright (C) 1995 Sun Microsystems.
5 ;; Copyright (C) 1996 Ben Wing. 6 ;; Copyright (C) 1996 Ben Wing.
6 7
7 ;; Maintainer: Jonathan Stigelman <Stig@hackvan.com> 8 ;; Maintainer: Jonathan Stigelman <Stig@hackvan.com>
60 ;; ### The maintainer is supposed to be stig, but I haven't seen him 61 ;; ### The maintainer is supposed to be stig, but I haven't seen him
61 ;; around for ages. The real maintainer for the moment is Hrvoje 62 ;; around for ages. The real maintainer for the moment is Hrvoje
62 ;; Niksic <hniksic@srce.hr>. 63 ;; Niksic <hniksic@srce.hr>.
63 64
64 ;;; Code: 65 ;;; Code:
65
66 (require 'pp)
67 66
68 (defgroup hyper-apropos nil 67 (defgroup hyper-apropos nil
69 "Hypertext emacs lisp documentation interface." 68 "Hypertext emacs lisp documentation interface."
70 :group 'docs 69 :group 'docs
71 :group 'lisp 70 :group 'lisp
863 (progn 862 (progn
864 (newline 3) (delete-blank-lines) (newline 1) 863 (newline 3) (delete-blank-lines) (newline 1)
865 (insert-face "value: " 'hyper-apropos-heading) 864 (insert-face "value: " 'hyper-apropos-heading)
866 (if hyper-apropos-prettyprint-long-values 865 (if hyper-apropos-prettyprint-long-values
867 (condition-case nil 866 (condition-case nil
868 (let ((pp-print-readably nil)) (pprint local)) 867 (cl-prettyprint local)
869 (error (insert local-str))) 868 (error (insert local-str)))
870 (insert local-str)))) 869 (insert local-str))))
871 (if global-str 870 (if global-str
872 (progn 871 (progn
873 (newline 3) (delete-blank-lines) (newline 1) 872 (newline 3) (delete-blank-lines) (newline 1)
874 (insert-face "default value: " 'hyper-apropos-heading) 873 (insert-face "default value: " 'hyper-apropos-heading)
875 (if hyper-apropos-prettyprint-long-values 874 (if hyper-apropos-prettyprint-long-values
876 (condition-case nil 875 (condition-case nil
877 (let ((pp-print-readably nil)) (pprint global)) 876 (cl-prettyprint global)
878 (error (insert global-str))) 877 (error (insert global-str)))
879 (insert global-str))))) 878 (insert global-str)))))
880 (indent-rigidly beg (point) 2)))) 879 (indent-rigidly beg (point) 2))))
881 ;; face -------------------------------------------------------------- 880 ;; face --------------------------------------------------------------
882 (and (memq 'face type) 881 (and (memq 'face type)
1244 (goto-char (point-min)) 1243 (goto-char (point-min))
1245 (forward-sexp 2) 1244 (forward-sexp 2)
1246 (insert (format " for function `%S'" sym)) 1245 (insert (format " for function `%S'" sym))
1247 ) 1246 )
1248 ((consp fun) 1247 ((consp fun)
1249 (with-output-to-temp-buffer "*Disassemble*" 1248 (with-current-buffer "*Disassemble*"
1250 (pprint (if macrop 1249 (cl-prettyprint (if macrop
1251 (cons 'defmacro (cons sym (cdr (cdr fun)))) 1250 (cons 'defmacro (cons sym (cdr (cdr fun))))
1252 (cons 'defun (cons sym (cdr fun)))))) 1251 (cons 'defun (cons sym (cdr fun))))))
1253 (set-buffer "*Disassemble*") 1252 (set-buffer "*Disassemble*")
1254 (emacs-lisp-mode)) 1253 (emacs-lisp-mode))
1255 ((or (vectorp fun) (stringp fun)) 1254 ((or (vectorp fun) (stringp fun))
1256 ;; #### - do something fancy here 1255 ;; #### - do something fancy here
1257 (with-output-to-temp-buffer "*Disassemble*" 1256 (with-output-to-temp-buffer "*Disassemble*"