Commit 17ef0353 authored by Richard M. Stallman's avatar Richard M. Stallman
Browse files

(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.
parent 3c7d31b9
...@@ -514,33 +514,36 @@ found." ...@@ -514,33 +514,36 @@ found."
(let ((other (if (eq (current-buffer) (get-buffer "*Help*")) (let ((other (if (eq (current-buffer) (get-buffer "*Help*"))
() ()
(current-buffer)))) (current-buffer))))
(set-buffer (window-buffer (posn-window (event-start event)))) (save-excursion
(goto-char (posn-point (event-start event))) (set-buffer (window-buffer (posn-window (event-start event))))
;; somehow when clicking with the point in another window, undoes badly (goto-char (posn-point (event-start event)))
(undo-boundary) (or (and (not (eobp)) (get-text-property (point) 'mouse-face))
(apropos-follow other))) (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) (defun apropos-follow (&optional other)
(interactive) (interactive)
(let ((point (point)) (let* (;; Properties are always found at the beginning of the line.
(item (bol (save-excursion (beginning-of-line) (point)))
(or (and (not (eobp)) (get-text-property (point) 'item)) ;; If there is no `item' property here, look behind us.
(and (not (bobp)) (get-text-property (1- (point)) 'item)))) (item (get-text-property bol 'item))
action action-point) (item-at (if item nil (previous-single-property-change bol 'item)))
(if (null 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")) (error "There is nothing to follow here"))
(if (consp item) (if (consp item) (error "There is nothing to follow in `%s'" (car item)))
(error "There is nothing to follow in `%s'" (car item))) (if other (set-buffer other))
(while (if (setq action-point (funcall action item)))
(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)))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment