(follow-mode): Don't run hooks twice. Use `when'.

[bpt/emacs.git] / lisp / button.el

diff --git a/lisp/button.el b/lisp/button.el
index 375182d..85180a9 100644 (file)
--- a/lisp/button.el
+++ b/lisp/button.el
@@ -1,6 +1,7 @@
 ;;; button.el --- clickable buttons
 ;;
-;; Copyright (C) 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2002, 2003, 2004, 2005,
+;;   2006, 2007 Free Software Foundation, Inc.
 ;;
 ;; Author: Miles Bader <miles@gnu.org>
 ;; Keywords: extensions
@@ -9,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,
@@ -51,11 +52,14 @@
 ;; Globals
 
 ;; Use color for the MS-DOS port because it doesn't support underline.
+;; FIXME if MS-DOS correctly answers the (supports) question, it need
+;; no longer be a special case.
 (defface button '((((type pc) (class color))
                   (:foreground "lightblue"))
-                 (t :underline t))
+                 (((supports :underline t)) :underline t)
+                 (t (:foreground "lightblue")))
   "Default face used for buttons."
-  :group 'faces)
+  :group 'basic-faces)
 
 ;;;###autoload
 (defvar button-map
@@ -88,9 +92,6 @@ Mode-specific keymaps may want to use this as their parent keymap.")
 ;; Prevent insertions adjacent to the text-property buttons from
 ;; inheriting its properties.
 (put 'default-button 'rear-nonsticky t)
-;; Text property buttons don't have a `button' property of their own, so
-;; they inherit this.
-(put 'default-button 'button t)
 
 ;; A `category-symbol' property for the default button type
 (put 'button 'button-category-symbol 'default-button)
@@ -315,7 +316,11 @@ Also see `insert-text-button'."
       (setcar (cdr type-entry)
              (button-category-symbol (car (cdr type-entry))))))
   ;; Now add all the text properties at once
-  (add-text-properties beg end properties)
+  (add-text-properties beg end
+                       ;; Each button should have a non-eq `button'
+                       ;; property so that next-single-property-change can
+                       ;; detect boundaries reliably.
+                       (cons 'button (cons (list t) properties)))
   ;; Return something that can be used to get at the button.
   beg)
 
@@ -364,16 +369,29 @@ instead of starting at the next button."
             (next-button pos))))
 
 (defun previous-button (pos &optional count-current)
-  "Return the Nth button before position POS in the current buffer.
+  "Return the previous button before position POS in the current buffer.
 If COUNT-CURRENT is non-nil, count any button at POS in the search,
 instead of starting at the next button."
-  (unless count-current
-    (setq pos (previous-single-char-property-change pos 'button)))
-  (and (> pos (point-min))
-       (or (button-at (1- pos))
-          ;; We must have originally been on a button, and are now in
-          ;; the inter-button space.  Recurse to find a button.
-          (previous-button pos))))
+  (let ((button (button-at pos)))
+    (if button
+       (if count-current
+           button
+         ;; We started out on a button, so move to its start and look
+         ;; for the previous button boundary.
+         (setq pos (previous-single-char-property-change
+                    (button-start button) 'button))
+         (let ((new-button (button-at pos)))
+           (if new-button
+               ;; We are in a button again; this can happen if there
+               ;; are adjacent buttons (or at bob).
+               (unless (= pos (button-start button)) new-button)
+             ;; We are now in the space between buttons.
+             (previous-button pos))))
+      ;; We started out in the space between buttons.
+      (setq pos (previous-single-char-property-change pos 'button))
+      (or (button-at pos)
+         (and (> pos (point-min))
+              (button-at (1- pos)))))))
 
 \f
 ;; User commands
@@ -452,5 +470,5 @@ Returns the button found."
 
 (provide 'button)
 
-;;; arch-tag: 5f2c7627-413b-4097-b282-630f89d9c5e9
+;; arch-tag: 5f2c7627-413b-4097-b282-630f89d9c5e9
 ;;; button.el ends here