From: Stefan Monnier Date: Wed, 5 May 2010 03:45:21 +0000 (-0400) Subject: Use define-minor-mode in more cases. X-Git-Tag: emacs-pretest-24.0.90~104^2~275^2~438^2~278 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=80ac5d4d34b34947df9b0088d81ec02aa10a93b5;p=emacs.git 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. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 3edaea5d623..f2ebf07fd87 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,15 @@ 2010-05-05 Stefan Monnier + 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): diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index bb5fd5037a1..e828325bd0e 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el @@ -282,7 +282,7 @@ Not documented ;;;;;; 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" "\ diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index e48835adeb1..57870b19066 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -1826,7 +1826,17 @@ Example: ;; (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 diff --git a/lisp/scroll-bar.el b/lisp/scroll-bar.el index 3f763fc59da..ebc00859137 100644 --- a/lisp/scroll-bar.el +++ b/lisp/scroll-bar.el @@ -29,6 +29,7 @@ ;;; Code: (require 'mouse) +(eval-when-compile (require 'cl)) ;;;; Utilities. @@ -79,9 +80,6 @@ SIDE must be the symbol `left' or `right'." "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 @@ Setting the variable with a customization buffer also takes effect." ;; 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. diff --git a/lisp/simple.el b/lisp/simple.el index 37ad0d81ca0..8e45ca4694d 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -5149,7 +5149,7 @@ Some major modes set this.") (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 @@ automatically breaks the line at a previous space. 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 @@ if long lines are truncated." (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 @@ it to the right. At the end of a line, such characters extend the line. 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 @@ replaces the text at the cursor, just as ordinary typing characters do. 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 @@ call `normal-erase-is-backspace-mode' (which see) instead." 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 @@ probably not turn on this mode on a text-only terminal if you don't 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 @@ See also `normal-erase-is-backspace'." (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)) diff --git a/lisp/term/tvi970.el b/lisp/term/tvi970.el index 389adcde6c4..4476165febc 100644 --- a/lisp/term/tvi970.el +++ b/lisp/term/tvi970.el @@ -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 @@ independent of the normal number keys. 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