;;; Code:
-(defun Menubar-items-truncate-list (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) 50) x (concat "..." (substring x -50))))
- (if (<= (length list) n)
+ (if (<= (length x) label-length)
+ (list x x)
+ (list
+ (concat "..." (substring x (- label-length))) x)))
+ (if (<= (length list) count)
list
- (butlast list (- (length list) n)))))
+ (butlast list (- (length list) count)))))
(defun submenu-generate-accelerator-spec (list &optional omit-chars-list)
"Add auto-generated accelerator specifications to a submenu.
"")))
(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.
["Save %_As..." write-file]
["Save So%_me Buffers" save-some-buffers]
"-----"
- ,@(if (eq system-type 'windows-nt)
+ ,@(if (valid-specifier-tag-p 'msprinter)
'(["Page Set%_up..." generic-page-setup]))
["%_Print" generic-print-buffer
:active (or (valid-specifier-tag-p 'msprinter)
:suffix (if (region-active-p) "Selection..."
(if put-buffer-names-in-file-menu (concat (buffer-name) "...")
"..."))]
- ,@(unless (eq system-type 'windows-nt)
+ ,@(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) "")]))
["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]
("%_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
menu
(let ((items
(submenu-generate-accelerator-spec
- (mapcar #'(lambda (string)
- (vector string
- (list 'grep string)))
- (Menubar-items-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
menu
(let ((items
(submenu-generate-accelerator-spec
- (mapcar #'(lambda (string)
- (vector string
- (list 'compile string)))
- (Menubar-items-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)]
: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)
(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"
(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"
["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)])))
\f
(defun maybe-add-init-button ()