X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=lisp%2Fmenubar-items.el;h=d5b763758815b9c6d086055b20f77c4a1935bf40;hp=54a82e8745003d9db62c5e30d1bbb5cd286ea652;hb=d498337390c3a567aae4fa0e1c1f06064a808d21;hpb=3062d425fac0473eb5aa2efc0bb002f6ce0cb028 diff --git a/lisp/menubar-items.el b/lisp/menubar-items.el index 54a82e8..d5b7637 100644 --- a/lisp/menubar-items.el +++ b/lisp/menubar-items.el @@ -54,10 +54,18 @@ ;;; Code: -(defun menu-truncate-list (list n) - (if (<= (length list) n) - list - (butlast list (- (length list) n)))) +(defun Menubar-items-truncate-history (list count label-length) + "Truncate a history LIST to first COUNT items. +Return a list of (label value) lists with labels truncated to last +LABEL-LENGTH characters of value." + (mapcar #'(lambda (x) + (if (<= (length x) label-length) + (list x x) + (list + (concat "..." (substring x (- label-length))) x))) + (if (<= (length list) count) + list + (butlast list (- (length list) count))))) (defun submenu-generate-accelerator-spec (list &optional omit-chars-list) "Add auto-generated accelerator specifications to a submenu. @@ -120,6 +128,95 @@ which will not be used as accelerators." ""))) (t ""))) +(defcustom menu-max-items 25 + "*Maximum number of items in generated menus. +If number of entries in such a menu is larger than this value, split menu +into submenus of nearly equal length (see `menu-submenu-max-items'). If +nil, never split menu into submenus." + :group 'menu + :type '(choice (const :tag "no submenus" nil) + (integer))) + +(defcustom menu-submenu-max-items 20 + "*Maximum number of items in submenus when splitting menus. +We split large menus into submenus of this many items, and then balance +them out as much as possible (otherwise the last submenu may have very few +items)." + :group 'menu + :type 'integer) + +(defcustom menu-submenu-name-format "%-12.12s ... %.12s" + "*Format specification of the submenu name when splitting menus. +Used by `menu-split-long-menu' if the number of entries in a menu is +larger than `menu-menu-max-items'. +This string should contain one %s for the name of the first entry and +one %s for the name of the last entry in the submenu. +If the value is a function, it should return the submenu name. The +function is be called with two arguments, the names of the first and +the last entry in the menu." + :group 'menu + :type '(choice (string :tag "Format string") + (function))) + +(defun menu-split-long-menu (menu) + "Split MENU according to `menu-max-items' and add accelerator specs. + +You should normally use the idiom + +\(menu-split-long-menu (menu-sort-menu menu)) + +See also `menu-sort-menu'." + (let ((len (length menu))) + (if (or (null menu-max-items) + (<= len menu-max-items)) + (submenu-generate-accelerator-spec menu) + (let* ((outer (/ (+ len (1- menu-submenu-max-items)) + menu-submenu-max-items)) + (inner (/ (+ len (1- outer)) outer)) + (result nil)) + (while menu + (let ((sub nil) + (from (car menu))) + (dotimes (foo (min inner len)) + (setq sub (cons (car menu) sub) + menu (cdr menu))) + (setq len (- len inner)) + (let ((to (car sub))) + (setq sub (nreverse sub)) + (setq result + (cons (cons (if (stringp menu-submenu-name-format) + (format menu-submenu-name-format + (menu-item-strip-accelerator-spec + (aref from 0)) + (menu-item-strip-accelerator-spec + (aref to 0))) + (funcall menu-submenu-name-format + (menu-item-strip-accelerator-spec + (aref from 0)) + (menu-item-strip-accelerator-spec + (aref to 0)))) + (submenu-generate-accelerator-spec sub)) + result))))) + (submenu-generate-accelerator-spec (nreverse result)))))) + +(defun menu-sort-menu (menu) + "Sort MENU alphabetically. + +You should normally use the idiom + +\(menu-split-long-menu (menu-sort-menu menu)) + +See also `menu-split-long-menu'." + (sort menu + #'(lambda (a b) (string-lessp (aref a 0) (aref b 0))))) + +(defun menu-item-search () + "Bring up a search dialog if possible and desired, else do interactive search" + (interactive) + (if (should-use-dialog-box-p) + (make-search-dialog) + (isearch-forward))) + (defconst default-menubar ; (purecopy-menubar ;purespace is dead ;; note backquote. @@ -139,15 +236,19 @@ which will not be used as accelerators." ["Save %_As..." write-file] ["Save So%_me Buffers" save-some-buffers] "-----" + ,@(if (valid-specifier-tag-p 'msprinter) + '(["Page Set%_up..." generic-page-setup])) ["%_Print" generic-print-buffer :active (or (valid-specifier-tag-p 'msprinter) (and (not (eq system-type 'windows-nt)) - (fboundp 'lpr-buffer))) - :suffix (if put-buffer-names-in-file-menu (concat (buffer-name) "...") - "...")] - ["Prett%_y-Print" ps-print-buffer-with-faces - :active (fboundp 'ps-print-buffer-with-faces) - :suffix (if put-buffer-names-in-file-menu (buffer-name) "")] + (fboundp 'lpr-region))) + :suffix (if (region-active-p) "Selection..." + (if put-buffer-names-in-file-menu (concat (buffer-name) "...") + "..."))] + ,@(unless (valid-specifier-tag-p 'msprinter) + '(["Prett%_y-Print" ps-print-buffer-with-faces + :active (fboundp 'ps-print-buffer-with-faces) + :suffix (if put-buffer-names-in-file-menu (buffer-name) "")])) "-----" ["%_Revert Buffer" revert-buffer :active (or buffer-file-name revert-buffer-function) @@ -189,7 +290,7 @@ which will not be used as accelerators." ["Select %_All" mark-whole-buffer] ["Select Pa%_ge" mark-page] "----" - ["%_Find..." make-search-dialog] + ["%_Find..." menu-item-search] ["R%_eplace..." query-replace] ["Replace (Rege%_xp)..." query-replace-regexp] ["%_List Matching Lines..." list-matching-lines] @@ -392,23 +493,26 @@ which will not be used as accelerators." ("%_Tools" ("%_Packages" - ("%_Add Download Site" - :filter (lambda (&rest junk) - (submenu-generate-accelerator-spec - (package-get-download-menu)))) + ("%_Set Download Site" + ("%_Official Releases" + :filter (lambda (&rest junk) + (menu-split-long-menu + (submenu-generate-accelerator-spec + (package-ui-download-menu))))) + ("%_Pre-Releases" + :filter (lambda (&rest junk) + (menu-split-long-menu + (submenu-generate-accelerator-spec + (package-ui-pre-release-download-menu))))) + ("%_Site Releases" + :filter (lambda (&rest junk) + (menu-split-long-menu + (submenu-generate-accelerator-spec + (package-ui-site-release-download-menu)))))) + "--:shadowEtchedIn" ["%_Update Package Index" package-get-update-base] ["%_List and Install" pui-list-packages] ["U%_pdate Installed Packages" package-get-update-all] - ;; hack-o-matic, we can't force a load of package-base here - ;; since it triggers dialog box interactions which we can't - ;; deal with while using a menu - ("Using %_Custom" - :filter (lambda (&rest junk) - (if package-get-base - (submenu-generate-accelerator-spec - (cdr (custom-menu-create 'packages))) - '("Please load Package Index")))) - ["%_Help" (Info-goto-node "(xemacs)Packages")]) ("%_Internet" ["Read Mail %_1 (VM)..." vm @@ -429,10 +533,11 @@ which will not be used as accelerators." menu (let ((items (submenu-generate-accelerator-spec - (mapcar #'(lambda (string) - (vector string - (list 'grep string))) - (menu-truncate-list grep-history 10))))) + (mapcar #'(lambda (label-value) + (vector (first label-value) + (list 'grep (second label-value)))) + (Menubar-items-truncate-history + grep-history 10 50))))) (append menu '("---") items)))) ["%_Grep..." grep :active (fboundp 'grep)] ["%_Kill Grep" kill-compilation @@ -537,10 +642,11 @@ which will not be used as accelerators." menu (let ((items (submenu-generate-accelerator-spec - (mapcar #'(lambda (string) - (vector string - (list 'compile string))) - (menu-truncate-list compile-history 10))))) + (mapcar #'(lambda (label-value) + (vector (first label-value) + (list 'compile (second label-value)))) + (Menubar-items-truncate-history + compile-history 10 50))))) (append menu '("---") items)))) ["%_Compile..." compile :active (fboundp 'compile)] ["%_Repeat Compilation" recompile :active (fboundp 'recompile)] @@ -883,6 +989,14 @@ which will not be used as accelerators." :active (and (boundp 'browse-url-browser-function) (fboundp 'browse-url-w3) (fboundp 'w3-fetch))] + ["Emacs-%_W3 (gnudoit)" + (customize-set-variable 'browse-url-browser-function 'browse-url-w3-gnudoit) + :style radio + :selected (and (boundp 'browse-url-browser-function) + (eq browse-url-browser-function + 'browse-url-w3-gnudoit)) + :active (and (boundp 'browse-url-browser-function) + (fboundp 'browse-url-w3-gnudoit))] ["%_Netscape" (customize-set-variable 'browse-url-browser-function 'browse-url-netscape) @@ -938,14 +1052,66 @@ which will not be used as accelerators." (eq browse-url-browser-function 'browse-url-grail)) :active (and (boundp 'browse-url-browser-function) (fboundp 'browse-url-grail))] - ["%_Kfm" + ["%_KDE" + (customize-set-variable 'browse-url-browser-function + 'browse-url-kde) + :style radio + :selected (and (boundp 'browse-url-browser-function) + (eq browse-url-browser-function 'browse-url-kde)) + :active (and (boundp 'browse-url-browser-function) + (fboundp 'browse-url-kde))] + ["Mo%_zilla" + (customize-set-variable 'browse-url-browser-function + 'browse-url-mozilla) + :style radio + :selected (and (boundp 'browse-url-browser-function) + (eq browse-url-browser-function 'browse-url-mozilla)) + :active (and (boundp 'browse-url-browser-function) + (fboundp 'browse-url-mozilla))] + ["G%_aleon" + (customize-set-variable 'browse-url-browser-function + 'browse-url-galeon) + :style radio + :selected (and (boundp 'browse-url-browser-function) + (eq browse-url-browser-function 'browse-url-galeon)) + :active (and (boundp 'browse-url-browser-function) + (fboundp 'browse-url-galeon))] + ["%_Opera" + (customize-set-variable 'browse-url-browser-function + 'browse-url-opera) + :style radio + :selected (and (boundp 'browse-url-browser-function) + (eq browse-url-browser-function 'browse-url-opera)) + :active (and (boundp 'browse-url-browser-function) + (fboundp 'browse-url-opera))] + ["%_MMM" + (customize-set-variable 'browse-url-browser-function + 'browse-url-mmm) + :style radio + :selected (and (boundp 'browse-url-browser-function) + (eq browse-url-browser-function 'browse-url-mmm)) + :active (and (boundp 'browse-url-browser-function) + (fboundp 'browse-url-mmm))] + ["MS-Windows Default %_Browser" + (customize-set-variable 'browse-url-browser-function + 'browse-url-default-windows-browser) + :style radio + :selected (and (boundp 'browse-url-browser-function) + (eq browse-url-browser-function + 'browse-url-default-windows-browser)) + :active (and (boundp 'browse-url-browser-function) + (fboundp 'mswindows-shell-execute) + (fboundp 'browse-url-default-windows-browser))] + ["G%_eneric Browser" (customize-set-variable 'browse-url-browser-function - 'browse-url-kfm) + 'browse-url-generic) :style radio :selected (and (boundp 'browse-url-browser-function) - (eq browse-url-browser-function 'browse-url-kfm)) + (eq browse-url-browser-function 'browse-url-generic)) :active (and (boundp 'browse-url-browser-function) - (fboundp 'browse-url-kfm))] + (boundp 'browse-url-generic-program) + browse-url-generic-program + (fboundp 'browse-url-generic))] )) ("%_Troubleshooting" ["%_Debug on Error" @@ -1404,7 +1570,7 @@ which will not be used as accelerators." (progn (find-file (or user-init-file "~/.xemacs/init.el")) (or (eq major-mode 'emacs-lisp-mode) (emacs-lisp-mode)))] - ["%_Save Options to Init File" customize-save-customized] + ["%_Save Options to Custom File" customize-save-customized] ) ("%_Buffers" @@ -1423,7 +1589,7 @@ which will not be used as accelerators." ("%_Help" ["%_About XEmacs..." about-xemacs] "-----" - ["XEmacs %_News" view-emacs-news] + ["What's %_New in XEmacs" view-emacs-news] ["%_Obtaining XEmacs" describe-distribution] "-----" ("%_Info (Online Docs)" @@ -1478,8 +1644,8 @@ which will not be used as accelerators." ["Find %_Packages" finder-by-keyword] ["View %_Splash Screen" xemacs-splash-buffer] ["%_Unix Manual..." manual-entry]) - ["Send %_Bug Report..." report-emacs-bug - :active (fboundp 'report-emacs-bug)]))) + ["Send %_Bug Report..." report-xemacs-bug + :active (fboundp 'report-xemacs-bug)]))) (defun maybe-add-init-button ()