Mercurial > hg > xemacs-beta
annotate lisp/behavior.el @ 5760:995257d0c590
Added tag r21-5-latest-beta for changeset 6c2aa9851f5e
| author | Stephen J. Turnbull <stephen@xemacs.org> |
|---|---|
| date | Tue, 27 Aug 2013 01:33:34 +0900 |
| parents | 66d2f63df75f |
| children |
| rev | line source |
|---|---|
| 2546 | 1 ;;; behavior.el --- consistent interface onto packages |
| 502 | 2 |
| 2546 | 3 ;; Copyright (C) 2000, 2001, 2002, 2003 Ben Wing. |
| 502 | 4 |
| 5 ;; Author: Ben Wing | |
| 6 ;; Maintainer: XEmacs Development Team | |
| 7 ;; Keywords: internal, dumped | |
| 8 | |
| 9 ;; This file is part of XEmacs. | |
| 10 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5271
diff
changeset
|
11 ;; 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:
5271
diff
changeset
|
12 ;; 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:
5271
diff
changeset
|
13 ;; 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:
5271
diff
changeset
|
14 ;; option) any later version. |
| 502 | 15 |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5271
diff
changeset
|
16 ;; 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:
5271
diff
changeset
|
17 ;; 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:
5271
diff
changeset
|
18 ;; 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:
5271
diff
changeset
|
19 ;; for more details. |
| 502 | 20 |
| 21 ;; 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:
5271
diff
changeset
|
22 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
| 502 | 23 |
| 24 ;;; Synched up with: Not in FSF. | |
| 25 | |
| 26 ;;; Authorship: | |
| 27 | |
| 28 ;; Created July 2000 by Ben Wing. | |
| 29 | |
| 30 ;;; Commentary: | |
| 31 | |
| 2546 | 32 ;; This file is dumped with XEmacs. |
| 33 | |
| 34 ;; This file is part of the "Behaviors" project and is a work in progress. | |
| 35 ;; The purpose of the project is to provide (a) a consistent interface (at | |
| 36 ;; the API level) onto the functionality provided by packages, and (b) an | |
| 37 ;; easy-to-use user interface for this functionality, something that | |
| 38 ;; *really works*. | |
| 39 ;; | |
| 40 ;; First, what characteristics do/should packages have? (NOTE: In this | |
| 41 ;; discussion below, `package' and `behavior' are being used more or less | |
| 42 ;; interchangeably. Eventually this will get resolved.) | |
| 43 | |
| 44 ;; 1) A file, or one or more file, containing the code of the package. In | |
| 45 ;; addition, a "head" file in the case that the package needs to be | |
| 46 ;; loaded in order to get its functionality (e.g. "load-to-enable" | |
| 47 ;; packages -- an abomination that is tolerated only with severe | |
| 48 ;; displeasure). | |
| 49 ;; 2) A Lisp name -- a fairly short symbol (2-3 words max), uncapitalized, | |
| 50 ;; without use of excessive abbreviation and with words set off by | |
| 51 ;; dashes. This should be the same as the name of the topmost custom | |
| 52 ;; group associated with the package (see next item), and preferably the | |
| 53 ;; same as the common prefix used for variables defined by your package | |
| 54 ;; and the name of the head file of the package. | |
| 55 ;; 3) Associated custom group listing the settings associated with the package. | |
| 56 ;; 4) Enable and disable methods for turning on or off the functionality of | |
| 57 ;; the package, if it's amenable to such a model. Most packages are of two | |
| 58 ;; types: | |
| 59 ;; | |
| 60 ;; (a) They add some functionality to XEmacs, which is incorporated | |
| 61 ;; into and makes changes to the normal functionality of XEmacs. Once the | |
| 62 ;; package is enabled, the user doesn't have to do anything specific for | |
| 63 ;; the package to do its thing -- it happens automatically if the user is | |
| 64 ;; using the area whose behavior has been changed. These include packages | |
|
5750
66d2f63df75f
Correct some spelling and formatting in behavior.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5666
diff
changeset
|
65 ;; such as `avoid' (which makes the mouse pointer move when the cursor |
| 2546 | 66 ;; gets too close), EFS (which adds the ability to treat an FTP site as |
| 67 ;; part of the local file system), the packages that supply the | |
| 68 ;; mode-specific handling for various files, etc | |
| 69 ;; | |
| 70 ;; (b) They provide functionality in the form of specific command to be | |
| 71 ;; invoked. This can be as simple as the `hippie-expand' command (tries | |
| 72 ;; lots of different expansion methods for the text before point, to | |
| 73 ;; try and get a result) and as complicated as GNUS or VM. | |
| 74 ;; | |
| 75 ;; Some packages might provide both -- you can enable them and they | |
| 76 ;; incorporate some functionality into the XEmacs base, but while | |
| 77 ;; they're enabled they provide certain commands. #### We need some | |
| 78 ;; thought here, and case-by-case analysis, to determine if this really | |
| 79 ;; makes sense -- can the enable/disable be removed and whatever needs | |
| 80 ;; to happen incorporated as part of the command? can the | |
| 81 ;; enable/disable just added to the commands? | |
| 82 ;; | |
| 83 ;; 5) Packages of type (b) just above will have a list of commands that can be | |
| 84 ;; run. They should be in standard menubar format -- i.e. just like a | |
| 85 ;; submenu, but without the initial string indidicating the name of the | |
| 86 ;; menu. | |
| 87 ;; 6) Short doc string, for use in a menu item. *NOT* necessarily the same | |
| 88 ;; as the documentation for the Custom group, which is often too long. | |
| 89 ;; 7) Long documentation. | |
| 90 ;; | |
| 91 ;; Good package etiquette: | |
| 92 ;; | |
| 93 ;; | |
| 94 ;; -- Never mess with the menu yourself, or try to "cheat" by putting yourself | |
| 95 ;; high up in the hierarchy, e.g. at the top-level or directly off a | |
| 96 ;; top-level group that expects to contain only groups of groups, not | |
| 97 ;; end-level groups. | |
| 98 ;; | |
| 99 ;; -- Never use the `override-behavior' commands or the like for specifying | |
| 100 ;; (in an overriding fashion) the exact appearance of the hierarchies. | |
| 101 ;; | |
| 102 ;; -- For type (a), with enable/disable methods: | |
| 103 ;; | |
| 104 ;; (a) Loading the file should NOT DO ANYTHING. Not enable, not add hooks, | |
| 105 ;; nothing. | |
| 106 ;; (b) Both enable and disable hooks must exist. The disable hook must | |
| 107 ;; completely reset the environment to how it was before the package | |
| 108 ;; was enabled. This includes restoring the prior bindings for | |
| 109 ;; modified key bindings. #### We need some helper function to assist | |
| 110 ;; with remembering the old key bindings and putting them back only | |
| 111 ;; when new key bindings haven't been made -- but recognize when those | |
| 112 ;; new key bondings were attached as a result of loading another | |
| 113 ;; package, so that after any order of loading and unloading a series | |
| 114 ;; of packages, the original bindings will eventually occur. (Something | |
| 115 ;; like `advice' for key definitions.) Replacement of functions should | |
| 116 ;; happen through `advice'. | |
| 117 ;; | |
| 118 ;; We recognize that many packages out there don't follow these precepts at | |
| 119 ;; all. Many or most of them are install-only, often happening | |
| 120 ;; automatically when the file is loaded. Converting these will be a step | |
| 121 ;; at a time: First, redo the latter type so that the initialization code | |
| 122 ;; is put into a function and not run automatically upon load. Next step, | |
| 123 ;; try to provide some sort of disable. Third step, work on making sure | |
| 124 ;; that disable removes *everything* and enable puts it all back. Fourth | |
| 125 ;; step, work on properly advising keys and functions. | |
| 126 ;; | |
| 127 | |
| 128 ;; Comparison/Integration with Custom: | |
| 129 | |
| 130 ;; Custom only handles variable settings, and has no concept of standard | |
| 131 ;; enable/disable methods for a package, a standard way of specifying | |
| 132 ;; package documentation, or a list of commands associated with a package. | |
| 133 ;; Also, its groups do not always map very well onto packages and the | |
| 134 ;; resulting hierarchy is too big, confusing, difficult-to-navigate, and | |
| 135 ;; incoherent. More generally it does not address at all the basic problem | |
| 136 ;; that a hierarchy created in a decentralized fashion -- and by a large | |
| 137 ;; number of authors, some more competent than others -- will inevitably be | |
| 138 ;; incoherent when put together. | |
| 139 ;; | |
| 140 | |
| 141 ;; In general, ease-of-use was not the overarching goal of Custom. The | |
| 142 ;; primary goal of Custom seems to have been to provide a consistent interface | |
| 143 ;; and get all the packages to use it. Ease-of-use -- or even following | |
| 144 ;; established user-interface standards -- has taken a far-distant second, and | |
| 145 ;; appears in many respects to be an afterthought that never had any serious | |
| 146 ;; effort investigated into it. | |
| 147 ;; | |
| 148 ;; The eventual intent of this project is to integrate with custom. The final | |
| 149 ;; intent of integration is that this project subsumes Custom completely, | |
| 150 ;; making Custom the unified, user-friendly means of controlling XEmacs that | |
| 151 ;; has never properly existed. However, that will take a lot of work. For | |
| 152 ;; the meantime, the plan is to develop the Behavior subsystem independent of | |
| 153 ;; Custom, with ease-of-use as the primary goal, and get it to the point where | |
| 154 ;; it encompasses most packages out there, has stabilized its interface, and | |
| 155 ;; works well. At that point, we will consider integration with Custom. (Note | |
| 156 ;; that the hard part of the Behavior work is not actually behaviorizing the | |
| 157 ;; packages, but developing the interface itself.) | |
| 158 ;; | |
| 159 ;; As for integrating with Custom -- ideally that would mean simply extending | |
| 160 ;; defgroup, but that is not really possible given that backward-compatibility | |
| 161 ;; would not work -- existing versions of `defgroup' give an error when | |
| 162 ;; presented with an unknown keyword. In practice, then, this might mean that | |
| 163 ;; a separate `define-behavior' command (or `defpackage', or the like) will | |
| 164 ;; still exist. | |
| 502 | 165 |
| 166 ;;; Code: | |
| 167 | |
| 800 | 168 ;; Hash table mapping behavior names to property lists, with entries for |
| 2546 | 169 ;; :group, :custom-group, :short-doc, :require, :enable, :disable, |
| 170 ;; and :commands. | |
| 800 | 171 (defconst behavior-hash-table (make-hash-table)) |
| 2546 | 172 ;; Hash table mapping groups to property lists (entries for :group, :children, |
| 173 ;; :short-doc). | |
| 174 (defconst behavior-group-hash-table (make-hash-table)) | |
| 175 ;; Hash table with override information for groups. | |
| 176 ;; :short-doc). | |
| 177 (defconst behavior-override-hash-table (make-hash-table)) | |
| 800 | 178 |
| 179 (defvar within-behavior-enabling-disabling nil) | |
| 180 | |
| 181 (defgroup behaviors nil | |
| 182 "Behaviors -- high-level functionality interface.") | |
| 183 | |
| 184 ;; List of enabled behaviors. | |
| 185 (defcustom enabled-behavior-list nil | |
| 186 "List of currently enabled behaviors. | |
| 187 Normally, don't set it directly; use `enable-behavior' or `disable-behavior'." | |
| 188 :initialize #'set-default | |
| 189 :set #'(lambda (sym val) | |
| 190 (if within-behavior-enabling-disabling | |
| 191 (set sym val) | |
| 192 (let* ((old-val enabled-behavior-list) | |
| 193 (disable-list (set-difference old-val val)) | |
| 194 (enable-list (set-difference val old-val))) | |
| 195 (dolist (b disable-list) | |
| 196 (disable-behavior b t)) | |
| 197 (dolist (b enable-list) | |
| 198 (enable-behavior b t)) | |
| 897 | 199 (assert (equal (sort (copy-sequence enabled-behavior-list) 'string-lessp) |
| 200 (sort (copy-sequence val) 'string-lessp)))))) | |
| 800 | 201 :type '(repeat (symbol :tag "Behavior")) |
| 202 :group 'behaviors) | |
| 203 | |
| 502 | 204 |
| 205 (defvar behavior-history nil | |
| 206 "History of entered behaviors.") | |
| 207 | |
| 2546 | 208 (defun behavior-group-p (group) |
| 209 "Non-nil if GROUP is the name of a valid behavior group." | |
| 210 (not (null (gethash group behavior-group-hash-table)))) | |
| 211 | |
| 212 (defun check-behavior-group (group) | |
| 213 "Verify that GROUP is a valid behavior group, or nil. | |
| 214 Return GROUP if so." | |
| 215 (or (behavior-group-p group) | |
| 216 (error 'invalid-argument "Invalid behavior group" group)) | |
| 217 group) | |
| 218 | |
| 219 (defun* define-behavior (name doc-string &key | |
| 220 group custom-group | |
| 221 (short-doc | |
| 222 (capitalize-string-as-title | |
| 223 (replace-in-string (symbol-name name) "-" " "))) | |
| 224 require enable disable commands | |
| 225 &allow-other-keys) | |
| 226 ;; We allow other keys to allow for the possibility of extensions by | |
| 227 ;; later versions of XEmacs. Packages should be able to support those | |
| 228 ;; extensions without worrying about causing problems with older versions | |
| 229 ;; of XEmacs. | |
| 502 | 230 "Define a behavior named NAME. |
| 231 DOC-STRING must be specified, a description of what the behavior does | |
| 232 when it's enabled and how to further control it (typically through | |
| 233 custom variables). Accepted keywords are | |
| 234 | |
| 2546 | 235 :group Symbol naming the behavior group this behavior is within. |
| 236 :custom-group Symbol naming the custom group containing the options that | |
| 237 can be set in association with this behavior. If not specified, | |
| 238 the custom group with the same name as the behavior will be | |
| 239 used, if it exists. | |
| 800 | 240 :short-doc A \"pretty\" version of the name, for use in menus. If omitted |
| 241 a prettified name will be generated. | |
| 242 :require A single symbol or a list of such symbols, which need to be | |
| 243 present at enable time, or will be loaded using `require'. | |
| 244 :enable A function of no variables, which turns the behavior on. | |
| 245 :disable A function of no variables, which turns the behavior off. | |
| 2546 | 246 :commands A list of interactive commands that can be invoked in |
| 247 conjunction with the behavior. These will appear in a submenu | |
| 248 along with the rest of the items for the behavior. | |
| 502 | 249 |
| 250 Behaviors are assumed to be global, and to take effect immediately; if | |
| 251 the underlying package is per-buffer, it may have to scan all existing | |
| 252 buffers and frob them. When a behavior is disabled, it should completely | |
| 253 go away *everywhere*, as if it were never invoked at all. | |
| 254 | |
| 2546 | 255 The :disable keyword can be missing, although this is considered bad |
| 502 | 256 practice. In such a case, attempting to disable the behavior will signal |
| 2546 | 257 an error unless you use the `force' option. |
| 258 | |
| 259 The :enable keyword can be missing. This is useful for behaviors that | |
| 260 are really a series of related commands without anything semantically | |
| 261 corresponding to \"turning on\" or \"turning off\" the behavior. | |
| 262 | |
| 263 A behavior with no :enable and no :command is possible. This might be | |
| 264 used, for example, by a behavior that encapsulates a series of related | |
| 265 Lisp functions. Such behaviors may be handled specially, e.g. not | |
| 266 displayed in the menus or displayed in a separate location, since they | |
| 267 have no user-invocable behavior." | |
| 268 (let ((entry (list :group (check-behavior-group group) | |
| 269 :custom-group custom-group | |
| 270 :short-doc short-doc :require require | |
| 271 :enable enable :disable disable | |
| 272 :commands commands))) | |
| 273 (puthash name entry behavior-hash-table)) | |
| 274 ;; update the children list of the group we're in (maybe nil). | |
| 275 (unless (member name (getf (gethash group behavior-group-hash-table) | |
| 276 :children)) | |
| 277 (push name (getf (gethash group behavior-group-hash-table) :children)))) | |
| 278 | |
| 279 (defun* override-behavior (name &key | |
| 280 short-doc | |
| 281 group | |
| 282 include | |
| 283 demote-others) | |
| 284 "Override the default properties of a behavior group NAME. | |
| 285 Normally, groups are created and assigned properties by individual packages. | |
| 286 The resulting hierarchy may not make much sense globally. This function | |
| 287 allows the hierarchy and appearance of a group to be specified globally, | |
|
5750
66d2f63df75f
Correct some spelling and formatting in behavior.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5666
diff
changeset
|
288 and will take precendence over the properties assigned by |
|
66d2f63df75f
Correct some spelling and formatting in behavior.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5666
diff
changeset
|
289 `define-behavior-group'. This allows a global organization to be imposed on |
|
66d2f63df75f
Correct some spelling and formatting in behavior.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5666
diff
changeset
|
290 groups, while still allowing for graceful handling of new or unknown groups. |
| 2546 | 291 |
| 292 NAME can be a symbol specifying a group name, or a list of | |
| 293 \(PARENT [...] NAME), where a path from a particular parent is explicitly | |
| 294 given. (This latter form allows the same name to be assigned to more than one | |
| 295 group.) | |
| 296 | |
| 297 Accepted keywords are | |
| 298 | |
| 299 :short-doc A \"pretty\" version of the name, for use in menus. | |
| 300 :group Parent group, if any. Should not be given if the parents are | |
| 301 explicitly specified in NAME. | |
| 302 :include A list of behaviors that are specifically included in this | |
| 303 group, in addition to those that are included by the behaviors | |
| 304 themselves. | |
| 305 :demote-others If non-nil, exclude all behaviors not specified in the :include | |
| 306 list and put them instead (i.e. \"demote\" them) to another group, | |
| 307 usually a subgroup." | |
| 308 (let ((entry (list :group (check-behavior-group group) | |
| 309 :short-doc short-doc | |
| 310 :include include | |
| 311 :demote-others demote-others))) | |
| 312 (puthash name entry behavior-override-hash-table))) | |
| 313 | |
| 314 (defun* define-behavior-group (name &key | |
| 315 (short-doc | |
| 316 (capitalize-string-as-title | |
| 317 (replace-in-string (symbol-name name) "-" | |
| 318 " "))) | |
| 319 group) | |
| 320 "Define a behavior group NAME. | |
| 321 | |
| 322 NAME can be a symbol specifying a group name, or a list of | |
| 323 \(PARENT [...] NAME), where a path from a particular parent is explicitly | |
| 324 given. (This latter form allows the same name to be assigned to more than one | |
| 325 group.) | |
| 326 | |
| 327 Accepted keywords are | |
| 328 | |
| 329 :short-doc A \"pretty\" version of the name, for use in menus. If omitted | |
| 330 a prettified name will be generated. | |
| 331 :group Parent group, if any. Should not be given if the parents are | |
| 332 explicitly specified in NAME." | |
| 333 (let ((entry (list :group (check-behavior-group group) | |
| 334 :short-doc short-doc))) | |
| 335 (puthash name entry behavior-group-hash-table)) | |
| 336 ;; update the children list of the parent (maybe nil). | |
| 337 (push name (getf (gethash group behavior-group-hash-table) :children))) | |
| 502 | 338 |
| 339 (defun read-behavior (prompt &optional must-match initial-contents history | |
| 2546 | 340 default-value) |
| 502 | 341 "Return a behavior symbol from the minibuffer, prompting with string PROMPT. |
| 342 If non-nil, optional second arg INITIAL-CONTENTS is a string to insert | |
| 343 in the minibuffer before reading. | |
| 344 Third arg HISTORY, if non-nil, specifies a history list. (It defaults to | |
| 345 `behavior-history'.) | |
| 346 Fourth arg DEFAULT-VALUE is the default value. If non-nil, it is used | |
| 347 for history command, and as the value to return if the user enters the | |
| 348 empty string." | |
| 349 (let ((result | |
|
5666
daf5accfe973
Use #'test-completion, minibuf.el, instead of implementing same.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
350 (completing-read prompt behavior-hash-table nil must-match |
|
daf5accfe973
Use #'test-completion, minibuf.el, instead of implementing same.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
351 initial-contents (or history 'behavior-history) |
|
daf5accfe973
Use #'test-completion, minibuf.el, instead of implementing same.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
352 default-value))) |
|
daf5accfe973
Use #'test-completion, minibuf.el, instead of implementing same.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
353 (if (stringp result) |
| 502 | 354 (intern result) |
| 355 result))) | |
| 356 | |
| 800 | 357 (defun behavior-enabled-p (behavior) |
| 358 "Non-nil if BEHAVIOR (a symbol) if currently enabled." | |
| 359 (memq behavior enabled-behavior-list)) | |
| 502 | 360 |
| 361 (defun enable-behavior (behavior &optional force) | |
| 362 "Enable the specified behavior." | |
| 363 (interactive (list (read-behavior "Enable Behavior: " t) current-prefix-arg)) | |
| 364 (let ((plist (gethash behavior behavior-hash-table))) | |
| 365 (or plist (error 'invalid-argument "Not a behavior" behavior)) | |
| 800 | 366 (or force (not (memq behavior enabled-behavior-list)) |
| 367 (error 'invalid-change "Behavior already enabled" behavior)) | |
| 502 | 368 (let ((require (getf plist :require)) |
| 369 (enable (getf plist :enable))) | |
| 370 (cond ((listp require) | |
|
5524
e05d98bf9644
Style and indentation corrections, behavior.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
371 (mapc 'require require)) |
| 502 | 372 ((symbolp require) |
| 373 (require require)) | |
| 374 (t (error 'invalid-argument "Invalid :require spec" require))) | |
| 800 | 375 (message "Enabling behavior %s..." behavior) |
| 376 (if enable (funcall enable)) | |
| 377 (message "Enabling behavior %s...done" behavior) | |
| 378 (let ((within-behavior-enabling-disabling t)) | |
| 379 (customize-set-variable 'enabled-behavior-list | |
| 380 (cons behavior enabled-behavior-list)))))) | |
| 502 | 381 |
| 382 (defun disable-behavior (behavior &optional force) | |
| 383 "Disable the specified behavior." | |
| 384 (interactive (list (read-behavior "Disable Behavior: " t) | |
| 385 current-prefix-arg)) | |
| 386 (let ((plist (gethash behavior behavior-hash-table))) | |
| 387 (or plist (error 'invalid-argument "Not a behavior" behavior)) | |
| 800 | 388 (or force (memq behavior enabled-behavior-list) |
| 389 (error 'invalid-change "Behavior not enabled" behavior)) | |
| 502 | 390 (let ((require (getf plist :require)) |
| 391 (disable (getf plist :disable))) | |
| 392 (cond ((listp require) | |
|
5524
e05d98bf9644
Style and indentation corrections, behavior.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
393 (mapc 'require require)) |
| 502 | 394 ((symbolp require) |
| 395 (require require)) | |
| 396 (t (error 'invalid-argument "Invalid :require spec" require))) | |
| 800 | 397 (message "Disabling behavior %s..." behavior) |
| 398 (if disable (funcall disable)) | |
| 399 (message "Disabling behavior %s...done" behavior) | |
| 400 (let ((within-behavior-enabling-disabling t)) | |
| 401 (customize-set-variable 'enabled-behavior-list | |
|
5652
cc6f0266bc36
Avoid #'delq in core Lisp, for the sake of style, a very slightly smaller binary
Aidan Kehoe <kehoea@parhasard.net>
parents:
5645
diff
changeset
|
402 (delete* behavior enabled-behavior-list)))))) |
| 502 | 403 |
| 2546 | 404 (defun compute-behavior-group-children (group hash) |
| 405 "Compute the actual children for GROUP and its subgroups. | |
| 406 This takes into account the override information specified." | |
| 407 (let* ((group-plist (gethash group behavior-group-hash-table)) | |
| 408 (override (gethash group behavior-override-hash-table)) | |
| 409 (children (getf group-plist :children))) | |
| 410 ) | |
| 411 ) | |
| 412 | |
| 413 (defun behavior-menu-filter (menu) | |
|
5645
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
414 (labels |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
415 ((behavior-menu-filter-1 (menu group) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
416 (submenu-generate-accelerator-spec |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
417 (let* ((enable |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
418 (menu-split-long-menu |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
419 (menu-sort-menu |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
420 (let ((group-plist (gethash group |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
421 behavior-group-hash-table))) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
422 (loop for behavior in (getf group-plist :children) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
423 nconc (if (behavior-group-p behavior) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
424 (list |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
425 (cons (getf |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
426 (gethash behavior |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
427 behavior-group-hash-table) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
428 :short-doc) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
429 (behavior-menu-filter-1 |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
430 menu behavior))) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
431 (let* ((plist (gethash behavior |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
432 behavior-hash-table)) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
433 (commands (getf plist :commands))) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
434 (nconc |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
435 (if (getf plist :enable) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
436 `([,(format "%s (%s) [toggle]" |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
437 (getf plist :short-doc) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
438 behavior) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
439 (if (memq ',behavior |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
440 enabled-behavior-list) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
441 (disable-behavior ',behavior) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
442 (enable-behavior ',behavior)) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
443 :active ,(if (getf plist :disable) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
444 t |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
445 (not |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
446 (memq |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
447 ',behavior |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
448 enabled-behavior-list))) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
449 :style toggle |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
450 :selected (memq |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
451 ',behavior |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
452 enabled-behavior-list)])) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
453 (cond ((null commands) nil) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
454 ((and (eq (length commands) 1) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
455 (vectorp (elt commands 0))) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
456 (let ((comm (copy-sequence |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
457 (elt commands 0)))) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
458 (setf (elt comm 0) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
459 (format "%s (%s)" |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
460 (elt comm 0) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
461 behavior)) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
462 (list comm))) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
463 (t (list |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
464 (cons (format "%s (%s) Commands" |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
465 (getf plist |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
466 :short-doc) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
467 behavior) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
468 commands))))))))) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
469 )) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
470 ) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
471 ) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
472 enable) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
473 '(?p)))) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
474 (append |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
475 `(("%_Package Utilities" |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
476 ("%_Set Download Site" |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
477 ("%_Official Releases" |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
478 :filter ,#'(lambda (&rest junk) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
479 (menu-split-long-menu |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
480 (submenu-generate-accelerator-spec |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
481 (package-ui-download-menu))))) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
482 ("%_Pre-Releases" |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
483 :filter ,#'(lambda (&rest junk) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
484 (menu-split-long-menu |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
485 (submenu-generate-accelerator-spec |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
486 (package-ui-pre-release-download-menu))))) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
487 ("%_Site Releases" |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
488 :filter ,#'(lambda (&rest junk) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
489 (menu-split-long-menu |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
490 (submenu-generate-accelerator-spec |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
491 (package-ui-site-release-download-menu)))))) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
492 "--:shadowEtchedIn" |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
493 ["%_Update Package Index" package-get-update-base] |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
494 ["%_List and Install" pui-list-packages] |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
495 ["U%_pdate Installed Packages" package-get-update-all] |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
496 ["%_Help" (Info-goto-node "(xemacs)Packages")]) |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
497 "----") |
|
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
498 (behavior-menu-filter-1 menu nil)))) |
| 2546 | 499 |
| 500 ;; Initialize top-level group. | |
| 501 (puthash nil '(:children nil :short-doc "Root") behavior-group-hash-table) | |
| 502 | |
| 502 | 503 (provide 'behavior) |
| 504 | |
|
5645
5d3bb1100832
Remove some utility functions from the global namespace, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5524
diff
changeset
|
505 ;;; behavior.el ends here |