changeset 13656:b5b44ae33653

(apropos-follow): Rewrite to use whole line as target of reference. (apropos-mouse-follow): Do save-excursion. Error if not adjacent to a mouse-face property.
author Richard M. Stallman <rms@gnu.org>
date Mon, 27 Nov 1995 05:47:49 +0000
parents 5dd2d988f3c3
children 0dd21f630fb0
files lisp/apropos.el
diffstat 1 files changed, 25 insertions(+), 22 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/apropos.el	Mon Nov 27 03:03:33 1995 +0000
+++ b/lisp/apropos.el	Mon Nov 27 05:47:49 1995 +0000
@@ -514,33 +514,36 @@
   (let ((other (if (eq (current-buffer) (get-buffer "*Help*"))
 		   ()
 		 (current-buffer))))
-    (set-buffer (window-buffer (posn-window (event-start event))))
-    (goto-char (posn-point (event-start event)))
-    ;; somehow when clicking with the point in another window, undoes badly
-    (undo-boundary)
-    (apropos-follow other)))
+    (save-excursion
+      (set-buffer (window-buffer (posn-window (event-start event))))
+      (goto-char (posn-point (event-start event)))
+      (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))))
 
 
 (defun apropos-follow (&optional other)
   (interactive)
-  (let ((point (point))
-	(item
-	 (or (and (not (eobp)) (get-text-property (point) 'item))
-	     (and (not (bobp)) (get-text-property (1- (point)) 'item))))
-	action action-point)
-    (if (null item)
+  (let* (;; Properties are always found at the beginning of the line.
+	 (bol (save-excursion (beginning-of-line) (point)))
+	 ;; If there is no `item' property here, look behind us.
+	 (item (get-text-property bol 'item))
+	 (item-at (if item nil (previous-single-property-change bol 'item)))
+	 ;; Likewise, if there is no `action' property here, look in front.
+	 (action (get-text-property bol 'action))
+	 (action-at (if action nil (next-single-property-change bol 'action))))
+    (and (null item) item-at
+	 (setq item (get-text-property (1- item-at) 'item)))
+    (and (null action) action-at
+	 (setq action (get-text-property action-at 'action)))
+    (if (not (and item action))
 	(error "There is nothing to follow here"))
-    (if (consp item)
-	(error "There is nothing to follow in `%s'" (car item)))
-    (while (if (setq action-point
-		     (next-single-property-change (point) 'action))
-	       (<= action-point point))
-      (goto-char (1+ action-point))
-      (setq action action-point))
-    (funcall
-     (prog1 (get-text-property (or action action-point (point)) 'action)
-       (if other (set-buffer other)))
-     item)))
+    (if (consp item) (error "There is nothing to follow in `%s'" (car item)))
+    (if other (set-buffer other))
+    (funcall action item)))