/[emacs]/emacs/lisp/emacs-lisp/easy-mmode.el
ViewVC logotype

Diff of /emacs/lisp/emacs-lisp/easy-mmode.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.38 by rms, Mon Mar 4 22:26:57 2002 UTC revision 1.38.2.1 by miles, Fri Apr 4 06:20:16 2003 UTC
# Line 88  used (see below). Line 88  used (see below).
88    
89  BODY contains code that will be executed each time the mode is (dis)activated.  BODY contains code that will be executed each time the mode is (dis)activated.
90    It will be executed after any toggling but before running the hooks.    It will be executed after any toggling but before running the hooks.
91    BODY can start with a list of CL-style keys specifying additional arguments.    Before the actual body code, you can write
92    The following keyword arguments are supported:    keyword arguments (alternating keywords and values).
93  :group   Followed by the group name to use for any generated `defcustom'.    These following keyword arguments are supported (other keywords
94  :global  If non-nil specifies that the minor mode is not meant to be    will be passed to `defcustom' if the minor mode is global):
95           buffer-local.  By default, the variable is made buffer-local.  :group GROUP    Custom group name to use in all generated `defcustom' forms.
96  :init-value  Same as the INIT-VALUE argument.  :global GLOBAL  If non-nil specifies that the minor mode is not meant to be
97  :lighter  Same as the LIGHTER argument."                  buffer-local, so don't make the variable MODE buffer-local.
98                    By default, the mode is buffer-local.
99    :init-value VAL Same as the INIT-VALUE argument.
100    :lighter SPEC   Same as the LIGHTER argument.
101    :require SYM    Same as in `defcustom'.
102    
103    For example, you could write
104      (define-minor-mode foo-mode \"If enabled, foo on you!\"
105        :lighter \" Foo\" :require 'foo :global t :group 'hassle :version \"27.5\"
106        ...BODY CODE...)"
107    
108    ;; Allow skipping the first three args.    ;; Allow skipping the first three args.
109    (cond    (cond
110     ((keywordp init-value)     ((keywordp init-value)
# Line 107  BODY contains code that will be executed Line 117  BODY contains code that will be executed
117    (let* ((mode-name (symbol-name mode))    (let* ((mode-name (symbol-name mode))
118           (pretty-name (easy-mmode-pretty-mode-name mode lighter))           (pretty-name (easy-mmode-pretty-mode-name mode lighter))
119           (globalp nil)           (globalp nil)
          (togglep t) ;; This should never be nil -- rms.  
120           (group nil)           (group nil)
121           (extra-args nil)           (extra-args nil)
122             (extra-keywords nil)
123             (require t)
124           (keymap-sym (if (and keymap (symbolp keymap)) keymap           (keymap-sym (if (and keymap (symbolp keymap)) keymap
125                         (intern (concat mode-name "-map"))))                         (intern (concat mode-name "-map"))))
126           (hook (intern (concat mode-name "-hook")))           (hook (intern (concat mode-name "-hook")))
127           (hook-on (intern (concat mode-name "-on-hook")))           (hook-on (intern (concat mode-name "-on-hook")))
128           (hook-off (intern (concat mode-name "-off-hook"))))           (hook-off (intern (concat mode-name "-off-hook")))
129             keyw)
130    
131      ;; Check keys.      ;; Check keys.
132      (while (keywordp (car body))      (while (keywordp (setq keyw (car body)))
133        (case (pop body)        (setq body (cdr body))
134          (case keyw
135          (:init-value (setq init-value (pop body)))          (:init-value (setq init-value (pop body)))
136          (:lighter (setq lighter (pop body)))          (:lighter (setq lighter (pop body)))
137          (:global (setq globalp (pop body)))          (:global (setq globalp (pop body)))
138          (:extra-args (setq extra-args (pop body)))          (:extra-args (setq extra-args (pop body)))
139          (:group (setq group (nconc group (list :group (pop body)))))          (:group (setq group (nconc group (list :group (pop body)))))
140          (t (pop body))))          (:require (setq require (pop body)))
141            (t (push keyw extra-keywords) (push (pop body) extra-keywords))))
142    
143      (unless group      (unless group
144        ;; We might as well provide a best-guess default group.        ;; We might as well provide a best-guess default group.
145        (setq group        (setq group
146              `(:group ',(intern (replace-regexp-in-string "-mode\\'" ""              `(:group ',(or (custom-current-group)
147                                                           mode-name)))))                             (intern (replace-regexp-in-string
148      ;; Add default properties to LIGHTER.                                      "-mode\\'" "" mode-name))))))
     (unless (or (not (stringp lighter)) (get-text-property 0 'local-map lighter)  
                 (get-text-property 0 'keymap lighter))  
       (setq lighter  
             (propertize lighter  
                         'local-map mode-line-minor-mode-keymap  
                         'help-echo "mouse-3: minor mode menu")))  
149    
150      `(progn      `(progn
151         ;; Define the variable to enable or disable the mode.         ;; Define the variable to enable or disable the mode.
# Line 156  See the command `%s' for a description o Line 164  See the command `%s' for a description o
164  Setting this variable directly does not take effect;  Setting this variable directly does not take effect;
165  use either \\[customize] or the function `%s'."  use either \\[customize] or the function `%s'."
166                          pretty-name mode mode)                          pretty-name mode mode)
167                 :set (lambda (symbol value) (funcall symbol (or value 0)))                 :set 'custom-set-minor-mode
168                 :initialize 'custom-initialize-default                 :initialize 'custom-initialize-default
169                 ,@group                 ,@group
170                 :type 'boolean                 :type 'boolean
171                 ,@(when curfile                 ,@(cond
172                     (list                    ((not (and curfile require)) nil)
173                      :require                    ((not (eq require t)) `(:require ,require))
174                      (list 'quote                    (t `(:require
175                            (intern (file-name-nondirectory                         ',(intern (file-name-nondirectory
176                                     (file-name-sans-extension curfile)))))))))                                    (file-name-sans-extension curfile))))))
177                   ,@(nreverse extra-keywords))))
178    
179         ;; The actual function.         ;; The actual function.
180         (defun ,mode (&optional arg ,@extra-args)         (defun ,mode (&optional arg ,@extra-args)
181           ,(or doc           ,(or doc
182                (format (concat "Toggle %s on or off.                (format (concat "Toggle %s on or off.
183  Interactively, with no prefix argument, toggle the mode.  Interactively, with no prefix argument, toggle the mode.
184  With universal prefix ARG " (unless togglep "(or if ARG is nil) ") "turn mode on.  With universal prefix ARG turn mode on.
185  With zero or negative ARG turn mode off.  With zero or negative ARG turn mode off.
186  \\{%s}") pretty-name keymap-sym))  \\{%s}") pretty-name keymap-sym))
187           ;; Make no arg by default in an interactive call,           ;; Use `toggle' rather than (if ,mode 0 1) so that using
188           ;; so that repeating the command toggles again.           ;; repeat-command still does the toggling correctly.
189           (interactive "P")           (interactive (list (or current-prefix-arg 'toggle)))
190           (setq ,mode           (setq ,mode
191                 (if arg                 (cond
192                     (> (prefix-numeric-value arg) 0)                  ((eq arg 'toggle) (not ,mode))
193                   ,(if togglep `(not ,mode) t)))                  (arg (> (prefix-numeric-value arg) 0))
194                    (t
195                     (if (null ,mode) t
196                       (message
197                        "Toggling %s off; better pass an explicit argument."
198                        ',mode)
199                       nil))))
200           ,@body           ,@body
201           ;; The on/off hooks are here for backward compatibility only.           ;; The on/off hooks are here for backward compatibility only.
202           (run-hooks ',hook (if ,mode ',hook-on ',hook-off))           (run-hooks ',hook (if ,mode ',hook-on ',hook-off))
          ;; Return the new setting.  
203           (if (interactive-p)           (if (interactive-p)
204               (message ,(format "%s %%sabled" pretty-name)               (progn
205                        (if ,mode "en" "dis")))                 ,(if globalp `(customize-mark-as-set ',mode))
206                   (message ,(format "%s %%sabled" pretty-name)
207                            (if ,mode "en" "dis"))))
208           (force-mode-line-update)           (force-mode-line-update)
209             ;; Return the new setting.
210           ,mode)           ,mode)
211    
212         ;; Autoloading an easy-mmode-define-minor-mode autoloads         ;; Autoloading an easy-mmode-define-minor-mode autoloads
# Line 199  With zero or negative ARG turn mode off. Line 216  With zero or negative ARG turn mode off.
216         ;; The toggle's hook.         ;; The toggle's hook.
217         (defcustom ,hook nil         (defcustom ,hook nil
218           ,(format "Hook run at the end of function `%s'." mode-name)           ,(format "Hook run at the end of function `%s'." mode-name)
219           :group ,(cadr group)           ,@group
220           :type 'hook)           :type 'hook)
221    
222         ;; Define the minor-mode keymap.         ;; Define the minor-mode keymap.
# Line 215  With zero or negative ARG turn mode off. Line 232  With zero or negative ARG turn mode off.
232                         ,(if keymap keymap-sym                         ,(if keymap keymap-sym
233                            `(if (boundp ',keymap-sym)                            `(if (boundp ',keymap-sym)
234                                 (symbol-value ',keymap-sym))))                                 (symbol-value ',keymap-sym))))
235          
236         ;; If the mode is global, call the function according to the default.         ;; If the mode is global, call the function according to the default.
237         ,(if globalp         ,(if globalp
238              `(if (and load-file-name ,mode)              `(if (and load-file-name (not (equal ,init-value ,mode)))
239                   (eval-after-load load-file-name '(,mode 1)))))))                   (eval-after-load load-file-name '(,mode (if ,mode 1 -1))))))))
240    
241  ;;;  ;;;
242  ;;; make global minor mode  ;;; make global minor mode
# Line 251  KEYS is a list of CL-style keyword argum Line 268  KEYS is a list of CL-style keyword argum
268      (unless group      (unless group
269        ;; We might as well provide a best-guess default group.        ;; We might as well provide a best-guess default group.
270        (setq group        (setq group
271              `(:group ',(intern (replace-regexp-in-string "-mode\\'" ""              `(:group ',(or (custom-current-group)
272                                                           (symbol-name mode))))))                             (intern (replace-regexp-in-string
273                                        "-mode\\'" "" (symbol-name mode)))))))
274    
275      `(progn      `(progn
276         ;; The actual global minor-mode         ;; The actual global minor-mode
277         (define-minor-mode ,global-mode         (define-minor-mode ,global-mode
# Line 266  in which `%s' turns it on." Line 285  in which `%s' turns it on."
285           ;; Setup hook to handle future mode changes and new buffers.           ;; Setup hook to handle future mode changes and new buffers.
286           (if ,global-mode           (if ,global-mode
287               (progn               (progn
288                 (add-hook 'find-file-hooks ',buffers)                 (add-hook 'find-file-hook ',buffers)
289                 (add-hook 'change-major-mode-hook ',cmmh))                 (add-hook 'change-major-mode-hook ',cmmh))
290             (remove-hook 'find-file-hooks ',buffers)             (remove-hook 'find-file-hook ',buffers)
291             (remove-hook 'change-major-mode-hook ',cmmh))             (remove-hook 'change-major-mode-hook ',cmmh))
292    
293           ;; Go through existing buffers.           ;; Go through existing buffers.
# Line 290  in which `%s' turns it on." Line 309  in which `%s' turns it on."
309             (let ((buf (pop ,buffers)))             (let ((buf (pop ,buffers)))
310               (when (buffer-live-p buf)               (when (buffer-live-p buf)
311                 (with-current-buffer buf (,turn-on))))))                 (with-current-buffer buf (,turn-on))))))
312           (put ',buffers 'definition-name ',global-mode)
313    
314         ;; The function that catches kill-all-local-variables.         ;; The function that catches kill-all-local-variables.
315         (defun ,cmmh ()         (defun ,cmmh ()
316           (add-to-list ',buffers (current-buffer))           (add-to-list ',buffers (current-buffer))
317           (add-hook 'post-command-hook ',buffers)))))           (add-hook 'post-command-hook ',buffers))
318           (put ',cmmh 'definition-name ',global-mode))))
319    
320  ;;;  ;;;
321  ;;; easy-mmode-defmap  ;;; easy-mmode-defmap

Legend:
Removed from v.1.38  
changed lines
  Added in v.1.38.2.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26