From 26a4a227ac02f64280967676cf3e60de32d023cb Mon Sep 17 00:00:00 2001 From: Karl Heuer Date: Tue, 19 Dec 1995 22:01:53 +0000 Subject: [PATCH] (apropos-match-face): Use `secondary-selection' rather than `highlight' to distinguish it from mouse-face highlighting of hyperlinks. (apropos-mode-map): Rename from `apropos-local-map'. (apropos-mode): Set it rather than have a local-map that made RET locally unusable when copied to other buffer. (apropos-print): Use it. When there is only one property, show what it is. Remove superfluous `save-excursion', thus making help commands' return-message be correct. (apropos-print, apropos-describe-plist): `print-help-return-message' like help commands. --- lisp/apropos.el | 240 +++++++++++++++++++++++++----------------------- 1 file changed, 127 insertions(+), 113 deletions(-) diff --git a/lisp/apropos.el b/lisp/apropos.el index 3d20b6e2981..ef26b9878fa 100644 --- a/lisp/apropos.el +++ b/lisp/apropos.el @@ -81,18 +81,18 @@ text-property list for efficiency.") "*Face for property name in apropos output or `nil'. This looks good, but slows down the commands several times.") -(defvar apropos-match-face (if window-system 'highlight) +(defvar apropos-match-face (if window-system 'secondary-selection) "*Face for matching part in apropos-documentation/value output or `nil'. This looks good, but slows down the commands several times.") -(defvar apropos-local-map +(defvar apropos-mode-map (let ((map (make-sparse-keymap))) (define-key map "\C-m" 'apropos-follow) (define-key map [mouse-2] 'apropos-mouse-follow) (define-key map [down-mouse-2] nil) map) - "Local map active when displaying apropos output.") + "Keymap used in Apropos mode.") (defvar apropos-regexp nil @@ -107,6 +107,17 @@ This looks good, but slows down the commands several times.") (defvar apropos-item () "Current item in or for apropos-accumulator.") +(defun apropos-mode () + "Major mode for following hyperlinks in output of apropos commands. + +\\{apropos-mode-map}" + (interactive) + (kill-all-local-variables) + (use-local-map apropos-mode-map) + (setq major-mode 'apropos-mode + mode-name "Apropos")) + + ;; For auld lang syne: ;;;###autoload (fset 'command-apropos 'apropos-command) @@ -122,7 +133,7 @@ variables." "(regexp): ")) current-prefix-arg)) (let ((message - (let ((standard-output (get-buffer-create "*Help*"))) + (let ((standard-output (get-buffer-create "*Apropos*"))) (print-help-return-message 'identity)))) (or do-all (setq do-all apropos-do-all)) (setq apropos-accumulator @@ -186,9 +197,9 @@ Returns list of symbols and documentation found." (string-match "\n" doc)) "(not documented)")) (if (setq doc (symbol-plist symbol)) - (if (eq (setq doc (/ (length doc) 2)) 1) - "1 property" - (concat doc " properties"))))) + (if (eq (/ (length doc) 2) 1) + (format "1 property (%s)" (car doc)) + (concat (/ (length doc) 2) " properties"))))) (setq p (cdr p))))) nil)) @@ -220,7 +231,7 @@ Returns list of symbols and values found." ;;;###autoload (defun apropos-documentation (apropos-regexp &optional do-all) - "Show symbols whose names or documentation contain matches for REGEXP. + "Show symbols whose documentation contain matches for REGEXP. With optional prefix ARG or if `apropos-do-all' is non-nil, also use documentation that is not stored in the documentation file and show key bindings. @@ -238,11 +249,10 @@ Returns list of symbols and documentation found." (mapatoms (lambda (symbol) (setq f (apropos-safe-documentation symbol) - v (get symbol 'variable-documentation) - v (if (integerp v) nil v)) - (or (string-match apropos-regexp (symbol-name symbol)) - (setq f (apropos-documentation-internal f) - v (apropos-documentation-internal v))) + v (get symbol 'variable-documentation)) + (if (integerp v) (setq v)) + (setq f (apropos-documentation-internal f) + v (apropos-documentation-internal v)) (if (or f v) (if (setq apropos-item (cdr (assq symbol apropos-accumulator))) @@ -254,7 +264,7 @@ Returns list of symbols and documentation found." (setq apropos-accumulator (cons (list symbol f v) apropos-accumulator))))))) - (apropos-print do-all nil t)) + (apropos-print nil nil t)) (kill-buffer standard-input)))) @@ -307,57 +317,64 @@ Returns list of symbols and documentation found." ;; Finds all documentation related to APROPOS-REGEXP in internal-doc-file-name. (defun apropos-documentation-check-doc-file () - (let (type symbol beg end) + (let (type symbol (sepa 2) sepb beg end) + (insert ?\^_) + (backward-char) (insert-file-contents (concat doc-directory internal-doc-file-name)) - (while (re-search-forward apropos-regexp nil t) - (setq beg (match-beginning 0) - end (point)) - (search-backward "\C-_") - (if (> (point) beg) - () - (or (setq type (if (eq ?F (char-after (1+ (point)))) - 1 ;function documentation - 2) ;variable documentation - symbol (prog2 - (forward-char 2) - (read)) - beg (- beg (point) 1) - end (- end (point) 1) - doc (buffer-substring - (1+ (point)) - (if (search-forward "\C-_" nil 'move) - (1- (point)) - (point))) - apropos-item (assq symbol apropos-accumulator)) - (setq apropos-item (list symbol nil nil) - apropos-accumulator (cons apropos-item apropos-accumulator))) - (and apropos-match-face - (>= beg 0) - (put-text-property beg end 'face apropos-match-face doc)) - (setcar (nthcdr type apropos-item) doc))))) + (forward-char) + (while (save-excursion + (setq sepb (search-forward "\^_")) + (not (eobp))) + (beginning-of-line 2) + (if (save-restriction + (narrow-to-region (point) (1- sepb)) + (re-search-forward apropos-regexp nil t)) + (progn + (setq beg (match-beginning 0) + end (point)) + (goto-char (1+ sepa)) + (or (setq type (if (eq ?F (preceding-char)) + 1 ; function documentation + 2) ; variable documentation + symbol (read) + beg (- beg (point) 1) + end (- end (point) 1) + doc (buffer-substring (1+ (point)) (1- sepb)) + apropos-item (assq symbol apropos-accumulator)) + (setq apropos-item (list symbol nil nil) + apropos-accumulator (cons apropos-item + apropos-accumulator))) + (if apropos-match-face + (put-text-property beg end 'face apropos-match-face doc)) + (setcar (nthcdr type apropos-item) doc))) + (setq sepa (goto-char sepb))))) (defun apropos-documentation-check-elc-file (file) (if (member file apropos-files-scanned) nil - (let (symbol doc beg end end1 this-is-a-variable) + (let (symbol doc beg end this-is-a-variable) (setq apropos-files-scanned (cons file apropos-files-scanned)) (erase-buffer) (insert-file-contents file) (while (search-forward "\n#@" nil t) ;; Read the comment length, and advance over it. (setq end (read) - beg (point) - end (+ (point) end 1)) - (if (re-search-forward apropos-regexp end t) + beg (1+ (point)) + end (+ (point) end -1)) + (forward-char) + (if (save-restriction + ;; match ^ and $ relative to doc string + (narrow-to-region beg end) + (re-search-forward apropos-regexp nil t)) (progn - (goto-char end) - (setq doc (buffer-substring (1+ beg) (- end 2)) - end1 (- (match-end 0) beg 1) - beg (- (match-beginning 0) beg 1) - this-is-a-variable (looking-at "(defvar\\|(defconst") + (goto-char (+ end 2)) + (setq doc (buffer-substring beg end) + end (- (match-end 0) beg) + beg (- (match-beginning 0) beg) + this-is-a-variable (looking-at "(def\\(var\\|const\\) ") symbol (progn (skip-chars-forward "(a-z") - (forward-char 1) + (forward-char) (read)) symbol (if (consp symbol) (nth 1 symbol) @@ -371,12 +388,11 @@ Returns list of symbols and documentation found." apropos-accumulator (cons apropos-item apropos-accumulator))) (if apropos-match-face - (put-text-property beg end1 'face apropos-match-face + (put-text-property beg end 'face apropos-match-face doc)) (setcar (nthcdr (if this-is-a-variable 2 1) apropos-item) - doc))))) - (goto-char end))))) + doc))))))))) @@ -416,7 +432,7 @@ found." (funcall doc-fn apropos-accumulator)) (setq apropos-accumulator (sort apropos-accumulator (lambda (a b) - (string-lessp (car a) (car b))))) + (string-lessp (car a) (car b))))) (and apropos-label-face (symbolp apropos-label-face) (setq apropos-label-face `(face ,apropos-label-face @@ -425,60 +441,59 @@ found." (let ((p apropos-accumulator) (old-buffer (current-buffer)) symbol item point1 point2) - (save-excursion - (set-buffer standard-output) - (if window-system - (insert (substitute-command-keys - "Click \\\\[apropos-mouse-follow] to get full documentation.\n"))) - (insert (substitute-command-keys - "In this buffer, type \\\\[apropos-follow] to get full documentation.\n\n")) - (use-local-map apropos-local-map) - (while (consp p) - (or (not spacing) (bobp) (terpri)) - (setq apropos-item (car p) - symbol (car apropos-item) - p (cdr p) - point1 (point)) - (princ symbol) ;print symbol name - (setq point2 (point)) - ;; don't calculate key-bindings unless needed - (and do-keys - (commandp symbol) - (indent-to 30 1) - (insert - (if (setq item (save-excursion - (set-buffer old-buffer) - (where-is-internal symbol))) - (mapconcat - (if apropos-keybinding-face - (lambda (key) - (setq key (key-description key)) - (put-text-property 0 (length key) - 'face apropos-keybinding-face - key) - key) - 'key-description) - item ", ") - "(not bound to any keys)"))) - (terpri) - ;; only now so we don't propagate text attributes all over - (put-text-property point1 point2 'item - (if (eval `(or ,@(cdr apropos-item))) - (car apropos-item) - apropos-item)) - (if apropos-symbol-face - (put-text-property point1 point2 'face apropos-symbol-face)) - (apropos-print-doc 'describe-function 1 - (if (commandp symbol) - "Command" - (if (apropos-macrop symbol) - "Macro" - "Function")) - do-keys) - (apropos-print-doc 'describe-variable 2 - "Variable" do-keys) - (apropos-print-doc 'apropos-describe-plist 3 - "Plist" nil)))))) + (set-buffer standard-output) + (apropos-mode) + (if window-system + (insert (substitute-command-keys + "Click \\[apropos-mouse-follow] to get full documentation.\n"))) + (insert (substitute-command-keys + "In this buffer, type \\[apropos-follow] to get full documentation.\n\n")) + (while (consp p) + (or (not spacing) (bobp) (terpri)) + (setq apropos-item (car p) + symbol (car apropos-item) + p (cdr p) + point1 (point)) + (princ symbol) ; print symbol name + (setq point2 (point)) + ;; don't calculate key-bindings unless needed + (and do-keys + (commandp symbol) + (indent-to 30 1) + (insert + (if (setq item (save-excursion + (set-buffer old-buffer) + (where-is-internal symbol))) + (mapconcat + (if apropos-keybinding-face + (lambda (key) + (setq key (key-description key)) + (put-text-property 0 (length key) + 'face apropos-keybinding-face + key) + key) + 'key-description) + item ", ") + "(not bound to any keys)"))) + (terpri) + ;; only now so we don't propagate text attributes all over + (put-text-property point1 point2 'item + (if (eval `(or ,@(cdr apropos-item))) + (car apropos-item) + apropos-item)) + (if apropos-symbol-face + (put-text-property point1 point2 'face apropos-symbol-face)) + (apropos-print-doc 'describe-function 1 + (if (commandp symbol) + "Command" + (if (apropos-macrop symbol) + "Macro" + "Function")) + do-keys) + (apropos-print-doc 'describe-variable 2 + "Variable" do-keys) + (apropos-print-doc 'apropos-describe-plist 3 + "Plist" nil))))) (prog1 apropos-accumulator (setq apropos-accumulator ()))) ; permit gc @@ -511,7 +526,7 @@ found." (defun apropos-mouse-follow (event) (interactive "e") - (let ((other (if (eq (current-buffer) (get-buffer "*Help*")) + (let ((other (if (eq (current-buffer) (get-buffer "*Apropos*")) () (current-buffer)))) (save-excursion @@ -520,8 +535,6 @@ found." (or (and (not (eobp)) (get-text-property (point) 'mouse-face)) (and (not (bobp)) (get-text-property (1- (point)) 'mouse-face)) (error "There is nothing to follow here")) - ;; somehow when clicking with the point in another window, undoes badly - (undo-boundary) (apropos-follow other)))) @@ -557,6 +570,7 @@ found." (if apropos-symbol-face (put-text-property 8 (- (point) 14) 'face apropos-symbol-face)) (insert (apropos-format-plist symbol "\n ")) - (princ ")"))) + (princ ")") + (print-help-return-message))) ;;; apropos.el ends here -- 2.39.2