[Emacs-diffs] /srv/bzr/emacs/trunk r100146: Use define-minor-mode in more cases.

[Stefan Monnier]

------------------------------------------------------------
revno: 100146
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Tue 2010-05-04 23:45:21 -0400
message:
  Use define-minor-mode in more cases.
  * term/tvi970.el (tvi970-set-keypad-mode):
  * simple.el (auto-fill-mode, overwrite-mode, binary-overwrite-mode)
  (normal-erase-is-backspace-mode):
  * scroll-bar.el (scroll-bar-mode): Use it and define-minor-mode.
  (set-scroll-bar-mode-1): (Re)move to its sole caller.
  (get-scroll-bar-mode): New function.
  * emacs-lisp/cl-macs.el (eq): Handle a non-variable first arg.
modified:
  lisp/ChangeLog
  lisp/emacs-lisp/cl-loaddefs.el
  lisp/emacs-lisp/cl-macs.el
  lisp/scroll-bar.el
  lisp/simple.el
  lisp/term/tvi970.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2010-05-05 02:08:25 +0000
+++ b/lisp/ChangeLog    2010-05-05 03:45:21 +0000
@@ -1,5 +1,15 @@
 2010-05-05  Stefan Monnier  <address@hidden>
 
+       Use define-minor-mode in more cases.
+       * term/tvi970.el (tvi970-set-keypad-mode):
+       * simple.el (auto-fill-mode, overwrite-mode, binary-overwrite-mode)
+       (normal-erase-is-backspace-mode):
+       * scroll-bar.el (scroll-bar-mode): Use it and define-minor-mode.
+       (set-scroll-bar-mode-1): (Re)move to its sole caller.
+       (get-scroll-bar-mode): New function.
+       * emacs-lisp/cl-macs.el (eq): Handle a non-variable first arg.
+
+       Use define-minor-mode for less obvious cases.
        * emacs-lisp/easy-mmode.el (define-minor-mode): Add :variable keyword.
        * emacs-lisp/cl-macs.el (terminal-parameter, eq): Add setf method.
        * international/iso-ascii.el (iso-ascii-mode):

=== modified file 'lisp/emacs-lisp/cl-loaddefs.el'
--- a/lisp/emacs-lisp/cl-loaddefs.el    2010-04-21 02:05:24 +0000
+++ b/lisp/emacs-lisp/cl-loaddefs.el    2010-05-05 03:45:21 +0000
@@ -282,7 +282,7 @@
 ;;;;;;  flet progv psetq do-all-symbols do-symbols dotimes dolist
 ;;;;;;  do* do loop return-from return block etypecase typecase ecase
 ;;;;;;  case load-time-value eval-when destructuring-bind function*
-;;;;;;  defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" 
"7fad7dd60f2f96ba90432f885015d61b")
+;;;;;;  defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" 
"0faa39d8f21ae59f2cc1baa835e28a5f")
 ;;; Generated autoloads from cl-macs.el
 
 (autoload 'gensym "cl-macs" "\

=== modified file 'lisp/emacs-lisp/cl-macs.el'
--- a/lisp/emacs-lisp/cl-macs.el        2010-05-05 02:08:25 +0000
+++ b/lisp/emacs-lisp/cl-macs.el        2010-05-05 03:45:21 +0000
@@ -1826,7 +1826,17 @@
 ;; (setq a 7) or (setq a nil) depending on whether B is nil or not.
 ;; This is useful when you have control over the PLACE but not over
 ;; the VALUE, as is the case in define-minor-mode's :variable.
-(defsetf eq (a b) (v) `(setf ,a (if ,v ,b (not ,b))))
+(define-setf-method eq (place val)
+  (let ((method (get-setf-method place cl-macro-environment))
+        (val-temp (make-symbol "--eq-val--"))
+        (store-temp (make-symbol "--eq-store--")))
+    (list (append (nth 0 method) (list val-temp))
+          (append (nth 1 method) (list val))
+          (list store-temp)
+          `(let ((,(car (nth 2 method))
+                  (if ,store-temp ,val-temp (not ,val-temp))))
+             ,(nth 3 method) ,store-temp)
+          `(eq ,(nth 4 method) ,val-temp))))
 
 ;;; More complex setf-methods.
 ;; These should take &environment arguments, but since full arglists aren't

=== modified file 'lisp/scroll-bar.el'
--- a/lisp/scroll-bar.el        2010-02-28 14:36:34 +0000
+++ b/lisp/scroll-bar.el        2010-05-05 03:45:21 +0000
@@ -29,6 +29,7 @@
 ;;; Code:
 
 (require 'mouse)
+(eval-when-compile (require 'cl))
 
 
 ;;;; Utilities.
@@ -79,9 +80,6 @@
   "Non-nil means `set-scroll-bar-mode' should really do something.
 This is nil while loading `scroll-bar.el', and t afterward.")
 
-(defun set-scroll-bar-mode-1 (ignore value)
-  (set-scroll-bar-mode value))
-
 (defun set-scroll-bar-mode (value)
   "Set `scroll-bar-mode' to VALUE and put the new value into effect."
   (if scroll-bar-mode
@@ -107,27 +105,23 @@
   ;; The default value for :initialize would try to use :set
   ;; when processing the file in cus-dep.el.
   :initialize 'custom-initialize-default
-  :set 'set-scroll-bar-mode-1)
+  :set (lambda (sym val) (set-scroll-bar-mode val)))
 
 ;; We just set scroll-bar-mode, but that was the default.
 ;; If it is set again, that is for real.
 (setq scroll-bar-mode-explicit t)
 
-(defun scroll-bar-mode (&optional flag)
+(defun get-scroll-bar-mode () scroll-bar-mode)
+(defsetf get-scroll-bar-mode set-scroll-bar-mode)
+(define-minor-mode scroll-bar-mode
   "Toggle display of vertical scroll bars on all frames.
 This command applies to all frames that exist and frames to be
 created in the future.
 With a numeric argument, if the argument is positive
 turn on scroll bars; otherwise turn off scroll bars."
-  (interactive "P")
-
-  ;; Tweedle the variable according to the argument.
-  (set-scroll-bar-mode (if (if (null flag)
-                              (not scroll-bar-mode)
-                            (setq flag (prefix-numeric-value flag))
-                            (or (not (numberp flag)) (> flag 0)))
-                          (or previous-scroll-bar-mode
-                              default-frame-scroll-bars))))
+  :variable (eq (get-scroll-bar-mode)
+                (or previous-scroll-bar-mode
+                    default-frame-scroll-bars)))
 
 (defun toggle-scroll-bar (arg)
   "Toggle whether or not the selected frame has vertical scroll bars.

=== modified file 'lisp/simple.el'
--- a/lisp/simple.el    2010-05-02 05:56:30 +0000
+++ b/lisp/simple.el    2010-05-05 03:45:21 +0000
@@ -5149,7 +5149,7 @@
 (put 'auto-fill-function 'safe-local-variable 'null)
 ;; FIXME: turn into a proper minor mode.
 ;; Add a global minor mode version of it.
-(defun auto-fill-mode (&optional arg)
+(define-minor-mode auto-fill-mode
   "Toggle Auto Fill mode.
 With ARG, turn Auto Fill mode on if and only if ARG is positive.
 In Auto Fill mode, inserting a space at a column beyond `current-fill-column'
@@ -5157,14 +5157,7 @@
 
 The value of `normal-auto-fill-function' specifies the function to use
 for `auto-fill-function' when turning Auto Fill mode on."
-  (interactive "P")
-  (prog1 (setq auto-fill-function
-              (if (if (null arg)
-                      (not auto-fill-function)
-                      (> (prefix-numeric-value arg) 0))
-                  normal-auto-fill-function
-                  nil))
-    (force-mode-line-update)))
+  :variable (eq auto-fill-function normal-auto-fill-function))
 
 ;; This holds a document string used to document auto-fill-mode.
 (defun auto-fill-function ()
@@ -5263,7 +5256,7 @@
 (defvar overwrite-mode-binary (purecopy " Bin Ovwrt")
   "The string displayed in the mode line when in binary overwrite mode.")
 
-(defun overwrite-mode (arg)
+(define-minor-mode overwrite-mode
   "Toggle overwrite mode.
 With prefix argument ARG, turn overwrite mode on if ARG is positive,
 otherwise turn it off.  In overwrite mode, printing characters typed
@@ -5272,14 +5265,9 @@
 Before a tab, such characters insert until the tab is filled in.
 \\[quoted-insert] still inserts characters in overwrite mode; this
 is supposed to make it easier to insert characters when necessary."
-  (interactive "P")
-  (setq overwrite-mode
-       (if (if (null arg) (not overwrite-mode)
-             (> (prefix-numeric-value arg) 0))
-           'overwrite-mode-textual))
-  (force-mode-line-update))
+  :variable (eq overwrite-mode 'overwrite-mode-textual))
 
-(defun binary-overwrite-mode (arg)
+(define-minor-mode binary-overwrite-mode
   "Toggle binary overwrite mode.
 With prefix argument ARG, turn binary overwrite mode on if ARG is
 positive, otherwise turn it off.  In binary overwrite mode, printing
@@ -5292,13 +5280,7 @@
 Note that binary overwrite mode is not its own minor mode; it is a
 specialization of overwrite mode, entered by setting the
 `overwrite-mode' variable to `overwrite-mode-binary'."
-  (interactive "P")
-  (setq overwrite-mode
-       (if (if (null arg)
-               (not (eq overwrite-mode 'overwrite-mode-binary))
-             (> (prefix-numeric-value arg) 0))
-           'overwrite-mode-binary))
-  (force-mode-line-update))
+  :variable (eq overwrite-mode 'overwrite-mode-binary))
 
 (define-minor-mode line-number-mode
   "Toggle Line Number mode.
@@ -6438,7 +6420,7 @@
              normal-erase-is-backspace)
            1 0)))))
 
-(defun normal-erase-is-backspace-mode (&optional arg)
+(define-minor-mode normal-erase-is-backspace-mode
   "Toggle the Erase and Delete mode of the Backspace and Delete keys.
 
 With numeric ARG, turn the mode on if and only if ARG is positive.
@@ -6468,13 +6450,10 @@
 have both Backspace, Delete and F1 keys.
 
 See also `normal-erase-is-backspace'."
-  (interactive "P")
-  (let ((enabled (or (and arg (> (prefix-numeric-value arg) 0))
-                    (not (or arg
-                              (eq 1 (terminal-parameter
-                                     nil 'normal-erase-is-backspace)))))))
-    (set-terminal-parameter nil 'normal-erase-is-backspace
-                           (if enabled 1 0))
+  :variable (eq (terminal-parameter
+                 nil 'normal-erase-is-backspace) 1)
+  (let ((enabled (eq 1 (terminal-parameter
+                        nil 'normal-erase-is-backspace))))
 
     (cond ((or (memq window-system '(x w32 ns pc))
               (memq system-type '(ms-dos windows-nt)))
@@ -6510,7 +6489,6 @@
             (keyboard-translate ?\C-h ?\C-h)
             (keyboard-translate ?\C-? ?\C-?))))
 
-    (run-hooks 'normal-erase-is-backspace-hook)
     (if (called-interactively-p 'interactive)
        (message "Delete key deletes %s"
                 (if (eq 1 (terminal-parameter nil 'normal-erase-is-backspace))

=== modified file 'lisp/term/tvi970.el'
--- a/lisp/term/tvi970.el       2010-01-13 08:35:10 +0000
+++ b/lisp/term/tvi970.el       2010-05-05 03:45:21 +0000
@@ -28,6 +28,8 @@
 
 ;;; Code:
 
+(eval-when-compile (require 'cl))
+
 (defvar tvi970-terminal-map
   (let ((map (make-sparse-keymap)))
 
@@ -102,7 +104,7 @@
 
 
 ;; Should keypad numbers send ordinary digits or distinct escape sequences?
-(defun tvi970-set-keypad-mode (&optional arg)
+(define-minor-mode tvi970-set-keypad-mode
   "Set the current mode of the TVI 970 numeric keypad.
 In ``numeric keypad mode'', the number keys on the keypad act as
 ordinary digits.  In ``alternate keypad mode'', the keys send distinct
@@ -111,12 +113,9 @@
 With no argument, toggle between the two possible modes.
 With a positive argument, select alternate keypad mode.
 With a negative argument, select numeric keypad mode."
-  (interactive "P")
-  (let ((newval (if (null arg)
-                    (not (terminal-parameter nil 'tvi970-keypad-numeric))
-                  (> (prefix-numeric-value arg) 0))))
-    (set-terminal-parameter nil 'tvi970-keypad-numeric newval)
-    (send-string-to-terminal (if newval "\e=" "\e>"))))
+  :variable (terminal-parameter nil 'tvi970-keypad-numeric)
+  (send-string-to-terminal
+   (if (terminal-parameter nil 'tvi970-keypad-numeric) "\e=" "\e>")))
 
 ;; arch-tag: c1334cf0-1462-41c3-a963-c077d175f8f0
 ;;; tvi970.el ends here