(copyright-update-year): Fix subexpression numbering for the case when

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

diff --git a/lisp/button.el b/lisp/button.el
index 1b0c009..df95487 100644 (file)
--- a/lisp/button.el
+++ b/lisp/button.el
@@ -1,6 +1,7 @@
 ;;; button.el --- clickable buttons
 ;;
-;; Copyright (C) 2001, 2005 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2002, 2003, 2004, 2005,
+;;   2006, 2007, 2008 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,16 +52,21 @@
 ;; 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
   (let ((map (make-sparse-keymap)))
-    (define-key map "\r" 'push-button)
+    ;; The following definition needs to avoid using escape sequences that
+    ;; might get converted to ^M when building loaddefs.el
+    (define-key map [(control ?m)] 'push-button)
     (define-key map [mouse-2] 'push-button)
     map)
   "Keymap used by buttons.")
@@ -69,6 +75,7 @@
 (defvar button-buffer-map
   (let ((map (make-sparse-keymap)))
     (define-key map [?\t] 'forward-button)
+    (define-key map "\e\t" 'backward-button)
     (define-key map [backtab] 'backward-button)
     map)
   "Keymap useful for buffers containing buttons.
@@ -87,9 +94,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)
@@ -114,7 +118,7 @@ Buttons inherit them by setting their `category' property to that symbol."
 
 ;;;###autoload
 (defun define-button-type (name &rest properties)
-  "Define a `button type' called NAME.
+  "Define a `button type' called NAME (a symbol).
 The remaining arguments form a sequence of PROPERTY VALUE pairs,
 specifying properties to use as defaults for buttons with this type
 \(a button's type may be set by giving it a `type' property when
@@ -314,7 +318,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)
 
@@ -363,16 +371,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
@@ -451,5 +472,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