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