Mercurial > hg > xemacs-beta
annotate lisp/behavior.el @ 5750:66d2f63df75f
Correct some spelling and formatting in behavior.el.
Mentioned in tracker issue 826, the third thing mentioned there (the file
name at the bottom of the file) had already been fixed.
lisp/ChangeLog addition:
2013-08-05 Aidan Kehoe <kehoea@parhasard.net>
* behavior.el:
(override-behavior):
Correct some spelling and formatting here, thank you Steven
Mitchell in tracker issue 826.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Mon, 05 Aug 2013 10:05:32 +0100 |
| parents | daf5accfe973 |
| 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 |