X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/476e9367ec1f440aa23904b7bc482ea4a3b8041c..3d2062d8f6e43761a1175f1b9f779b827012722a:/lisp/help-fns.el diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 857157b75f..eee0794b67 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -1,7 +1,7 @@ ;;; help-fns.el --- Complex help functions ;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001, -;; 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. +;; 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: help, internal @@ -10,7 +10,7 @@ ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) +;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, @@ -35,72 +35,6 @@ (require 'help-mode) - -;;;###autoload -(defun help-with-tutorial (&optional arg) - "Select the Emacs learn-by-doing tutorial. -If there is a tutorial version written in the language -of the selected language environment, that version is used. -If there's no tutorial in that language, `TUTORIAL' is selected. -With ARG, you are asked to choose which language." - (interactive "P") - (let ((lang (if arg - (let ((minibuffer-setup-hook minibuffer-setup-hook)) - (add-hook 'minibuffer-setup-hook - 'minibuffer-completion-help) - (read-language-name 'tutorial "Language: " "English")) - (if (get-language-info current-language-environment 'tutorial) - current-language-environment - "English"))) - file filename) - (setq filename (get-language-info lang 'tutorial)) - (setq file (expand-file-name (concat "~/" filename))) - (delete-other-windows) - (if (get-file-buffer file) - (switch-to-buffer (get-file-buffer file)) - (switch-to-buffer (create-file-buffer file)) - (setq buffer-file-name file) - (setq default-directory (expand-file-name "~/")) - (setq buffer-auto-save-file-name nil) - (insert-file-contents (expand-file-name filename data-directory)) - (hack-local-variables) - (goto-char (point-min)) - (search-forward "\n<<") - (beginning-of-line) - ;; Convert the <<...>> line to the proper [...] line, - ;; or just delete the <<...>> line if a [...] line follows. - (cond ((save-excursion - (forward-line 1) - (looking-at "\\[")) - (delete-region (point) (progn (forward-line 1) (point)))) - ((looking-at "<>") - (replace-match "[Middle of page left blank for didactic purposes. Text continues below]")) - (t - (looking-at "<<") - (replace-match "[") - (search-forward ">>") - (replace-match "]"))) - (beginning-of-line) - (let ((n (- (window-height (selected-window)) - (count-lines (point-min) (point)) - 6))) - (if (< n 8) - (progn - ;; For a short gap, we don't need the [...] line, - ;; so delete it. - (delete-region (point) (progn (end-of-line) (point))) - (newline n)) - ;; Some people get confused by the large gap. - (newline (/ n 2)) - - ;; Skip the [...] line (don't delete it). - (forward-line 1) - (newline (- n (/ n 2))))) - (goto-char (point-min)) - (setq buffer-undo-list nil) - (set-buffer-modified-p nil)))) - - ;; Functions ;;;###autoload @@ -298,6 +232,23 @@ face (according to `face-differs-from-default-p')." libname) file)))) +(defun find-source-lisp-file (file-name) + (let* ((elc-file (locate-file (concat file-name + (if (string-match "\\.el" file-name) + "c" + ".elc")) + load-path)) + (str (if (and elc-file (file-readable-p elc-file)) + (with-temp-buffer + (insert-file-contents-literally elc-file nil 0 256) + (buffer-string)))) + (src-file (and str + (string-match ";;; from file \\(.*\\.el\\)" str) + (match-string 1 str)))) + (if (and src-file (file-readable-p src-file)) + src-file + file-name))) + ;;;###autoload (defun describe-function-1 (function) (let* ((def (if (symbolp function) @@ -375,6 +326,10 @@ face (according to `face-differs-from-default-p')." ;; but that's completely wrong when the user used load-file. (princ (if (eq file-name 'C-source) "C source code" file-name)) (princ "'") + ;; See if lisp files are present where they where installed from. + (if (not (eq file-name 'C-source)) + (setq file-name (find-source-lisp-file file-name))) + ;; Make a hyperlink to the library. (with-current-buffer standard-output (save-excursion @@ -383,35 +338,40 @@ face (according to `face-differs-from-default-p')." (princ ".") (terpri) (when (commandp function) - (let* ((remapped (command-remapping function)) - (keys (where-is-internal - (or remapped function) overriding-local-map nil nil)) - non-modified-keys) - ;; Which non-control non-meta keys run this command? - (dolist (key keys) - (if (member (event-modifiers (aref key 0)) '(nil (shift))) - (push key non-modified-keys))) - (when remapped - (princ "It is remapped to `") - (princ (symbol-name remapped)) - (princ "'")) - - (when keys - (princ (if remapped " which is bound to " "It is bound to ")) - ;; FIXME: This list can be very long (f.ex. for self-insert-command). - ;; If there are many, remove them from KEYS. - (if (< (length non-modified-keys) 10) - (princ (mapconcat 'key-description keys ", ")) - (dolist (key non-modified-keys) - (setq keys (delq key keys))) - (if keys - (progn - (princ (mapconcat 'key-description keys ", ")) - (princ ", and many ordinary text characters")) - (princ "many ordinary text characters")))) - (when (or remapped keys non-modified-keys) - (princ ".") - (terpri)))) + (if (and (eq function 'self-insert-command) + (eq (key-binding "a") 'self-insert-command) + (eq (key-binding "b") 'self-insert-command) + (eq (key-binding "c") 'self-insert-command)) + (princ "It is bound to many ordinary text characters.\n") + (let* ((remapped (command-remapping function)) + (keys (where-is-internal + (or remapped function) overriding-local-map nil nil)) + non-modified-keys) + ;; Which non-control non-meta keys run this command? + (dolist (key keys) + (if (member (event-modifiers (aref key 0)) '(nil (shift))) + (push key non-modified-keys))) + (when remapped + (princ "It is remapped to `") + (princ (symbol-name remapped)) + (princ "'")) + + (when keys + (princ (if remapped " which is bound to " "It is bound to ")) + ;; If lots of ordinary text characters run this command, + ;; don't mention them one by one. + (if (< (length non-modified-keys) 10) + (princ (mapconcat 'key-description keys ", ")) + (dolist (key non-modified-keys) + (setq keys (delq key keys))) + (if keys + (progn + (princ (mapconcat 'key-description keys ", ")) + (princ ", and many ordinary text characters")) + (princ "many ordinary text characters")))) + (when (or remapped keys non-modified-keys) + (princ ".") + (terpri))))) (let* ((arglist (help-function-arglist def)) (doc (documentation function)) (usage (help-split-fundoc doc function))) @@ -461,7 +421,7 @@ face (according to `face-differs-from-default-p')." ;;;###autoload (defun variable-at-point (&optional any-symbol) - "Return the bound variable symbol found around point. + "Return the bound variable symbol found at or before point. Return 0 if there is no such symbol. If ANY-SYMBOL is non-nil, don't insist the symbol be bound." (or (condition-case () @@ -540,7 +500,8 @@ it is displayed along with the global value." (error nil)))) (when location (with-current-buffer (car location) - (goto-char (cdr location)) + (when (cdr location) + (goto-char (cdr location))) (when (re-search-backward "^;;; Generated autoloads from \\(.*\\)" nil t) (setq file-name (match-string 1))))))) @@ -604,14 +565,8 @@ it is displayed along with the global value." ;; See previous comment for this function. ;; (help-xref-on-pp from (point)) (if (< (point) (+ from 20)) - (delete-region (1- from) from))))))) - ;; Add a note for variables that have been make-var-buffer-local. - (when (and (local-variable-if-set-p variable) - (or (not (local-variable-p variable)) - (with-temp-buffer - (local-variable-if-set-p variable)))) - (princ "\nAutomatically becomes buffer-local when set in any fashion.\n")) - (terpri) + (delete-region (1- from) from)))))) + (terpri)) ;; If the value is large, move it to the end. (with-current-buffer standard-output @@ -621,7 +576,11 @@ it is displayed along with the global value." ;; of a symbol. (set-syntax-table emacs-lisp-mode-syntax-table) (goto-char val-start-pos) - (delete-region (point) (progn (end-of-line) (point))) + ;; The line below previously read as + ;; (delete-region (point) (progn (end-of-line) (point))) + ;; which suppressed display of the buffer local value for + ;; large values. + (when (looking-at "value is") (replace-match "")) (save-excursion (insert "\n\nValue:") (set (make-local-variable 'help-button-cache) @@ -631,34 +590,50 @@ it is displayed along with the global value." 'action help-button-cache 'follow-link t 'help-echo "mouse-2, RET: show value") - (insert ".\n\n"))) + (insert ".\n"))) + (terpri) - ;; Mention if it's an alias (let* ((alias (condition-case nil (indirect-variable variable) (error variable))) (obsolete (get variable 'byte-obsolete-variable)) (safe-var (get variable 'safe-local-variable)) (doc (or (documentation-property variable 'variable-documentation) - (documentation-property alias 'variable-documentation)))) + (documentation-property alias 'variable-documentation))) + (extra-line nil)) + ;; Add a note for variables that have been make-var-buffer-local. + (when (and (local-variable-if-set-p variable) + (or (not (local-variable-p variable)) + (with-temp-buffer + (local-variable-if-set-p variable)))) + (setq extra-line t) + (princ " Automatically becomes buffer-local when set in any fashion.\n")) + + ;; Mention if it's an alias (unless (eq alias variable) - (princ (format "\nThis variable is an alias for `%s'.\n" alias))) + (setq extra-line t) + (princ (format " This variable is an alias for `%s'.\n" alias))) + (when obsolete - (princ "\nThis variable is obsolete") + (setq extra-line t) + (princ " This variable is obsolete") (if (cdr obsolete) (princ (format " since %s" (cdr obsolete)))) - (princ ";") (terpri) + (princ ";\n ") (princ (if (stringp (car obsolete)) (car obsolete) (format "use `%s' instead." (car obsolete)))) (terpri)) (when safe-var - (princ "This variable is safe as a file local variable ") - (princ "if its value\nsatisfies the predicate ") + (setq extra-line t) + (princ " This variable is safe as a file local variable ") + (princ "if its value\n satisfies the predicate ") (princ (if (byte-code-function-p safe-var) "which is byte-compiled expression.\n" - (format "`%s'.\n" safe-var))) - (terpri)) + (format "`%s'.\n" safe-var)))) + + (if extra-line (terpri)) (princ "Documentation:\n") - (princ (or doc "Not documented as a variable."))) + (with-current-buffer standard-output + (insert (or doc "Not documented as a variable.")))) ;; Make a link to customize if this variable can be customized. (if (custom-variable-p variable) (let ((customize-label "customize"))