Mercurial > hg > xemacs-beta

comparison lisp/prim/help.el @ 197:acd284d43ca1 r20-3b25

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b25
author cvs
date Mon, 13 Aug 2007 10:00:02 +0200
parents a2f645c6b9f8
children 850242ba4a81
comparison
equal deleted inserted replaced
196:58e0786448ca 197:acd284d43ca1
886 ;(gettext "an interactive autoloaded Lisp macro") 886 ;(gettext "an interactive autoloaded Lisp macro")
887 887
888 (defun describe-function-1 (function stream &optional nodoc) 888 (defun describe-function-1 (function stream &optional nodoc)
889 (princ (format "`%S' is " function) stream) 889 (princ (format "`%S' is " function) stream)
890 (let* ((def function) 890 (let* ((def function)
891 file-name
892 (doc (condition-case nil 891 (doc (condition-case nil
893 (or (documentation function) 892 (or (documentation function)
894 (gettext "not documented")) 893 (gettext "not documented"))
895 (void-function ""))) 894 (void-function "")))
896 aliases home kbd-macro-p fndef macrop) 895 aliases file-name autoload-file kbd-macro-p fndef macrop)
897 (while (and (symbolp def) (fboundp def)) 896 (while (and (symbolp def) (fboundp def))
898 (when (not (eq def function)) 897 (when (not (eq def function))
899 (setq aliases 898 (setq aliases
900 (if aliases 899 (if aliases
901 ;; I18N3 Need gettext due to concat 900 ;; I18N3 Need gettext due to concat
904 "\n which is an alias for `%s', " 903 "\n which is an alias for `%s', "
905 (symbol-name def))) 904 (symbol-name def)))
906 (format "an alias for `%s', " (symbol-name def))))) 905 (format "an alias for `%s', " (symbol-name def)))))
907 (setq def (symbol-function def))) 906 (setq def (symbol-function def)))
908 (if (compiled-function-p def) 907 (if (compiled-function-p def)
909 (setq home (compiled-function-annotation def))) 908 (setq file-name (compiled-function-annotation def)))
910 (if (eq 'macro (car-safe def)) 909 (if (eq 'macro (car-safe def))
911 (setq fndef (cdr def) 910 (setq fndef (cdr def)
911 home (and (compiled-function-p (cdr def))
912 (compiled-function-annotation (cdr def)))
912 macrop t) 913 macrop t)
913 (setq fndef def)) 914 (setq fndef def))
914 (if aliases (princ aliases stream)) 915 (if aliases (princ aliases stream))
915 (let ((int #'(lambda (string an-p macro-p) 916 (let ((int #'(lambda (string an-p macro-p)
916 (princ (format 917 (princ (format
937 ((eq (car-safe fndef) 'lambda) 938 ((eq (car-safe fndef) 'lambda)
938 (funcall int "Lisp" nil macrop)) 939 (funcall int "Lisp" nil macrop))
939 ((eq (car-safe fndef) 'mocklisp) 940 ((eq (car-safe fndef) 'mocklisp)
940 (funcall int "mocklisp" nil macrop)) 941 (funcall int "mocklisp" nil macrop))
941 ((eq (car-safe def) 'autoload) 942 ((eq (car-safe def) 'autoload)
942 (setq file-name (elt def 1)) 943 (setq autoload-file (elt def 1))
943 (funcall int "autoloaded Lisp" t (elt def 4))) 944 (funcall int "autoloaded Lisp" t (elt def 4)))
944 ((and (symbolp def) (not (fboundp def))) 945 ((and (symbolp def) (not (fboundp def)))
945 (princ "a symbol with a void (unbound) function definition." stream)) 946 (princ "a symbol with a void (unbound) function definition." stream))
946 (t 947 (t
947 nil))) 948 nil)))
948 (princ "\n") 949 (princ "\n")
950 (if autoload-file
951 (princ (format " -- autoloads from \"%s\"\n" autoload-file) stream))
949 (or file-name 952 (or file-name
950 (setq file-name (describe-function-find-file function))) 953 (setq file-name (describe-function-find-file function)))
951 (if file-name 954 (if file-name
952 (princ (format " -- loads from \"%s\"\n" file-name) stream)) 955 (princ (format " -- loaded from \"%s\"\n" file-name)) stream)
953 (if home
954 (princ (format " -- loaded from \"%s\"\n" home)) stream)
955 ;; (terpri stream) 956 ;; (terpri stream)
956 (if describe-function-show-arglist 957 (if describe-function-show-arglist
957 (let ((arglist 958 (let ((arglist
958 (cond ((compiled-function-p fndef) 959 (cond ((compiled-function-p fndef)
959 (compiled-function-arglist fndef)) 960 (compiled-function-arglist fndef))
1364 (or (eq def function) 1365 (or (eq def function)
1365 (if aliases 1366 (if aliases
1366 (setq aliases (concat aliases 1367 (setq aliases (concat aliases
1367 (format ", which is an alias for %s" 1368 (format ", which is an alias for %s"
1368 (symbol-name def)))) 1369 (symbol-name def))))
1369 (setq aliases (format "an alias for %s" (symbol-name 1370 (setq aliases (format "an alias for %s" (symbol-name def)))))
1370 def)))))
1371 (setq function (symbol-function function) 1371 (setq function (symbol-function function)
1372 def (symbol-function function))) 1372 def (symbol-function function)))
1373 (if aliases 1373 (if aliases
1374 (message aliases)) 1374 (message aliases))
1375 (setq library 1375 (setq library
1380 (substring (compiled-function-annotation def) 0 -4)))) 1380 (substring (compiled-function-annotation def) 0 -4))))
1381 (if (null library) 1381 (if (null library)
1382 (error (format "Don't know where `%s' is defined" function))) 1382 (error (format "Don't know where `%s' is defined" function)))
1383 (if (string-match "\\.el\\(c\\)\\'" library) 1383 (if (string-match "\\.el\\(c\\)\\'" library)
1384 (setq library (substring library 0 (match-beginning 1)))) 1384 (setq library (substring library 0 (match-beginning 1))))
1385 (let* ((path (or path find-function-source-path)) 1385 (let* ((path find-function-source-path)
1386 (filename (or (locate-library (concat library ".el") t path) 1386 (filename (if (file-exists-p library)
1387 (locate-library library t path)))) 1387 library
1388 (if (string-match "\\(\\.el\\)\\'" library)
1389 (setq library (substring library 0
1390 (match-beginning
1391 1))))
1392 (or (locate-library (concat library ".el") t path)
1393 (locate-library library t path)))))
1388 (if (not filename) 1394 (if (not filename)
1389 (error "The library \"%s\" is not in the path." library)) 1395 (error "The library \"%s\" is not in the path." library))
1390 (with-current-buffer (find-file-noselect filename) 1396 (with-current-buffer (find-file-noselect filename)
1391 (save-match-data 1397 (save-match-data
1392 (let (;; avoid defconst, defgroup, defvar (any others?) 1398 (let (;; avoid defconst, defgroup, defvar (any others?)