Mercurial > emacs
comparison lisp/emacs-lisp/easy-mmode.el @ 29406:f4b12c3efee8
(easy-mmode-define-toggle): Remove (inline into define-minor-mode).
(easy-mmode-pretty-mode-name): Rename from easy-mmode-derive-name
and improve to use the lighter to guess the capitalization.
(define-minor-mode): Inline code from easy-mmode-define-toggle.
Add keyword arguments to specify global-ness or the custom group.
Add local-map and help-echo properties to the lighter.
(easy-mmode-define-navigation): Add the errors to debug-ignored-errors.
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Sun, 04 Jun 2000 20:55:25 +0000 |
parents | addeae19bf96 |
children | 232f7e558a38 |
comparison
equal
deleted
inserted
replaced
29405:b32f6068a250 | 29406:f4b12c3efee8 |
---|---|
49 ;; Additionally to `define-minor-mode', the package provides convenient | 49 ;; Additionally to `define-minor-mode', the package provides convenient |
50 ;; ways to define keymaps, and other helper functions for major and minor modes. | 50 ;; ways to define keymaps, and other helper functions for major and minor modes. |
51 | 51 |
52 ;;; Code: | 52 ;;; Code: |
53 | 53 |
54 (defmacro easy-mmode-define-toggle (mode &optional doc &rest body) | 54 (defun easy-mmode-pretty-mode-name (mode &optional lighter) |
55 "Define a one arg toggle mode MODE function and associated hooks. | 55 "Turn the symbol MODE into a string intended for the user. |
56 MODE is the so defined function that toggles the mode. | 56 If provided LIGHTER will be used to help choose capitalization." |
57 optional DOC is its associated documentation. | 57 (let* ((case-fold-search t) |
58 BODY is executed after the toggling and before running MODE-hook." | 58 (name (concat (capitalize (replace-regexp-in-string |
59 (let* ((mode-name (symbol-name mode)) | 59 "-mode\\'" "" (symbol-name mode))) |
60 (pretty-name (easy-mmode-derive-name mode-name)) | 60 " mode"))) |
61 (hook (intern (concat mode-name "-hook"))) | 61 (if (not (stringp lighter)) name |
62 (hook-on (intern (concat mode-name "-on-hook"))) | 62 (setq lighter (replace-regexp-in-string "\\`\\s-+\\|\\-s+\\'" "" lighter)) |
63 (hook-off (intern (concat mode-name "-off-hook"))) | 63 (replace-regexp-in-string lighter lighter name t t)))) |
64 (toggle-doc (or doc | |
65 (format "With no argument, toggle %s. | |
66 With universal prefix ARG turn mode on. | |
67 With zero or negative ARG turn mode off. | |
68 \\{%s}" pretty-name (concat mode-name "-map"))))) | |
69 `(progn | |
70 (defcustom ,hook nil | |
71 ,(format "Hook called at the end of function `%s'." mode-name) | |
72 :type 'hook) | |
73 | |
74 (defun ,mode (&optional arg) | |
75 ,toggle-doc | |
76 (interactive "P") | |
77 (setq ,mode | |
78 (if arg | |
79 (> (prefix-numeric-value arg) 0) | |
80 (not ,mode))) | |
81 ,@body | |
82 ;; The on/off hooks are here for backward compatibility. | |
83 (run-hooks ',hook (if ,mode ',hook-on ',hook-off)) | |
84 ;; Return the new setting. | |
85 (if (interactive-p) | |
86 (message ,(format "%s %%sabled" pretty-name) | |
87 (if ,mode "en" "dis"))) | |
88 ,mode)))) | |
89 | |
90 (defun easy-mmode-derive-name (mode) | |
91 (replace-regexp-in-string | |
92 "-Mode" " mode" (capitalize (symbol-name mode)) t)) | |
93 | 64 |
94 ;;;###autoload | 65 ;;;###autoload |
95 (defalias 'easy-mmode-define-minor-mode 'define-minor-mode) | 66 (defalias 'easy-mmode-define-minor-mode 'define-minor-mode) |
96 ;;;###autoload | 67 ;;;###autoload |
97 (defmacro define-minor-mode (mode doc &optional init-value lighter keymap &rest body) | 68 (defmacro define-minor-mode (mode doc &optional init-value lighter keymap &rest body) |
98 "Define a new minor mode MODE. | 69 "Define a new minor mode MODE. |
99 This function defines the associated control variable, keymap, | 70 This function defines the associated control variable MODE, keymap MODE-map, |
100 toggle command, and hooks (see `easy-mmode-define-toggle'). | 71 toggle command MODE, and hook MODE-hook. |
101 | 72 |
102 DOC is the documentation for the mode toggle command. | 73 DOC is the documentation for the mode toggle command. |
103 Optional INIT-VALUE is the initial value of the mode's variable. | 74 Optional INIT-VALUE is the initial value of the mode's variable. |
104 By default, the variable is made buffer-local. This can be overridden | |
105 by specifying an initial value of (global . INIT-VALUE). | |
106 Optional LIGHTER is displayed in the modeline when the mode is on. | 75 Optional LIGHTER is displayed in the modeline when the mode is on. |
107 Optional KEYMAP is the default (defvar) keymap bound to the mode keymap. | 76 Optional KEYMAP is the default (defvar) keymap bound to the mode keymap. |
108 If it is a list, it is passed to `easy-mmode-define-keymap' | 77 If it is a list, it is passed to `easy-mmode-define-keymap' |
109 in order to build a valid keymap. | 78 in order to build a valid keymap. |
110 BODY contains code that will be executed each time the mode is (dis)activated. | 79 BODY contains code that will be executed each time the mode is (dis)activated. |
111 It will be executed after any toggling but before running the hooks." | 80 It will be executed after any toggling but before running the hooks. |
81 BODY can start with a list of CL-style keys specifying additional arguments. | |
82 Currently two such keyword arguments are supported: | |
83 :group followed by the group name to use for any generated `defcustom'. | |
84 :global if non-nil specifies that the minor mode is not meant to be | |
85 buffer-local. By default, the variable is made buffer-local." | |
112 (let* ((mode-name (symbol-name mode)) | 86 (let* ((mode-name (symbol-name mode)) |
87 (pretty-name (easy-mmode-pretty-mode-name mode lighter)) | |
113 (globalp nil) | 88 (globalp nil) |
89 ;; We might as well provide a best-guess default group. | |
90 (group (intern (replace-regexp-in-string "-mode\\'" "" mode-name))) | |
114 (keymap-sym (intern (concat mode-name "-map"))) | 91 (keymap-sym (intern (concat mode-name "-map"))) |
115 (keymap-doc (format "Keymap for `%s'." mode-name))) | 92 (hook (intern (concat mode-name "-hook"))) |
116 ;; Check if the mode should be global. | 93 (hook-on (intern (concat mode-name "-on-hook"))) |
94 (hook-off (intern (concat mode-name "-off-hook")))) | |
95 | |
96 ;; FIXME: compatibility that should be removed. | |
117 (when (and (consp init-value) (eq (car init-value) 'global)) | 97 (when (and (consp init-value) (eq (car init-value) 'global)) |
118 (setq init-value (cdr init-value) globalp t)) | 98 (setq init-value (cdr init-value) globalp t)) |
99 | |
100 ;; Check keys. | |
101 (while | |
102 (case (car body) | |
103 (:global (setq body (cdr body)) (setq globalp (pop body))) | |
104 (:group (setq body (cdr body)) (setq group (pop body))))) | |
105 | |
106 ;; Add default properties to LIGHTER. | |
107 (unless (or (not (stringp lighter)) (get-text-property 0 'local-map lighter) | |
108 (get-text-property 0 'keymap lighter)) | |
109 (setq lighter | |
110 (apply 'propertize lighter | |
111 'local-map (make-mode-line-mouse2-map mode) | |
112 (unless (get-text-property 0 'help-echo lighter) | |
113 (list 'help-echo | |
114 (format "mouse-2: turn off %s" pretty-name)))))) | |
119 | 115 |
120 `(progn | 116 `(progn |
121 ;; Define the variable to enable or disable the mode. | 117 ;; Define the variable to enable or disable the mode. |
122 ,(if globalp | 118 ,(if globalp |
123 `(defcustom ,mode ,init-value | 119 `(defcustom ,mode ,init-value |
124 ,(format "Toggle %s. | 120 ,(format "Toggle %s. |
125 Setting this variable directly does not take effect; | 121 Setting this variable directly does not take effect; |
126 use either \\[customize] or the function `%s'." | 122 use either \\[customize] or the function `%s'." |
127 (easy-mmode-derive-name mode) mode) | 123 pretty-name mode) |
128 :set (lambda (symbol value) (funcall symbol (or value 0))) | 124 :set (lambda (symbol value) (funcall symbol (or value 0))) |
129 :initialize 'custom-initialize-default | 125 :initialize 'custom-initialize-default |
126 :group ',group | |
130 :type 'boolean) | 127 :type 'boolean) |
131 `(progn | 128 `(progn |
132 (defvar ,mode ,init-value ,(format "Non-nil if mode is enabled. | 129 (defvar ,mode ,init-value ,(format "Non-nil if %s is enabled. |
133 Use the function `%s' to change this variable." mode)) | 130 Use the function `%s' to change this variable." pretty-name mode)) |
134 (make-variable-buffer-local ',mode))) | 131 (make-variable-buffer-local ',mode))) |
135 | 132 |
136 ;; Define the minor-mode keymap. | 133 ;; Define the minor-mode keymap. |
137 ,(when keymap | 134 ,(when keymap |
138 `(defvar ,keymap-sym | 135 `(defvar ,keymap-sym |
139 (cond ((and ,keymap (keymapp ,keymap)) | 136 (cond ((and ,keymap (keymapp ,keymap)) |
140 ,keymap) | 137 ,keymap) |
141 ((listp ,keymap) | 138 ((listp ,keymap) |
142 (easy-mmode-define-keymap ,keymap)) | 139 (easy-mmode-define-keymap ,keymap)) |
143 (t (error "Invalid keymap %S" ,keymap))) | 140 (t (error "Invalid keymap %S" ,keymap))) |
144 ,keymap-doc)) | 141 ,(format "Keymap for `%s'." mode-name))) |
145 | 142 |
146 ;; Define the toggle and the hooks. | 143 ;; The toggle's hook. |
147 (easy-mmode-define-toggle ,mode ,doc ,@body) | 144 (defcustom ,hook nil |
148 (add-minor-mode ',mode ,lighter | 145 ,(format "Hook run at the end of function `%s'." mode-name) |
146 :group ',group | |
147 :type 'hook) | |
148 | |
149 ;; The actual function. | |
150 (defun ,mode (&optional arg) | |
151 ,(or doc | |
152 (format "With no argument, toggle %s. | |
153 With universal prefix ARG turn mode on. | |
154 With zero or negative ARG turn mode off. | |
155 \\{%s}" pretty-name keymap-sym)) | |
156 (interactive "P") | |
157 (setq ,mode | |
158 (if arg | |
159 (> (prefix-numeric-value arg) 0) | |
160 (not ,mode))) | |
161 ,@body | |
162 ;; The on/off hooks are here for backward compatibility only. | |
163 (run-hooks ',hook (if ,mode ',hook-on ',hook-off)) | |
164 ;; Return the new setting. | |
165 (if (interactive-p) | |
166 (message ,(format "%s %%sabled" pretty-name) | |
167 (if ,mode "en" "dis"))) | |
168 ,mode) | |
169 | |
170 (add-minor-mode ',mode ',lighter | |
149 (if (boundp ',keymap-sym) (symbol-value ',keymap-sym))) | 171 (if (boundp ',keymap-sym) (symbol-value ',keymap-sym))) |
150 | 172 |
151 ;; If the mode is global, call the function according to the default. | 173 ;; If the mode is global, call the function according to the default. |
152 ,(if globalp `(if ,mode (,mode 1)))))) | 174 ,(if globalp `(if ,mode (,mode 1)))))) |
153 | 175 |
379 (let* ((base-name (symbol-name base)) | 401 (let* ((base-name (symbol-name base)) |
380 (prev-sym (intern (concat base-name "-prev"))) | 402 (prev-sym (intern (concat base-name "-prev"))) |
381 (next-sym (intern (concat base-name "-next")))) | 403 (next-sym (intern (concat base-name "-next")))) |
382 (unless name (setq name (symbol-name base-name))) | 404 (unless name (setq name (symbol-name base-name))) |
383 `(progn | 405 `(progn |
406 (add-to-list 'debug-ignored-errors | |
407 ,(concat "^No \\(previous\\|next\\) " (regexp-quote name))) | |
384 (defun ,next-sym (&optional count) | 408 (defun ,next-sym (&optional count) |
385 ,(format "Go to the next COUNT'th %s." name) | 409 ,(format "Go to the next COUNT'th %s." name) |
386 (interactive) | 410 (interactive) |
387 (unless count (setq count 1)) | 411 (unless count (setq count 1)) |
388 (if (< count 0) (,prev-sym (- count)) | 412 (if (< count 0) (,prev-sym (- count)) |