Mercurial > hg > xemacs-beta
annotate lisp/easy-mmode.el @ 5635:2fc3f2f35523
Put back compatibility alias for #'cl-puthash, used by 21.4's setf expansion
2012-01-02 Aidan Kehoe <kehoea@parhasard.net>
* obsolete.el (cl-puthash): Put back a compatibility alias for
this, setf-expansion of #'gethash calls it on 21.4, so it will
occur in packages for a while to come.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Mon, 02 Jan 2012 13:35:31 +0000 |
| parents | 308d34e9f07d |
| children |
| rev | line source |
|---|---|
| 2548 | 1 ;;; easy-mmode.el --- easy definition for major and minor modes |
| 2 | |
| 3 ;; Copyright (C) 1997, 2000, 2001 Free Software Foundation, Inc. | |
| 4 | |
| 5 ;; Author: Georges Brun-Cottan <Georges.Brun-Cottan@inria.fr> | |
| 6 ;; Maintainer: Stefan Monnier <monnier@gnu.org> | |
| 7 | |
| 8 ;; Keywords: extensions lisp | |
| 9 | |
| 10 ;; This file is part of XEmacs. | |
| 11 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4783
diff
changeset
|
12 ;; XEmacs is free software: you can redistribute it and/or modify it |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4783
diff
changeset
|
13 ;; under the terms of the GNU General Public License as published by the |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4783
diff
changeset
|
14 ;; Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4783
diff
changeset
|
15 ;; option) any later version. |
| 2548 | 16 |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4783
diff
changeset
|
17 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4783
diff
changeset
|
18 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4783
diff
changeset
|
19 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4783
diff
changeset
|
20 ;; for more details. |
| 2548 | 21 |
| 22 ;; You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4783
diff
changeset
|
23 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
| 2548 | 24 |
| 25 ;;; Synched up with: GNU Emacs 21.3. | |
| 26 | |
| 27 ;;; Commentary: | |
| 28 | |
| 29 ;; Minor modes are useful and common. This package makes defining a | |
| 30 ;; minor mode easy, by focusing on the writing of the minor mode | |
| 31 ;; functionalities themselves. Moreover, this package enforces a | |
| 32 ;; conventional naming of user interface primitives, making things | |
| 33 ;; natural for the minor-mode end-users. | |
| 34 | |
| 35 ;; For each mode, easy-mmode defines the following: | |
| 36 ;; <mode> : The minor mode predicate. A buffer-local variable. | |
| 37 ;; <mode>-map : The keymap possibly associated to <mode>. | |
| 38 ;; <mode>-hook,<mode>-on-hook,<mode>-off-hook and <mode>-mode: | |
| 39 ;; see `define-minor-mode' documentation | |
| 40 ;; | |
| 41 ;; eval | |
| 42 ;; (pp (macroexpand '(define-minor-mode <your-mode> <doc>))) | |
| 43 ;; to check the result before using it. | |
| 44 | |
| 45 ;; The order in which minor modes are installed is important. Keymap | |
| 46 ;; lookup proceeds down minor-mode-map-alist, and the order there | |
| 47 ;; tends to be the reverse of the order in which the modes were | |
| 48 ;; installed. Perhaps there should be a feature to let you specify | |
| 49 ;; orderings. | |
| 50 | |
| 51 ;; Additionally to `define-minor-mode', the package provides convenient | |
| 52 ;; ways to define keymaps, and other helper functions for major and minor | |
| 53 ;; modes. | |
| 54 | |
| 55 ;;; Code: | |
| 56 | |
| 57 (eval-when-compile (require 'cl)) | |
| 58 | |
| 59 ;;; This file uses two functions that did not exist in some versions of | |
| 60 ;;; XEmacs: propertize and replace-regexp-in-string. We provide these | |
| 61 ;;; functions here for such XEmacsen. | |
| 62 ;;; | |
| 63 ;;; FIXME: These function definitions should go into the future or | |
| 64 ;;; forward-compat package, once that package exists. | |
| 65 | |
| 66 ;; XEmacs <= 21.4 does not have propertize, but XEmacs >= 21.5 dumps it (it is | |
| 67 ;; defined in subr.el). Therefore, it is either defined regardless of what | |
| 68 ;; has been loaded already, or it won't be defined regardless of what is | |
| 69 ;; loaded. | |
| 70 (if (not (fboundp 'propertize)) | |
| 71 (defun propertize (string &rest properties) | |
| 72 "Return a copy of STRING with text properties added. | |
| 73 First argument is the string to copy. | |
| 74 Remaining arguments form a sequence of PROPERTY VALUE pairs for text | |
| 75 properties to add to the result." | |
| 76 (let ((str (copy-sequence string))) | |
| 77 (add-text-properties 0 (length str) | |
| 78 properties | |
| 79 str) | |
| 80 str))) | |
| 81 | |
| 82 ;; XEmacs <= 21.4 does not have replace-regexp-in-string, but XEmacs >= 21.5 | |
| 83 ;; dumps it (it is defined in subr.el). Therefore, it is either defined | |
| 84 ;; regardless of what has been loaded already, or it won't be defined | |
| 85 ;; regardless of what is loaded. | |
| 86 (if (not (fboundp 'replace-regexp-in-string)) | |
| 87 (defun replace-regexp-in-string (regexp rep string &optional | |
| 88 fixedcase literal subexp start) | |
| 89 "Replace all matches for REGEXP with REP in STRING. | |
| 90 | |
| 91 Return a new string containing the replacements. | |
| 92 | |
| 93 Optional arguments FIXEDCASE, LITERAL and SUBEXP are like the | |
| 94 arguments with the same names of function `replace-match'. If START | |
| 95 is non-nil, start replacements at that index in STRING. | |
| 96 | |
| 97 REP is either a string used as the NEWTEXT arg of `replace-match' or a | |
| 98 function. If it is a function it is applied to each match to generate | |
| 99 the replacement passed to `replace-match'; the match-data at this | |
| 100 point are such that match 0 is the function's argument. | |
| 101 | |
| 102 To replace only the first match (if any), make REGEXP match up to \\' | |
| 103 and replace a sub-expression, e.g. | |
| 104 (replace-regexp-in-string \"\\(foo\\).*\\'\" \"bar\" \" foo foo\" nil nil 1) | |
| 105 => \" bar foo\" | |
| 106 " | |
| 107 (let ((l (length string)) | |
| 108 (start (or start 0)) | |
| 109 matches str mb me) | |
| 110 (save-match-data | |
| 111 (while (and (< start l) (string-match regexp string start)) | |
| 112 (setq mb (match-beginning 0) | |
| 113 me (match-end 0)) | |
| 114 ;; If we matched the empty string, make sure we advance by one char | |
| 115 (when (= me mb) (setq me (min l (1+ mb)))) | |
| 116 ;; Generate a replacement for the matched substring. | |
| 117 ;; Operate only on the substring to minimize string consing. | |
| 118 ;; Set up match data for the substring for replacement; | |
| 119 ;; presumably this is likely to be faster than munging the | |
| 120 ;; match data directly in Lisp. | |
| 121 (string-match regexp (setq str (substring string mb me))) | |
| 122 (setq matches | |
| 123 (cons (replace-match (if (stringp rep) | |
| 124 rep | |
| 125 (funcall rep (match-string 0 str))) | |
| 126 fixedcase literal str subexp) | |
| 127 (cons (substring string start mb) ; unmatched prefix | |
| 128 matches))) | |
| 129 (setq start me)) | |
| 130 ;; Reconstruct a string from the pieces. | |
| 131 (setq matches (cons (substring string start l) matches)) ; leftover | |
| 132 (apply #'concat (nreverse matches)))))) | |
| 133 | |
| 134 | |
| 135 (defun easy-mmode-pretty-mode-name (mode &optional lighter) | |
| 136 "Turn the symbol MODE into a string intended for the user. | |
| 137 If provided LIGHTER will be used to help choose capitalization." | |
| 138 (let* ((case-fold-search t) | |
| 139 (name (concat (replace-regexp-in-string | |
| 140 "-Minor" " minor" | |
| 141 (capitalize (replace-regexp-in-string | |
| 142 "-mode\\'" "" (symbol-name mode)))) | |
| 143 " mode"))) | |
| 144 (if (not (stringp lighter)) name | |
| 145 (setq lighter | |
| 146 (replace-regexp-in-string "\\`\\s-+\\|\\-s+\\'" "" lighter)) | |
| 147 (replace-regexp-in-string lighter lighter name t t)))) | |
| 148 | |
| 149 ;; XEmacs change: add -on-hook, -off-hook, and macro parameter documentation. | |
| 150 ;;;###no-autoload | |
| 151 (defalias 'easy-mmode-define-minor-mode 'define-minor-mode) | |
| 152 ;;;###no-autoload | |
| 153 (defmacro define-minor-mode (mode doc &optional init-value lighter keymap &rest body) | |
| 154 "Define a new minor mode MODE. | |
| 155 This function defines the associated control variable MODE, keymap MODE-map, | |
| 156 toggle command MODE, and hook MODE-hook. | |
| 157 | |
| 158 DOC is the documentation for the mode toggle command. | |
| 159 Optional INIT-VALUE is the initial value of the mode's variable. | |
| 160 Optional LIGHTER is displayed in the modeline when the mode is on. | |
| 161 Optional KEYMAP is the default (defvar) keymap bound to the mode keymap. | |
| 162 If it is a list, it is passed to `easy-mmode-define-keymap' | |
| 163 in order to build a valid keymap. It's generally better to use | |
| 164 a separate MODE-map variable than to use this argument. | |
| 165 The above three arguments can be skipped if keyword arguments are | |
| 166 used (see below). | |
| 167 | |
| 168 BODY contains code that will be executed each time the mode is (de)activated. | |
| 169 It will be executed after any toggling but before running the hooks. | |
| 170 Before the actual body code, you can write | |
| 171 keyword arguments (alternating keywords and values). | |
| 172 These following keyword arguments are supported: | |
| 173 :group GROUP Custom group name to use in all generated `defcustom' forms. | |
| 174 :global GLOBAL If non-nil specifies that the minor mode is not meant to be | |
| 175 buffer-local, so don't make the variable MODE buffer-local. | |
| 176 By default, the mode is buffer-local. | |
| 177 :init-value VAL Same as the INIT-VALUE argument. | |
| 178 :lighter SPEC Same as the LIGHTER argument. | |
| 179 :require SYM Same as in `defcustom'. | |
| 180 | |
| 181 For backwards compatibility, these hooks are run each time the mode is | |
| 182 \(de)activated. When the mode is toggled, MODE-hook is always run before the | |
| 183 other hook. | |
| 184 MODE-hook: run if the mode is toggled. | |
| 185 MODE-on-hook: run if the mode is activated. | |
| 186 MODE-off-hook: run if the mode is deactivated. | |
| 187 | |
| 188 \(defmacro easy-mmode-define-minor-mode | |
| 189 (MODE DOC &optional INIT-VALUE LIGHTER KEYMAP &rest BODY)...\) | |
| 190 | |
| 191 For example, you could write | |
| 192 (define-minor-mode foo-mode \"If enabled, foo on you!\" | |
| 193 nil \"Foo \" foo-keymap | |
| 194 :require 'foo :global t :group 'inconvenience | |
| 195 ...BODY CODE...)" | |
| 196 | |
| 197 ;; Allow skipping the first three args. | |
| 198 (cond | |
| 199 ((keywordp init-value) | |
| 200 (setq body (list* init-value lighter keymap body) | |
| 201 init-value nil lighter nil keymap nil)) | |
| 202 ((keywordp lighter) | |
| 203 (setq body (list* lighter keymap body) lighter nil keymap nil)) | |
| 204 ((keywordp keymap) (push keymap body) (setq keymap nil))) | |
| 205 | |
| 206 (let* ((mode-name (symbol-name mode)) | |
| 207 (pretty-name (easy-mmode-pretty-mode-name mode lighter)) | |
| 208 (globalp nil) | |
| 209 (group nil) | |
| 210 (extra-args nil) | |
| 211 (require t) | |
| 212 (keymap-sym (if (and keymap (symbolp keymap)) keymap | |
| 213 (intern (concat mode-name "-map")))) | |
| 214 (hook (intern (concat mode-name "-hook"))) | |
| 215 (hook-on (intern (concat mode-name "-on-hook"))) | |
| 216 (hook-off (intern (concat mode-name "-off-hook")))) | |
| 217 | |
| 218 ;; Check keys. | |
| 219 (while (keywordp (car body)) | |
| 220 (case (pop body) | |
| 221 (:init-value (setq init-value (pop body))) | |
| 222 (:lighter (setq lighter (pop body))) | |
| 223 (:global (setq globalp (pop body))) | |
| 224 (:extra-args (setq extra-args (pop body))) | |
| 225 (:group (setq group (nconc group (list :group (pop body))))) | |
| 226 (:require (setq require (pop body))) | |
| 227 (t (pop body)))) | |
| 228 | |
| 229 (unless group | |
| 230 ;; We might as well provide a best-guess default group. | |
| 231 (setq group | |
| 232 `(:group ',(or (custom-current-group) | |
| 233 (intern (replace-regexp-in-string | |
| 234 "-mode\\'" "" mode-name)))))) | |
| 235 ;; Add default properties to LIGHTER. | |
| 236 ;; #### FSF comments this out in 21.3. | |
| 237 ; (unless (or (not (stringp lighter)) | |
| 238 ; (get-text-property 0 'local-map lighter) | |
| 239 ; (get-text-property 0 'keymap lighter)) | |
| 240 ; (setq lighter | |
| 241 ; (propertize lighter | |
| 242 ; 'local-map modeline-minor-mode-map ; XEmacs change | |
| 243 ; 'help-echo "mouse-3: minor mode menu"))) | |
| 244 | |
| 245 `(progn | |
| 246 ;; Define the variable to enable or disable the mode. | |
| 247 ,(if (not globalp) | |
| 248 `(progn | |
| 249 (defvar ,mode ,init-value ,(format "Non-nil if %s is enabled. | |
| 250 Use the command `%s' to change this variable." pretty-name mode)) | |
| 251 (make-variable-buffer-local ',mode)) | |
| 252 | |
| 253 (let ((curfile (or (and (boundp 'byte-compile-current-file) | |
| 254 byte-compile-current-file) | |
| 255 load-file-name))) | |
| 256 `(defcustom ,mode ,init-value | |
| 257 ,(format "Non-nil if %s is enabled. | |
| 258 See the command `%s' for a description of this minor-mode. | |
| 259 Setting this variable directly does not take effect; | |
| 260 use either \\[customize] or the function `%s'." | |
| 261 pretty-name mode mode) | |
| 262 :set (lambda (symbol value) (funcall symbol (or value 0))) | |
| 263 :initialize 'custom-initialize-default | |
| 264 ,@group | |
| 265 :type 'boolean | |
| 266 ,@(cond | |
| 267 ((not (and curfile require)) nil) | |
| 268 ((not (eq require t)) `(:require ,require)) | |
| 269 (t `(:require | |
| 270 ',(intern (file-name-nondirectory | |
| 271 (file-name-sans-extension curfile))))))))) | |
| 272 | |
| 273 ;; The actual function. | |
| 274 (defun ,mode (&optional arg ,@extra-args) | |
| 275 ,(or doc | |
| 276 (format (concat "Toggle %s on or off. | |
| 277 Interactively, with no prefix argument, toggle the mode. | |
| 278 With universal prefix ARG turn mode on. | |
| 279 With zero or negative ARG turn mode off. | |
| 280 \\{%s}") pretty-name keymap-sym)) | |
| 281 ;; Use `toggle' rather than (if ,mode 0 1) so that using | |
| 282 ;; repeat-command still does the toggling correctly. | |
| 283 (interactive (list (or current-prefix-arg 'toggle))) | |
| 284 ;; XEmacs addition: save the old mode | |
| 285 (let ((old-mode ,mode)) | |
| 286 (setq ,mode | |
| 287 (cond | |
| 288 ((eq arg 'toggle) (not ,mode)) | |
| 289 (arg (or (listp arg);; XEmacs addition: C-u alone | |
| 290 (> (prefix-numeric-value arg) 0))) | |
| 291 (t | |
| 292 (if (null ,mode) t | |
| 293 (message | |
| 294 "Toggling %s off; better pass an explicit argument." | |
| 295 ',mode) | |
| 296 nil)))) | |
| 297 ,@body | |
| 298 ;; The on/off hooks are here for backward compatibility only. | |
| 299 ;; The on/off hooks are here for backward compatibility only. | |
| 300 ;; XEmacs change: check mode before running hooks | |
| 301 (and ,hook | |
| 302 (not (equal old-mode ,mode)) | |
| 303 (run-hooks ',hook)) | |
| 304 (and ,hook-on | |
| 305 ,mode | |
| 306 (run-hooks ',hook-on)) | |
| 307 (and ,hook-off | |
| 308 (not ,mode) | |
| 309 (run-hooks ',hook-off))) | |
| 310 (if (interactive-p) | |
| 311 (progn | |
| 312 ,(if globalp `(customize-mark-as-set ',mode)) | |
| 313 (message ,(format "%s %%sabled" pretty-name) | |
| 314 (if ,mode "en" "dis")))) | |
| 315 (force-mode-line-update) | |
| 316 ;; Return the new setting. | |
| 317 ,mode) | |
| 318 | |
| 319 ;; Autoloading an easy-mmode-define-minor-mode autoloads | |
| 320 ;; everything up-to-here. | |
| 321 ;; | |
| 322 ;; XEmacs change: XEmacs does not support :autoload-end. On the other | |
| 323 ;; hand, I don't see why we need to support it. An autoload cookie | |
| 324 ;; just before a (define-minor-mode foo) form will generate an autoload | |
| 325 ;; form for the file with name foo. But that's exactly right, since | |
| 326 ;; the defun created just above here has the name foo. There are no | |
| 327 ;; other top-level forms created above here by the macro, so we're done. | |
| 328 ;; | |
| 329 ;;:autoload-end | |
| 330 | |
| 331 ;; The toggle's hook. | |
| 332 (defcustom ,hook nil | |
| 333 ,(format "Hook run at the end of function `%s'." mode-name) | |
| 334 ,@group | |
| 335 :type 'hook) | |
| 336 | |
| 337 ;; XEmacs addition: declare the on and off hooks also | |
| 338 (defcustom ,hook-on nil | |
| 339 ,(format "Hook to run when entering %s." mode-name) | |
| 340 :group ,(cadr group) | |
| 341 :type 'hook) | |
| 342 | |
| 343 (defcustom ,hook-off nil | |
| 344 ,(format "Hook to run when exiting %s." mode-name) | |
| 345 :group ,(cadr group) | |
| 346 :type 'hook) | |
| 347 | |
| 348 ;; Define the minor-mode keymap. | |
| 349 ,(unless (symbolp keymap) ;nil is also a symbol. | |
| 350 `(defvar ,keymap-sym | |
| 351 (let ((m ,keymap)) | |
| 352 (cond ((keymapp m) m) | |
| 353 ((listp m) (easy-mmode-define-keymap m)) | |
| 354 (t (error "Invalid keymap %S" ,keymap)))) | |
| 355 ,(format "Keymap for `%s'." mode-name))) | |
| 356 | |
| 357 (add-minor-mode ',mode ',lighter | |
| 358 ,(if keymap keymap-sym | |
| 359 `(if (boundp ',keymap-sym) | |
| 360 (symbol-value ',keymap-sym))) | |
| 361 ;; XEmacs change: supply the AFTER and TOGGLE-FUN args | |
| 362 t ',mode) | |
| 363 | |
| 364 ;; If the mode is global, call the function according to the default. | |
| 365 ,(if globalp | |
| 366 `(if (and load-file-name (not (equal ,init-value ,mode)) | |
| 367 ;; XEmacs addition: | |
| 368 (not purify-flag)) | |
| 369 (eval-after-load load-file-name '(,mode (if ,mode 1 -1)))))))) | |
| 370 | |
| 371 ;;; | |
| 372 ;;; make global minor mode | |
| 373 ;;; | |
| 374 | |
| 375 ;;;###no-autoload | |
| 376 (defmacro easy-mmode-define-global-mode (global-mode mode turn-on | |
| 377 &rest keys) | |
| 378 "Make GLOBAL-MODE out of the buffer-local minor MODE. | |
| 379 TURN-ON is a function that will be called with no args in every buffer | |
| 380 and that should try to turn MODE on if applicable for that buffer. | |
| 381 KEYS is a list of CL-style keyword arguments: | |
| 382 :group to specify the custom group." | |
| 383 (let* ((global-mode-name (symbol-name global-mode)) | |
| 384 (pretty-name (easy-mmode-pretty-mode-name mode)) | |
| 385 (pretty-global-name (easy-mmode-pretty-mode-name global-mode)) | |
| 386 (group nil) | |
| 387 (extra-args nil) | |
| 388 (buffers (intern (concat global-mode-name "-buffers"))) | |
| 389 (cmmh (intern (concat global-mode-name "-cmmh")))) | |
| 390 | |
| 391 ;; Check keys. | |
| 392 (while (keywordp (car keys)) | |
| 393 (case (pop keys) | |
| 394 (:extra-args (setq extra-args (pop keys))) | |
| 395 (:group (setq group (nconc group (list :group (pop keys))))) | |
| 396 (t (setq keys (cdr keys))))) | |
| 397 | |
| 398 (unless group | |
| 399 ;; We might as well provide a best-guess default group. | |
| 400 (setq group | |
| 401 `(:group ',(or (custom-current-group) | |
| 402 (intern (replace-regexp-in-string | |
| 403 "-mode\\'" "" (symbol-name mode))))))) | |
| 404 | |
| 405 `(progn | |
| 406 ;; The actual global minor-mode | |
| 407 (define-minor-mode ,global-mode | |
| 408 ,(format "Toggle %s in every buffer. | |
| 409 With prefix ARG, turn %s on if and only if ARG is positive. | |
| 410 %s is actually not turned on in every buffer but only in those | |
| 411 in which `%s' turns it on." | |
| 412 pretty-name pretty-global-name pretty-name turn-on) | |
| 413 :global t :extra-args ,extra-args ,@group | |
| 414 | |
| 415 ;; Setup hook to handle future mode changes and new buffers. | |
| 416 (if ,global-mode | |
| 417 ;; XEmacs: find-file-hooks not find-file-hook | |
| 418 (progn | |
| 419 (add-hook 'find-file-hooks ',buffers) | |
| 420 (add-hook 'change-major-mode-hook ',cmmh)) | |
| 421 (remove-hook 'find-file-hooks ',buffers) | |
| 422 (remove-hook 'change-major-mode-hook ',cmmh)) | |
| 423 | |
| 424 ;; Go through existing buffers. | |
| 425 (dolist (buf (buffer-list)) | |
| 426 (with-current-buffer buf | |
| 427 (if ,global-mode (,turn-on) (when ,mode (,mode -1)))))) | |
| 428 | |
| 429 ;; TODO: XEmacs does not support :autoload-end | |
| 430 ;; Autoloading easy-mmode-define-global-mode | |
| 431 ;; autoloads everything up-to-here. | |
| 432 :autoload-end | |
| 433 | |
| 434 ;; List of buffers left to process. | |
| 435 (defvar ,buffers nil) | |
| 436 | |
| 437 ;; The function that calls TURN-ON in each buffer. | |
| 438 (defun ,buffers () | |
| 439 (remove-hook 'post-command-hook ',buffers) | |
| 440 (while ,buffers | |
| 441 (let ((buf (pop ,buffers))) | |
| 442 (when (buffer-live-p buf) | |
| 443 (with-current-buffer buf (,turn-on)))))) | |
| 444 (put ',buffers 'definition-name ',global-mode) | |
| 445 | |
| 446 ;; The function that catches kill-all-local-variables. | |
| 447 (defun ,cmmh () | |
| 448 (add-to-list ',buffers (current-buffer)) | |
| 449 (add-hook 'post-command-hook ',buffers)) | |
| 450 (put ',cmmh 'definition-name ',global-mode)))) | |
| 451 | |
| 452 ;;; | |
| 453 ;;; easy-mmode-defmap | |
| 454 ;;; | |
| 455 | |
| 456 (if (fboundp 'set-keymap-parents) | |
| 457 (defalias 'easy-mmode-set-keymap-parents 'set-keymap-parents) | |
| 458 (defun easy-mmode-set-keymap-parents (m parents) | |
| 459 (set-keymap-parent | |
| 460 m | |
| 461 (cond | |
| 462 ((not (consp parents)) parents) | |
| 463 ((not (cdr parents)) (car parents)) | |
| 464 (t (let ((m (copy-keymap (pop parents)))) | |
| 465 (easy-mmode-set-keymap-parents m parents) | |
| 466 m)))))) | |
| 467 | |
| 468 ;;;###no-autoload | |
| 469 (defun easy-mmode-define-keymap (bs &optional name m args) | |
| 470 "Return a keymap built from bindings BS. | |
| 471 BS must be a list of (KEY . BINDING) where | |
| 472 KEY and BINDINGS are suitable for `define-key'. | |
| 473 Optional NAME is passed to `make-sparse-keymap'. | |
| 474 Optional map M can be used to modify an existing map. | |
| 475 ARGS is a list of additional keyword arguments." | |
| 476 (let (inherit dense ;suppress | |
| 477 ) | |
| 478 (while args | |
| 479 (let ((key (pop args)) | |
| 480 (val (pop args))) | |
| 481 (case key | |
| 482 (:name (setq name val)) | |
| 483 (:dense (setq dense val)) | |
| 484 (:inherit (setq inherit val)) | |
| 485 (:group) | |
| 486 ;;((eq key :suppress) (setq suppress val)) | |
| 487 (t (message "Unknown argument %s in defmap" key))))) | |
| 488 (unless (keymapp m) | |
| 489 (setq bs (append m bs)) | |
| 490 (setq m (if dense (make-keymap name) (make-sparse-keymap name)))) | |
| 491 (dolist (b bs) | |
| 492 (let ((keys (car b)) | |
| 493 (binding (cdr b))) | |
| 494 (dolist (key (if (consp keys) keys (list keys))) | |
| 495 (cond | |
| 496 ((symbolp key) | |
| 497 (substitute-key-definition key binding m global-map)) | |
| 498 ((null binding) | |
| 499 (unless (keymapp (lookup-key m key)) (define-key m key binding))) | |
| 500 ((let ((o (lookup-key m key))) | |
| 501 (or (null o) (numberp o) (eq o 'undefined))) | |
| 502 (define-key m key binding)))))) | |
| 503 (cond | |
| 504 ((keymapp inherit) (set-keymap-parent m inherit)) | |
| 505 ((consp inherit) (easy-mmode-set-keymap-parents m inherit))) | |
| 506 m)) | |
| 507 | |
| 508 ;;;###no-autoload | |
| 509 (defmacro easy-mmode-defmap (m bs doc &rest args) | |
| 510 `(defconst ,m | |
| 511 (easy-mmode-define-keymap ,bs nil (if (boundp ',m) ,m) ,(cons 'list args)) | |
| 512 ,doc)) | |
| 513 | |
| 514 | |
| 515 ;;; | |
| 516 ;;; easy-mmode-defsyntax | |
| 517 ;;; | |
| 518 | |
| 519 (defun easy-mmode-define-syntax (css args) | |
| 520 (let ((st (make-syntax-table (plist-get args :copy))) | |
| 521 (parent (plist-get args :inherit))) | |
| 522 (dolist (cs css) | |
| 523 (let ((char (car cs)) | |
| 524 (syntax (cdr cs))) | |
| 525 (if (sequencep char) | |
|
4783
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2548
diff
changeset
|
526 (mapc (lambda (c) (modify-syntax-entry c syntax st)) char) |
| 2548 | 527 (modify-syntax-entry char syntax st)))) |
| 528 ;; XEmacs change: we do not have set-char-table-parent | |
| 529 (if parent (derived-mode-merge-syntax-tables | |
| 530 (if (symbolp parent) (symbol-value parent) parent) st)) | |
| 531 st)) | |
| 532 | |
| 533 ;;;###no-autoload | |
| 534 (defmacro easy-mmode-defsyntax (st css doc &rest args) | |
| 535 "Define variable ST as a syntax-table. | |
| 536 CSS contains a list of syntax specifications of the form (CHAR . SYNTAX)." | |
| 537 `(progn | |
| 538 (autoload 'easy-mmode-define-syntax "easy-mmode") | |
| 539 (defconst ,st (easy-mmode-define-syntax ,css ,(cons 'list args)) ,doc))) | |
| 540 | |
| 541 | |
| 542 | |
| 543 ;;; | |
| 544 ;;; easy-mmode-define-navigation | |
| 545 ;;; | |
| 546 | |
| 547 ;; XEmacs change: autoload | |
| 548 ;;;###no-autoload | |
| 549 (defmacro easy-mmode-define-navigation (base re &optional name endfun) | |
| 550 "Define BASE-next and BASE-prev to navigate in the buffer. | |
| 551 RE determines the places the commands should move point to. | |
| 552 NAME should describe the entities matched by RE. It is used to build | |
| 553 the docstrings of the two functions. | |
| 554 BASE-next also tries to make sure that the whole entry is visible by | |
| 555 searching for its end (by calling ENDFUN if provided or by looking for | |
| 556 the next entry) and recentering if necessary. | |
| 557 ENDFUN should return the end position (with or without moving point)." | |
| 558 (let* ((base-name (symbol-name base)) | |
| 559 (prev-sym (intern (concat base-name "-prev"))) | |
| 560 (next-sym (intern (concat base-name "-next")))) | |
| 561 (unless name (setq name (symbol-name base-name))) | |
| 562 `(progn | |
| 563 (add-to-list 'debug-ignored-errors | |
| 564 ,(concat "^No \\(previous\\|next\\) " (regexp-quote name))) | |
| 565 (defun ,next-sym (&optional count) | |
| 566 ,(format "Go to the next COUNT'th %s." name) | |
| 567 (interactive) | |
| 568 (unless count (setq count 1)) | |
| 569 (if (< count 0) (,prev-sym (- count)) | |
| 570 (if (looking-at ,re) (incf count)) | |
| 571 (if (not (re-search-forward ,re nil t count)) | |
| 572 (if (looking-at ,re) | |
| 573 (goto-char (or ,(if endfun `(,endfun)) (point-max))) | |
| 574 (error ,(format "No next %s" name))) | |
| 575 (goto-char (match-beginning 0)) | |
| 576 (when (and (eq (current-buffer) (window-buffer (selected-window))) | |
| 577 (interactive-p)) | |
| 578 (let ((endpt (or (save-excursion | |
| 579 ,(if endfun `(,endfun) | |
| 580 `(re-search-forward ,re nil t 2))) | |
| 581 (point-max)))) | |
| 582 ;; XEmacs change: versions < 21.5.16 have a | |
| 583 ;; pos-visible-in-window-p that takes only 2 parameters | |
| 584 (unless | |
| 585 (if (eq (function-max-args #'pos-visible-in-window-p) 2) | |
| 586 (pos-visible-in-window-p endpt nil) | |
| 587 (pos-visible-in-window-p endpt nil t)) | |
| 588 (recenter '(0)))))))) | |
| 589 (defun ,prev-sym (&optional count) | |
| 590 ,(format "Go to the previous COUNT'th %s" (or name base-name)) | |
| 591 (interactive) | |
| 592 (unless count (setq count 1)) | |
| 593 (if (< count 0) (,next-sym (- count)) | |
| 594 (unless (re-search-backward ,re nil t count) | |
| 595 (error ,(format "No previous %s" name)))))))) | |
| 596 | |
| 597 (provide 'easy-mmode) | |
| 598 | |
| 599 ;;; easy-mmode.el ends here |