Mercurial > hg > xemacs-beta
comparison lisp/behavior.el @ 5645:5d3bb1100832
Remove some utility functions from the global namespace, lisp/
lisp/ChangeLog addition:
2012-04-07 Aidan Kehoe <kehoea@parhasard.net>
Remove some utility functions from the global namespace, it's more
appropriate to have them as labels (that is, lexically-visible
functions.)
* behavior.el:
* behavior.el (behavior-menu-filter-1): Moved to being a label.
* behavior.el (behavior-menu-filter): Use the label.
* cus-edit.el (custom-load-symbol-1): Moved to being a label.
* cus-edit.el (custom-load-symbol): Use the label.
* menubar.el (find-menu-item-1): Moved to being a label.
* menubar.el (find-menu-item): Use the label.
* window-xemacs.el:
* window-xemacs.el (display-buffer-1): Moved to being a label.
* window-xemacs.el (display-buffer): Use the label; use (block
...) instead of (catch ...), use prog1 instead of needlessly
binding a variable.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sat, 07 Apr 2012 21:57:31 +0100 |
| parents | e05d98bf9644 |
| children | cc6f0266bc36 |
comparison
equal
deleted
inserted
replaced
| 5644:0df3cedee9ac | 5645:5d3bb1100832 |
|---|---|
| 412 (override (gethash group behavior-override-hash-table)) | 412 (override (gethash group behavior-override-hash-table)) |
| 413 (children (getf group-plist :children))) | 413 (children (getf group-plist :children))) |
| 414 ) | 414 ) |
| 415 ) | 415 ) |
| 416 | 416 |
| 417 (defun behavior-menu-filter-1 (menu group) | |
| 418 (submenu-generate-accelerator-spec | |
| 419 (let* ( | |
| 420 ;;options | |
| 421 ;;help | |
| 422 (enable | |
| 423 (menu-split-long-menu | |
| 424 (menu-sort-menu | |
| 425 (let ((group-plist (gethash group behavior-group-hash-table))) | |
| 426 (loop for behavior in (getf group-plist :children) | |
| 427 nconc (if (behavior-group-p behavior) | |
| 428 (list | |
| 429 (cons (getf | |
| 430 (gethash behavior behavior-group-hash-table) | |
| 431 :short-doc) | |
| 432 (behavior-menu-filter-1 menu behavior))) | |
| 433 (let* ((plist (gethash behavior behavior-hash-table)) | |
| 434 (commands (getf plist :commands))) | |
| 435 (nconc | |
| 436 (if (getf plist :enable) | |
| 437 `([,(format "%s (%s) [toggle]" | |
| 438 (getf plist :short-doc) | |
| 439 behavior) | |
| 440 (if (memq ',behavior | |
| 441 enabled-behavior-list) | |
| 442 (disable-behavior ',behavior) | |
| 443 (enable-behavior ',behavior)) | |
| 444 :active ,(if (getf plist :disable) t | |
| 445 (not (memq | |
| 446 ',behavior | |
| 447 enabled-behavior-list))) | |
| 448 :style toggle | |
| 449 :selected (memq ',behavior | |
| 450 enabled-behavior-list)])) | |
| 451 (cond ((null commands) nil) | |
| 452 ((and (eq (length commands) 1) | |
| 453 (vectorp (elt commands 0))) | |
| 454 (let ((comm (copy-sequence | |
| 455 (elt commands 0)))) | |
| 456 (setf (elt comm 0) | |
| 457 (format "%s (%s)" | |
| 458 (elt comm 0) behavior)) | |
| 459 (list comm))) | |
| 460 (t (list | |
| 461 (cons (format "%s (%s) Commands" | |
| 462 (getf plist :short-doc) | |
| 463 behavior) | |
| 464 commands))))))))) | |
| 465 )) | |
| 466 ) | |
| 467 ) | |
| 468 enable) | |
| 469 '(?p))) | |
| 470 | |
| 471 (defun behavior-menu-filter (menu) | 417 (defun behavior-menu-filter (menu) |
| 472 (append | 418 (labels |
| 473 `(("%_Package Utilities" | 419 ((behavior-menu-filter-1 (menu group) |
| 474 ("%_Set Download Site" | 420 (submenu-generate-accelerator-spec |
| 475 ("%_Official Releases" | 421 (let* ((enable |
| 476 :filter ,#'(lambda (&rest junk) | 422 (menu-split-long-menu |
| 477 (menu-split-long-menu | 423 (menu-sort-menu |
| 478 (submenu-generate-accelerator-spec | 424 (let ((group-plist (gethash group |
| 479 (package-ui-download-menu))))) | 425 behavior-group-hash-table))) |
| 480 ("%_Pre-Releases" | 426 (loop for behavior in (getf group-plist :children) |
| 481 :filter ,#'(lambda (&rest junk) | 427 nconc (if (behavior-group-p behavior) |
| 482 (menu-split-long-menu | 428 (list |
| 483 (submenu-generate-accelerator-spec | 429 (cons (getf |
| 484 (package-ui-pre-release-download-menu))))) | 430 (gethash behavior |
| 485 ("%_Site Releases" | 431 behavior-group-hash-table) |
| 486 :filter ,#'(lambda (&rest junk) | 432 :short-doc) |
| 487 (menu-split-long-menu | 433 (behavior-menu-filter-1 |
| 488 (submenu-generate-accelerator-spec | 434 menu behavior))) |
| 489 (package-ui-site-release-download-menu)))))) | 435 (let* ((plist (gethash behavior |
| 490 "--:shadowEtchedIn" | 436 behavior-hash-table)) |
| 491 ["%_Update Package Index" package-get-update-base] | 437 (commands (getf plist :commands))) |
| 492 ["%_List and Install" pui-list-packages] | 438 (nconc |
| 493 ["U%_pdate Installed Packages" package-get-update-all] | 439 (if (getf plist :enable) |
| 494 ["%_Help" (Info-goto-node "(xemacs)Packages")]) | 440 `([,(format "%s (%s) [toggle]" |
| 495 "----") | 441 (getf plist :short-doc) |
| 496 (behavior-menu-filter-1 menu nil))) | 442 behavior) |
| 443 (if (memq ',behavior | |
| 444 enabled-behavior-list) | |
| 445 (disable-behavior ',behavior) | |
| 446 (enable-behavior ',behavior)) | |
| 447 :active ,(if (getf plist :disable) | |
| 448 t | |
| 449 (not | |
| 450 (memq | |
| 451 ',behavior | |
| 452 enabled-behavior-list))) | |
| 453 :style toggle | |
| 454 :selected (memq | |
| 455 ',behavior | |
| 456 enabled-behavior-list)])) | |
| 457 (cond ((null commands) nil) | |
| 458 ((and (eq (length commands) 1) | |
| 459 (vectorp (elt commands 0))) | |
| 460 (let ((comm (copy-sequence | |
| 461 (elt commands 0)))) | |
| 462 (setf (elt comm 0) | |
| 463 (format "%s (%s)" | |
| 464 (elt comm 0) | |
| 465 behavior)) | |
| 466 (list comm))) | |
| 467 (t (list | |
| 468 (cons (format "%s (%s) Commands" | |
| 469 (getf plist | |
| 470 :short-doc) | |
| 471 behavior) | |
| 472 commands))))))))) | |
| 473 )) | |
| 474 ) | |
| 475 ) | |
| 476 enable) | |
| 477 '(?p)))) | |
| 478 (append | |
| 479 `(("%_Package Utilities" | |
| 480 ("%_Set Download Site" | |
| 481 ("%_Official Releases" | |
| 482 :filter ,#'(lambda (&rest junk) | |
| 483 (menu-split-long-menu | |
| 484 (submenu-generate-accelerator-spec | |
| 485 (package-ui-download-menu))))) | |
| 486 ("%_Pre-Releases" | |
| 487 :filter ,#'(lambda (&rest junk) | |
| 488 (menu-split-long-menu | |
| 489 (submenu-generate-accelerator-spec | |
| 490 (package-ui-pre-release-download-menu))))) | |
| 491 ("%_Site Releases" | |
| 492 :filter ,#'(lambda (&rest junk) | |
| 493 (menu-split-long-menu | |
| 494 (submenu-generate-accelerator-spec | |
| 495 (package-ui-site-release-download-menu)))))) | |
| 496 "--:shadowEtchedIn" | |
| 497 ["%_Update Package Index" package-get-update-base] | |
| 498 ["%_List and Install" pui-list-packages] | |
| 499 ["U%_pdate Installed Packages" package-get-update-all] | |
| 500 ["%_Help" (Info-goto-node "(xemacs)Packages")]) | |
| 501 "----") | |
| 502 (behavior-menu-filter-1 menu nil)))) | |
| 497 | 503 |
| 498 ;; Initialize top-level group. | 504 ;; Initialize top-level group. |
| 499 (puthash nil '(:children nil :short-doc "Root") behavior-group-hash-table) | 505 (puthash nil '(:children nil :short-doc "Root") behavior-group-hash-table) |
| 500 | 506 |
| 501 (provide 'behavior) | 507 (provide 'behavior) |
| 502 | 508 |
| 503 ;;; finder-inf.el ends here | 509 ;;; behavior.el ends here |