Mercurial > hg > xemacs-beta
diff lisp/prim/help.el @ 203:850242ba4a81 r20-3b28
Import from CVS: tag r20-3b28
author | cvs |
---|---|
date | Mon, 13 Aug 2007 10:02:21 +0200 |
parents | acd284d43ca1 |
children | e45d5e7c476e |
line wrap: on
line diff
--- a/lisp/prim/help.el Mon Aug 13 10:01:24 2007 +0200 +++ b/lisp/prim/help.el Mon Aug 13 10:02:21 2007 +0200 @@ -261,8 +261,7 @@ (insert-file-contents (expand-file-name tutorial data-directory)) (goto-char (point-min)) (search-forward "\n<<") - (beginning-of-line) - (delete-region (point) (progn (end-of-line) (point))) + (delete-region (point-at-bol) (point-at-eol)) (let ((n (- (window-height (selected-window)) (count-lines (point-min) (point)) 6))) @@ -276,12 +275,14 @@ (goto-char (point-min)) (set-buffer-modified-p nil)))) -;; used by describe-key and describe-key-briefly +;; used by describe-key, describe-key-briefly, insert-key-binding, etc. (defun key-or-menu-binding (key &optional menu-flag) - ;; KEY is any value returned by next-command-event - ;; MENU-FLAG is a symbol that should be set to T if KEY is a menu event, - ;; or NIL otherwise + "Return the command invoked by KEY. +Like `key-binding', but handles menu events and toolbar presses correctly. +KEY is any value returned by `next-command-event'. +MENU-FLAG is a symbol that should be set to T if KEY is a menu event, + or NIL otherwise" (let (defn) (and menu-flag (set menu-flag nil)) ;; If the key typed was really a menu selection, grab the form out @@ -295,12 +296,12 @@ (list (event-function event) (event-object event)) (cdr event))) (and menu-flag (set menu-flag t)) - (if (eq (car defn) 'eval) - (setq defn (car (cdr defn)))) - (if (eq (car-safe defn) 'call-interactively) - (setq defn (car (cdr defn)))) - (if (and (consp defn) (null (cdr defn))) - (setq defn (car defn)))) + (when (eq (car defn) 'eval) + (setq defn (car (cdr defn)))) + (when (eq (car-safe defn) 'call-interactively) + (setq defn (car (cdr defn)))) + (when (and (consp defn) (null (cdr defn))) + (setq defn (car defn)))) ;; else (setq defn (key-binding key))) ;; kludge: if a toolbar button was pressed on, try to find the @@ -405,26 +406,24 @@ (set-buffer standard-output) (help-mode)))) (let ((helpwin (get-buffer-window "*Help*"))) - (if helpwin - (progn - (save-excursion - (set-buffer (window-buffer helpwin)) - ;;If the *Help* buffer is already displayed on this - ;; frame, don't override the previous configuration - (if help-not-visible - (set-frame-property (selected-frame) - 'help-window-config winconfig))) - (if help-selects-help-window - (select-window helpwin)) - (cond ((eq helpwin (selected-window)) - (display-message 'command - (substitute-command-keys "Type \\[help-mode-quit] to remove help window, \\[scroll-up] to scroll the help."))) - (was-one-window - (display-message 'command - (substitute-command-keys "Type \\[delete-other-windows] to remove help window, \\[scroll-other-window] to scroll the help."))) - (t - (display-message 'command - (substitute-command-keys "Type \\[switch-to-buffer-other-window] to restore the other window, \\[scroll-other-window] to scroll the help.")))))))))) + (when helpwin + (with-current-buffer (window-buffer helpwin) + ;; If the *Help* buffer is already displayed on this + ;; frame, don't override the previous configuration + (when help-not-visible + (set-frame-property (selected-frame) + 'help-window-config winconfig))) + (when help-selects-help-window + (select-window helpwin)) + (cond ((eq helpwin (selected-window)) + (display-message 'command + (substitute-command-keys "Type \\[help-mode-quit] to remove help window, \\[scroll-up] to scroll the help."))) + (was-one-window + (display-message 'command + (substitute-command-keys "Type \\[delete-other-windows] to remove help window, \\[scroll-other-window] to scroll the help."))) + (t + (display-message 'command + (substitute-command-keys "Type \\[switch-to-buffer-other-window] to restore the other window, \\[scroll-other-window] to scroll the help."))))))))) (defun describe-key (key) "Display documentation of the function invoked by KEY. @@ -740,12 +739,12 @@ (while (or (equal event help-key) (eq char ??) (eq 'help-command (key-binding event)) - (eq char ? ) + (eq char ?\ ) (eq 'scroll-up (key-binding event)) (eq char ?\177) (and (not (eq char ?b)) (eq 'scroll-down (key-binding event)))) - (if (or (eq char ? ) + (if (or (eq char ?\ ) (eq 'scroll-up (key-binding event))) (scroll-up)) (if (or (eq char ?\177) @@ -767,10 +766,10 @@ (call-interactively defn) (ding))))) -;; Return a function which is called by the list containing point. -;; If that gives no function, return a function whose name is around point. -;; If that doesn't give a function, return nil. (defun function-called-at-point () + "Return the function which is called by the list containing point. +If that gives no function, return the function whose name is around point. +If that doesn't give a function, return nil." (or (condition-case () (save-excursion (save-restriction @@ -796,22 +795,60 @@ (set-syntax-table stab))) (error nil)))) -;; default to nil for the non-hackers? +(defun function-at-point () + "Return the function whose name is around point. +If that gives no function, return the function which is called by the +list containing point. If that doesn't give a function, return nil." + (or (condition-case () + (let ((stab (syntax-table))) + (unwind-protect + (save-excursion + (set-syntax-table emacs-lisp-mode-syntax-table) + (or (not (zerop (skip-syntax-backward "_w"))) + (eq (char-syntax (char-after (point))) ?w) + (eq (char-syntax (char-after (point))) ?_) + (forward-sexp -1)) + (skip-chars-forward "`'") + (let ((obj (read (current-buffer)))) + (and (symbolp obj) (fboundp obj) obj))) + (set-syntax-table stab))) + (error nil)) + (condition-case () + (save-excursion + (save-restriction + (narrow-to-region (max (point-min) (- (point) 1000)) (point-max)) + (backward-up-list 1) + (forward-char 1) + (let (obj) + (setq obj (read (current-buffer))) + (and (symbolp obj) (fboundp obj) obj)))) + (error nil)))) + +;; Default to nil for the non-hackers? Not until we find a way to +;; distinguish hackers from non-hackers automatically! (defcustom describe-function-show-arglist t "*If non-nil, describe-function will show its arglist, unless the function is autoloaded." :type 'boolean :group 'help-appearance) +(defcustom find-function-function 'function-at-point + "*The function used by `describe-function', `where-is' and +`find-function' to select the function near point. + +For example `function-at-point' or `function-called-at-point'." + :type 'function + :group 'help) + (defun describe-function-find-file (function) (let ((files load-history) - file) - (while files - (if (memq function (cdr (car files))) - (setq file (car (car files)) - files nil)) - (setq files (cdr files))) - file)) + file) + (while files + (if (memq function (cdr (car files))) + (setq file (car (car files)) + files nil)) + (setq files (cdr files))) + file)) (defun describe-function (function) "Display the full documentation of FUNCTION (a symbol). @@ -830,10 +867,8 @@ (with-displaying-help-buffer (lambda () (describe-function-1 function standard-output) - (save-excursion - (set-buffer standard-output) - ;; Return the text we displayed. - (buffer-string))))) + ;; Return the text we displayed. + (buffer-string nil nil standard-output)))) (defun function-obsolete-p (function) "Return non-nil if FUNCTION is obsolete." @@ -908,8 +943,8 @@ (setq file-name (compiled-function-annotation def))) (if (eq 'macro (car-safe def)) (setq fndef (cdr def) - home (and (compiled-function-p (cdr def)) - (compiled-function-annotation (cdr def))) + file-name (and (compiled-function-p (cdr def)) + (compiled-function-annotation (cdr def))) macrop t) (setq fndef def)) (if aliases (princ aliases stream)) @@ -1010,23 +1045,24 @@ (terpri stream)))))))) -(defun describe-function-arglist (function) - (interactive (list (or (function-called-at-point) - (error "no function call at point")))) - (let ((b nil)) - (unwind-protect - (save-excursion - (set-buffer (setq b (get-buffer-create " *arglist*"))) - (buffer-disable-undo b) - (erase-buffer) - (describe-function-1 function b t) - (goto-char (point-min)) - (end-of-line) - (or (eobp) (delete-char 1)) - (just-one-space) - (end-of-line) - (message (buffer-substring (point-min) (point)))) - (and b (kill-buffer b))))) +;;; ## this doesn't seem to be used for anything +;; (defun describe-function-arglist (function) +;; (interactive (list (or (function-called-at-point) +;; (error "no function call at point")))) +;; (let ((b nil)) +;; (unwind-protect +;; (save-excursion +;; (set-buffer (setq b (get-buffer-create " *arglist*"))) +;; (buffer-disable-undo b) +;; (erase-buffer) +;; (describe-function-1 function b t) +;; (goto-char (point-min)) +;; (end-of-line) +;; (or (eobp) (delete-char 1)) +;; (just-one-space) +;; (end-of-line) +;; (message (buffer-substring (point-min) (point)))) +;; (and b (kill-buffer b))))) (defun variable-at-point () @@ -1073,25 +1109,23 @@ (defun built-in-variable-doc (variable) "Return a string describing whether VARIABLE is built-in." (let ((type (built-in-variable-type variable))) - (cond ((eq type 'integer) "a built-in integer variable") - ((eq type 'const-integer) "a built-in constant integer variable") - ((eq type 'boolean) "a built-in boolean variable") - ((eq type 'const-boolean) "a built-in constant boolean variable") - ((eq type 'object) "a simple built-in variable") - ((eq type 'const-object) "a simple built-in constant variable") - ((eq type 'const-specifier) "a built-in constant specifier variable") - ((eq type 'current-buffer) "a built-in buffer-local variable") - ((eq type 'const-current-buffer) - "a built-in constant buffer-local variable") - ((eq type 'default-buffer) - "a built-in default buffer-local variable") - ((eq type 'selected-console) "a built-in console-local variable") - ((eq type 'const-selected-console) - "a built-in constant console-local variable") - ((eq type 'default-console) - "a built-in default console-local variable") - (type "an unknown type of built-in variable?") - (t "a variable declared in Lisp")))) + (case type + (integer "a built-in integer variable") + (const-integer "a built-in constant integer variable") + (boolean "a built-in boolean variable") + (const-boolean "a built-in constant boolean variable") + (object "a simple built-in variable") + (const-object "a simple built-in constant variable") + (const-specifier "a built-in constant specifier variable") + (current-buffer "a built-in buffer-local variable") + (const-current-buffer "a built-in constant buffer-local variable") + (default-buffer "a built-in default buffer-local variable") + (selected-console "a built-in console-local variable") + (const-selected-console "a built-in constant console-local variable") + (default-console "a built-in default console-local variable") + (t + (if type "an unknown type of built-in variable?" + "a variable declared in Lisp"))))) (defun describe-variable (variable) "Display the full documentation of VARIABLE (a symbol)." @@ -1159,16 +1193,14 @@ (let ((doc (documentation-property variable 'variable-documentation)) (obsolete (variable-obsoleteness-doc origvar)) (compatible (variable-compatibility-doc origvar))) - (if obsolete - (progn - (princ obsolete) - (terpri) - (terpri))) - (if compatible - (progn - (princ compatible) - (terpri) - (terpri))) + (when obsolete + (princ obsolete) + (terpri) + (terpri)) + (when compatible + (princ compatible) + (terpri) + (terpri)) ;; don't bother to print anything if variable is obsolete and aliased. (when (or (not obsolete) (not aliases)) (if doc @@ -1176,15 +1208,13 @@ (princ doc) (princ "not documented as a variable.")) (terpri))) - (save-excursion - (set-buffer standard-output) - ;; Return the text we displayed. - (buffer-string)))))) + ;; Return the text we displayed. + (buffer-string nil nil standard-output))))) (defun sorted-key-descriptions (keys &optional separator) "Sort and separate the key descriptions for KEYS. The sorting is done by length (shortest bindings first), and the bindings -are separated with SEPARATOR (`, ' by default)." +are separated with SEPARATOR (\", \" by default)." (mapconcat 'key-description (sort keys #'(lambda (x y) (< (length x) (length y)))) @@ -1210,53 +1240,8 @@ (message "%s is not on any keys" definition))) nil) -;; Synched with Emacs 19.35 -;; Moved to packages.el -;(defun locate-library (library &optional nosuffix path interactive-call) -; "Show the precise file name of Emacs library LIBRARY. -;This command searches the directories in `load-path' like `M-x load-library' -;to find the file that `M-x load-library RET LIBRARY RET' would load. -;Optional second arg NOSUFFIX non-nil means don't add suffixes `.elc' or `.el' -;to the specified name LIBRARY. +;; `locate-library' moved to "packages.el" -;If the optional third arg PATH is specified, that list of directories -;is used instead of `load-path'." -; (interactive (list (read-string "Locate library: ") -; nil nil -; t)) -; (let (result) -; (catch 'answer -; (mapcar -; (lambda (dir) -; (mapcar -; (lambda (suf) -; (let ((try (expand-file-name (concat library suf) dir))) -; (and (file-readable-p try) -; (null (file-directory-p try)) -; (progn -; (setq result try) -; (throw 'answer try))))) -; (if nosuffix -; '("") -; (let ((basic '(".elc" ".el" "")) -; (compressed '(".Z" ".gz" ""))) -; ;; If autocompression mode is on, -; ;; consider all combinations of library suffixes -; ;; and compression suffixes. -; (if (rassq 'jka-compr-handler file-name-handler-alist) -; (apply 'nconc -; (mapcar (lambda (compelt) -; (mapcar (lambda (baselt) -; (concat baselt compelt)) -; basic)) -; compressed)) -; basic))))) -; (or path load-path))) -; (and interactive-call -; (if result -; (message "Library is file %s" result) -; (message "No library %s in search path" library))) -; result)) ;; Functions ported from C into Lisp in XEmacs @@ -1323,207 +1308,13 @@ (princ (car pid) stream) (princ "@" stream) (princ (cdr pid) stream)) - (let ((cmd (process-command p))) - (while cmd - (princ (car cmd) stream) - (setq cmd (cdr cmd)) - (if cmd (princ " " stream))))) + (let ((cmd (process-command p))) + (while cmd + (princ (car cmd) stream) + (setq cmd (cdr cmd)) + (if cmd (princ " " stream))))) (terpri stream))))))) - -;; find-function stuff - -(defvar find-function-function 'function-at-point - "*The function used by `describe-function', `where-is' and -`find-function' to select the function near point. - -For example `function-at-point' or `function-called-at-point'.") - -(defvar find-function-source-path nil - "The default list of directories where find-function searches. - -If this variable is `nil' then find-function searches `load-path' by -default.") - - -(defun find-function-noselect (function) - "Returns a pair `(buffer . point)' pointing to the definition of FUNCTION. - -Finds the Emacs Lisp library containing the definition of FUNCTION -in a buffer and the point of the definition. The buffer is -not selected. - -The library where FUNCTION is defined is searched for in -`find-function-source-path', if non `nil', otherwise in `load-path'." - (and (subrp (symbol-function function)) - (error "%s is a primitive function" function)) - (if (not function) - (error "You didn't specify a function")) - (let ((def (symbol-function function)) - library aliases) - (while (symbolp def) - (or (eq def function) - (if aliases - (setq aliases (concat aliases - (format ", which is an alias for %s" - (symbol-name def)))) - (setq aliases (format "an alias for %s" (symbol-name def))))) - (setq function (symbol-function function) - def (symbol-function function))) - (if aliases - (message aliases)) - (setq library - (cond ((eq (car-safe def) 'autoload) - (nth 1 def)) - ((describe-function-find-file function)) - ((compiled-function-p def) - (substring (compiled-function-annotation def) 0 -4)))) - (if (null library) - (error (format "Don't know where `%s' is defined" function))) - (if (string-match "\\.el\\(c\\)\\'" library) - (setq library (substring library 0 (match-beginning 1)))) - (let* ((path find-function-source-path) - (filename (if (file-exists-p library) - library - (if (string-match "\\(\\.el\\)\\'" library) - (setq library (substring library 0 - (match-beginning - 1)))) - (or (locate-library (concat library ".el") t path) - (locate-library library t path))))) - (if (not filename) - (error "The library \"%s\" is not in the path." library)) - (with-current-buffer (find-file-noselect filename) - (save-match-data - (let (;; avoid defconst, defgroup, defvar (any others?) - (regexp - (format "^\\s-*(def[^cgv\W]\\w+\\*?\\s-+%s\\s-" function)) - (syntable (syntax-table))) - (set-syntax-table emacs-lisp-mode-syntax-table) - (goto-char (point-min)) - (if (prog1 - (re-search-forward regexp nil t) - (set-syntax-table syntable)) - (progn - (beginning-of-line) - (cons (current-buffer) (point))) - (error "Cannot find definition of `%s'" function)))))))) - -(defun function-at-point () - (or (condition-case () - (let ((stab (syntax-table))) - (unwind-protect - (save-excursion - (set-syntax-table emacs-lisp-mode-syntax-table) - (or (not (zerop (skip-syntax-backward "_w"))) - (eq (char-syntax (char-after (point))) ?w) - (eq (char-syntax (char-after (point))) ?_) - (forward-sexp -1)) - (skip-chars-forward "`'") - (let ((obj (read (current-buffer)))) - (and (symbolp obj) (fboundp obj) obj))) - (set-syntax-table stab))) - (error nil)) - (condition-case () - (save-excursion - (save-restriction - (narrow-to-region (max (point-min) (- (point) 1000)) (point-max)) - (backward-up-list 1) - (forward-char 1) - (let (obj) - (setq obj (read (current-buffer))) - (and (symbolp obj) (fboundp obj) obj)))) - (error nil)))) - -(defun find-function-read-function () - "Read and return a function, defaulting to the one near point. - -The function named by `find-function-function' is used to select the -default function." - (let ((fn (funcall find-function-function)) - (enable-recursive-minibuffers t) - val) - (setq val (completing-read - (if fn - (format "Find function (default %s): " fn) - "Find function: ") - obarray 'fboundp t nil 'function-history)) - (list (if (equal val "") - fn (intern val))))) - -(defun find-function-do-it (function switch-fn) - "find elisp FUNCTION in a buffer and display it with SWITCH-FN. -Point is saved in the buffer if it is one of the current buffers." - (let ((orig-point (point)) - (orig-buffers (buffer-list)) - (buffer-point (find-function-noselect function))) - (if buffer-point - (progn - (funcall switch-fn (car buffer-point)) - (if (memq (car buffer-point) orig-buffers) - (push-mark orig-point)) - (goto-char (cdr buffer-point)) - (recenter 0))))) - -(defun find-function (function) - "Find the definition of the function near point in the current window. - -Finds the Emacs Lisp library containing the definition of the function -near point (selected by `find-function-function') in a buffer and -places point before the definition. Point is saved in the buffer if -it is one of the current buffers. - -The library where FUNCTION is defined is searched for in -`find-function-source-path', if non `nil', otherwise in `load-path'." - (interactive (find-function-read-function)) - (find-function-do-it function 'switch-to-buffer)) - -(defun find-function-other-window (function) - "Find the definition of the function near point in the other window. - -Finds the Emacs Lisp library containing the definition of the function -near point (selected by `find-function-function') in a buffer and -places point before the definition. Point is saved in the buffer if -it is one of the current buffers. - -The library where FUNCTION is defined is searched for in -`find-function-source-path', if non `nil', otherwise in `load-path'." - (interactive (find-function-read-function)) - (find-function-do-it function 'switch-to-buffer-other-window)) - -(defun find-function-other-frame (function) - "Find the definition of the function near point in the another frame. - -Finds the Emacs Lisp library containing the definition of the function -near point (selected by `find-function-function') in a buffer and -places point before the definition. Point is saved in the buffer if -it is one of the current buffers. - -The library where FUNCTION is defined is searched for in -`find-function-source-path', if non `nil', otherwise in `load-path'." - (interactive (find-function-read-function)) - (find-function-do-it function 'switch-to-buffer-other-frame)) - -(defun find-function-on-key (key) - "Find the function that KEY invokes. KEY is a string. -Point is saved if FUNCTION is in the current buffer." - (interactive "kFind function on key: ") - (let ((defn (key-or-menu-binding key))) - (if (or (null defn) (integerp defn)) - (message "%s is undefined" (key-description key)) - (if (and (consp defn) (not (eq 'lambda (car-safe defn)))) - (message "runs %s" (prin1-to-string defn)) - (find-function-other-window defn))))) - -(defun find-function-at-point () - "Find directly the function at point in the other window." - (interactive) - (let ((symb (function-at-point))) - (when symb - (find-function-other-window symb)))) - -(define-key ctl-x-map "F" 'find-function) -(define-key ctl-x-4-map "F" 'find-function-other-window) -(define-key ctl-x-5-map "F" 'find-function-other-frame) +;; `find-function' et al moved to "find-func.el" ;;; help.el ends here