Mercurial > emacs

changeset 13752:e3b945c8141e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(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.
author Karl Heuer <kwzh@gnu.org>
date Tue, 19 Dec 1995 22:01:53 +0000
parents b7894a0895c0
children 9a8ea4e8cb01
files lisp/apropos.el
diffstat 1 files changed, 127 insertions(+), 113 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/apropos.el	Tue Dec 19 21:43:33 1995 +0000
+++ b/lisp/apropos.el	Tue Dec 19 22:01:53 1995 +0000
@@ -81,18 +81,18 @@
   "*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 @@
 (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 @@
 					  "(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 @@
 				       (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 @@
 
 ;;;###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 @@
 	      (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 @@
 		       (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 @@
 ;; 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 @@
 			      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 @@
 	(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 @@
       (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-local-map>\\[apropos-mouse-follow] to get full documentation.\n")))
-	  (insert (substitute-command-keys
-		   "In this buffer, type \\<apropos-local-map>\\[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 @@
 
 (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 @@
       (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 @@
     (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