Mercurial > hg > xemacs-beta
comparison lisp/hyper-apropos.el @ 5173:bd1e25975cdc
Use #'function-arglist, etc. from help.el, not reimplementing them, hyper-apropos
2010-03-29 Aidan Kehoe <kehoea@parhasard.net>
* hyper-apropos.el (hyper-apropos-get-doc):
Use help.el's #'function-arglist, #'function-documentation,
#'symbol-file in this function, instead of rolling our own.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Mon, 29 Mar 2010 18:49:33 +0100 |
| parents | fee33ab25966 |
| children | fa5d6416887f |
comparison
equal
deleted
inserted
replaced
| 5172:be6e5ea38dda | 5173:bd1e25975cdc |
|---|---|
| 728 ok beg | 728 ok beg |
| 729 newsym symtype doc obsolete | 729 newsym symtype doc obsolete |
| 730 (local mode-name) | 730 (local mode-name) |
| 731 global local-str global-str | 731 global local-str global-str |
| 732 font fore back undl | 732 font fore back undl |
| 733 aliases alias-desc desc) | 733 aliases alias-desc desc arglist) |
| 734 (save-excursion | 734 (save-excursion |
| 735 (set-buffer (get-buffer-create hyper-apropos-help-buf)) | 735 (set-buffer (get-buffer-create hyper-apropos-help-buf)) |
| 736 ;;(setq standard-output (current-buffer)) | 736 ;;(setq standard-output (current-buffer)) |
| 737 (setq buffer-read-only nil) | 737 (setq buffer-read-only nil) |
| 738 (erase-buffer) | 738 (erase-buffer) |
| 762 (cdr (assq symtype | 762 (cdr (assq symtype |
| 763 '((subr . "built-in ") | 763 '((subr . "built-in ") |
| 764 (bytecode . "compiled Lisp ") | 764 (bytecode . "compiled Lisp ") |
| 765 (autoload . "autoloaded Lisp ") | 765 (autoload . "autoloaded Lisp ") |
| 766 (lambda . "Lisp ")))) | 766 (lambda . "Lisp ")))) |
| 767 desc | 767 desc ",\n(loaded from \"" |
| 768 (case symtype | 768 (or (symbol-file symbol 'defun) |
| 769 ((autoload) (format ",\n(autoloaded from \"%s\")" | 769 "[no file information available]") |
| 770 (nth 1 newsym))) | 770 "\")") |
| 771 ((bytecode) (format ",\n(loaded from \"%s\")" | |
| 772 (symbol-file symbol))))) | |
| 773 local (current-local-map) | 771 local (current-local-map) |
| 774 global (current-global-map) | 772 global (current-global-map) |
| 775 obsolete (get symbol 'byte-obsolete-info) | 773 obsolete (get symbol 'byte-obsolete-info) |
| 776 doc (or (condition-case nil | 774 doc (function-documentation symbol t) |
| 777 (documentation symbol) | 775 arglist (replace-in-string |
| 778 (void-function | 776 (function-arglist symbol) |
| 779 "(alias for undefined function)") | 777 (format "^(%s " |
| 780 (error "(unexpected error from `documention')")) | 778 (regexp-quote (symbol-name symbol))) |
| 781 "function not documented")) | 779 "(")) |
| 782 (save-excursion | 780 (save-excursion |
| 783 (set-buffer hyper-apropos-help-buf) | 781 (set-buffer hyper-apropos-help-buf) |
| 784 (goto-char (point-max)) | 782 (goto-char (point-max)) |
| 785 (setq standard-output (current-buffer)) | 783 (setq standard-output (current-buffer)) |
| 786 (hyper-apropos-insert-section-heading alias-desc desc) | 784 (hyper-apropos-insert-section-heading alias-desc desc) |
| 800 (car obsolete) | 798 (car obsolete) |
| 801 (format "use `%s' instead." (car obsolete)))) | 799 (format "use `%s' instead." (car obsolete)))) |
| 802 'hyper-apropos-warning)) | 800 'hyper-apropos-warning)) |
| 803 (setq beg (point)) | 801 (setq beg (point)) |
| 804 (insert-face "arguments: " 'hyper-apropos-heading) | 802 (insert-face "arguments: " 'hyper-apropos-heading) |
| 805 (cond ((eq symtype 'lambda) | 803 (princ arglist) |
| 806 (princ (or (nth 1 newsym) "()"))) | |
| 807 ((eq symtype 'bytecode) | |
| 808 (princ (or (compiled-function-arglist newsym) | |
| 809 "()"))) | |
| 810 ((and (or (eq symtype 'subr) (eq symtype 'autoload)) | |
| 811 (string-match | |
| 812 "[\n\t ]*\narguments: ?(\\([^)]*\\))\n?\\'" | |
| 813 doc)) | |
| 814 (insert (substring doc | |
| 815 (match-beginning 1) | |
| 816 (match-end 1))) | |
| 817 (setq doc (substring doc 0 (match-beginning 0)))) | |
| 818 ((and (eq symtype 'subr) | |
| 819 (string-match | |
| 820 "\ | |
| 821 \[\n\t ]*([^\n\t )]+[\t ]*\\([^\n)]+\\)?)\\(:[\t ]*\\|\n?\\'\\)" | |
| 822 doc)) | |
| 823 (insert "(" | |
| 824 (if (match-end 1) | |
| 825 (substring doc | |
| 826 (match-beginning 1) | |
| 827 (match-end 1))) | |
| 828 ")") | |
| 829 (setq doc (substring doc (match-end 0)))) | |
| 830 (t (princ "[not available]"))) | |
| 831 (insert "\n\n") | 804 (insert "\n\n") |
| 832 (hyper-apropos-insert-face doc) | 805 (hyper-apropos-insert-face doc) |
| 833 (insert "\n") | 806 (insert "\n") |
| 834 (indent-rigidly beg (point) 2)))) | 807 (indent-rigidly beg (point) 2)))) |
| 835 ;; variable ---------------------------------------------------------- | 808 ;; variable ---------------------------------------------------------- |
| 942 (and (memq 'face type) | 915 (and (memq 'face type) |
| 943 (find-face symbol) | 916 (find-face symbol) |
| 944 (progn | 917 (progn |
| 945 (setq ok t) | 918 (setq ok t) |
| 946 (copy-face symbol 'hyper-apropos-temp-face 'global) | 919 (copy-face symbol 'hyper-apropos-temp-face 'global) |
| 947 (mapcar #'(lambda (property) | 920 (mapc #'(lambda (property) |
| 948 (setq symtype (face-property-instance symbol | 921 (setq symtype (face-property-instance symbol |
| 949 property)) | 922 property)) |
| 950 (if symtype | 923 (if symtype |
| 951 (set-face-property 'hyper-apropos-temp-face | 924 (set-face-property 'hyper-apropos-temp-face |
| 952 property | 925 property |
| 953 symtype))) | 926 symtype))) |
| 954 built-in-face-specifiers) | 927 built-in-face-specifiers) |
| 955 (setq font (cons (face-property-instance symbol 'font nil 0 t) | 928 (setq font (cons (face-property-instance symbol 'font nil 0 t) |
| 956 (face-property-instance symbol 'font)) | 929 (face-property-instance symbol 'font)) |
| 957 fore (cons (face-foreground-instance symbol nil 0 t) | 930 fore (cons (face-foreground-instance symbol nil 0 t) |
| 958 (face-foreground-instance symbol)) | 931 (face-foreground-instance symbol)) |
| 959 back (cons (face-background-instance symbol nil 0 t) | 932 back (cons (face-background-instance symbol nil 0 t) |