git.chise.org Git - chise/xemacs-chise.git.1/blob - lisp/menubar-items.el

   1 ;;; menubar-items.el --- Menubar and popup-menu content for XEmacs.
   2
   3 ;; Copyright (C) 1991-1995, 1997-1998 Free Software Foundation, Inc.
   4 ;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
   5 ;; Copyright (C) 1995 Sun Microsystems.
   6 ;; Copyright (C) 1995, 1996, 2000 Ben Wing.
   7 ;; Copyright (C) 1997 MORIOKA Tomohiko.
   8
   9 ;; Maintainer: XEmacs Development Team
  10 ;; Keywords: frames, extensions, internal, dumped
  11
  12 ;; This file is part of XEmacs.
  13
  14 ;; XEmacs is free software; you can redistribute it and/or modify it
  15 ;; under the terms of the GNU General Public License as published by
  16 ;; the Free Software Foundation; either version 2, or (at your option)
  17 ;; any later version.
  18
  19 ;; XEmacs is distributed in the hope that it will be useful, but
  20 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  22 ;; General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with Xmacs; see the file COPYING.  If not, write to the
  26 ;; Free Software Foundation, 59 Temple Place - Suite 330,
  27 ;; Boston, MA 02111-1307, USA.
  28
  29 ;;; Authorship:
  30
  31 ;; Created c. 1991 for Lucid Emacs.  Originally called x-menubar.el.
  32 ;;   Contained four menus -- File, Edit, Buffers, Help.
  33 ;;   Dynamic menu changes possible only through activate-menubar-hook.
  34 ;;   Also contained menu manipulation funs, e.g. find-menu-item, add-menu.
  35 ;; Options menu added for 19.9 by Jamie Zawinski, late 1993.
  36 ;; Major reorganization c. 1994 by Ben Wing; added many items and moved
  37 ;;   some items to two new menus, Apps and Tools. (for 19.10?)
  38 ;; Generic menubar functions moved to new file, menubar.el, by Ben Wing,
  39 ;;   1995, for 19.12; also, creation of current buffers menu options,
  40 ;;   and buffers menu changed from purely most-recent to sorted alphabetical,
  41 ;;   by mode.  Also added mode-popup-menu support.
  42 ;; New API (add-submenu, add-menu-button) and menu filter support added
  43 ;;   late summer 1995 by Stig, for 19.13.  Also popup-menubar-menu.
  44 ;; Renamed to menubar-items.el c. 1998, with MS Win support.
  45 ;; Options menu rewritten to use custom c. 1999 by ? (Jan Vroonhof?).
  46 ;; Major reorganization Mar. 2000 by Ben Wing; added many items and changed
  47 ;;   top-level menus to File, Edit, View, Cmds, Tools, Options, Buffers.
  48 ;; Accelerator spec functionality added Mar. 2000 by Ben Wing.
  49
  50 ;;; Commentary:
  51
  52 ;; This file is dumped with XEmacs (when window system and menubar support is
  53 ;; compiled in).
  54
  55 ;;; Code:
  56
  57 (defun Menubar-items-truncate-history (list count label-length)
  58   "Truncate a history LIST to first COUNT items.
  59 Return a list of (label value) lists with labels truncated to last
  60 LABEL-LENGTH characters of value."
  61   (mapcar #'(lambda (x)
  62               (if (<= (length x) label-length)
  63                   (list x x)
  64                 (list
  65                  (concat "..." (substring x (- label-length))) x)))
  66           (if (<= (length list) count)
  67               list
  68             (butlast list (- (length list) count)))))
  69
  70 (defun submenu-generate-accelerator-spec (list &optional omit-chars-list)
  71   "Add auto-generated accelerator specifications to a submenu.
  72 This can be used to add accelerators to the return value of a menu filter
  73 function.  It correctly ignores unselectable items.  It will destructively
  74 modify the list passed to it.  If an item already has an auto-generated
  75 accelerator spec, this will be removed before the new one is added, making
  76 this function idempotent.
  77
  78 If OMIT-CHARS-LIST is given, it should be a list of lowercase characters,
  79 which will not be used as accelerators."
  80   (let ((n 0))
  81     (dolist (item list list)
  82       (cond
  83        ((vectorp item)
  84         (setq n (1+ n))
  85         (aset item 0
  86               (concat
  87                (menu-item-generate-accelerator-spec n omit-chars-list)
  88                (menu-item-strip-accelerator-spec (aref item 0)))))
  89        ((consp item)
  90         (setq n (1+ n))
  91         (setcar item
  92                 (concat
  93                  (menu-item-generate-accelerator-spec n omit-chars-list)
  94                  (menu-item-strip-accelerator-spec (car item)))))))))
  95
  96 (defun menu-item-strip-accelerator-spec (item)
  97   "Strip an auto-generated accelerator spec off of ITEM.
  98 ITEM should be a string.  This removes specs added by
  99 `menu-item-generate-accelerator-spec' and `submenu-generate-accelerator-spec'."
 100   (if (string-match "%_. " item)
 101       (substring item 4)
 102     item))
 103
 104 (defun menu-item-generate-accelerator-spec (n &optional omit-chars-list)
 105   "Return an accelerator specification for use with auto-generated menus.
 106 This should be concat'd onto the beginning of each menu line.  The spec
 107 allows the Nth line to be selected by the number N.  '0' is used for the
 108 10th line, and 'a' through 'z' are used for the following 26 lines.
 109
 110 If OMIT-CHARS-LIST is given, it should be a list of lowercase characters,
 111 which will not be used as accelerators."
 112   (cond ((< n 10) (concat "%_" (int-to-string n) " "))
 113         ((= n 10) "%_0 ")
 114         ((<= n 36)
 115          (setq n (- n 10))
 116          (let ((m 0))
 117            (while (> n 0)
 118              (setq m (1+ m))
 119              (while (memq (int-to-char (+ m (- (char-to-int ?a) 1)))
 120                           omit-chars-list)
 121                (setq m (1+ m)))
 122              (setq n (1- n)))
 123            (if (<= m 26)
 124                (concat
 125                 "%_"
 126                 (char-to-string (int-to-char (+ m (- (char-to-int ?a) 1))))
 127                 " ")
 128              "")))
 129         (t "")))
 130
 131 (defcustom menu-max-items 25
 132   "*Maximum number of items in generated menus.
 133 If number of entries in such a menu is larger than this value, split menu
 134 into submenus of nearly equal length (see `menu-submenu-max-items').  If
 135 nil, never split menu into submenus."
 136   :group 'menu
 137   :type '(choice (const :tag "no submenus" nil)
 138                  (integer)))
 139
 140 (defcustom menu-submenu-max-items 20
 141   "*Maximum number of items in submenus when splitting menus.
 142 We split large menus into submenus of this many items, and then balance
 143 them out as much as possible (otherwise the last submenu may have very few
 144 items)."
 145   :group 'menu
 146   :type 'integer)
 147
 148 (defcustom menu-submenu-name-format "%-12.12s ... %.12s"
 149   "*Format specification of the submenu name when splitting menus.
 150 Used by `menu-split-long-menu' if the number of entries in a menu is
 151 larger than `menu-menu-max-items'.
 152 This string should contain one %s for the name of the first entry and
 153 one %s for the name of the last entry in the submenu.
 154 If the value is a function, it should return the submenu name.  The
 155 function is be called with two arguments, the names of the first and
 156 the last entry in the menu."
 157   :group 'menu
 158   :type '(choice (string :tag "Format string")
 159                  (function)))
 160
 161 (defun menu-split-long-menu (menu)
 162   "Split MENU according to `menu-max-items' and add accelerator specs.
 163
 164 You should normally use the idiom
 165
 166 \(menu-split-long-menu (menu-sort-menu menu))
 167
 168 See also `menu-sort-menu'."
 169   (let ((len (length menu)))
 170     (if (or (null menu-max-items)
 171             (<= len menu-max-items))
 172         (submenu-generate-accelerator-spec menu)
 173       (let* ((outer (/ (+ len (1- menu-submenu-max-items))
 174                        menu-submenu-max-items))
 175              (inner (/ (+ len (1- outer)) outer))
 176              (result nil))
 177         (while menu
 178           (let ((sub nil)
 179                 (from (car menu)))
 180             (dotimes (foo (min inner len))
 181               (setq sub  (cons (car menu) sub)
 182                     menu (cdr menu)))
 183             (setq len (- len inner))
 184             (let ((to (car sub)))
 185               (setq sub (nreverse sub))
 186               (setq result
 187                     (cons (cons (if (stringp menu-submenu-name-format)
 188                                     (format menu-submenu-name-format
 189                                             (menu-item-strip-accelerator-spec
 190                                              (aref from 0))
 191                                             (menu-item-strip-accelerator-spec
 192                                              (aref to 0)))
 193                                   (funcall menu-submenu-name-format
 194                                            (menu-item-strip-accelerator-spec
 195                                             (aref from 0))
 196                                            (menu-item-strip-accelerator-spec
 197                                             (aref to 0))))
 198                                 (submenu-generate-accelerator-spec sub))
 199                           result)))))
 200         (submenu-generate-accelerator-spec (nreverse result))))))
 201
 202 (defun menu-sort-menu (menu)
 203   "Sort MENU alphabetically.
 204
 205 You should normally use the idiom
 206
 207 \(menu-split-long-menu (menu-sort-menu menu))
 208
 209 See also `menu-split-long-menu'."
 210   (sort menu
 211         #'(lambda (a b) (string-lessp (aref a 0) (aref b 0)))))
 212
 213 (defun menu-item-search ()
 214   "Bring up a search dialog if possible and desired, else do interactive search"
 215   (interactive)
 216   (if (should-use-dialog-box-p)
 217       (make-search-dialog)
 218     (isearch-forward)))
 219
 220 (defconst default-menubar
 221 ; (purecopy-menubar ;purespace is dead
 222    ;; note backquote.
 223    `(
 224      ("%_File"
 225       ["%_Open..." find-file]
 226       ["Open in Other %_Window..." find-file-other-window]
 227       ["Open in New %_Frame..." find-file-other-frame]
 228       ["%_Hex Edit File..." hexl-find-file
 229        :active (fboundp 'hexl-find-file)]
 230       ["%_Insert File..." insert-file]
 231       ["%_View File..." view-file]
 232       "------"
 233       ["%_Save" save-buffer
 234        :active (buffer-modified-p)
 235        :suffix (if put-buffer-names-in-file-menu (buffer-name) "")]
 236       ["Save %_As..." write-file]
 237       ["Save So%_me Buffers" save-some-buffers]
 238       "-----"
 239       ,@(if (valid-specifier-tag-p 'msprinter)
 240           '(["Page Set%_up..." generic-page-setup]))
 241       ["%_Print" generic-print-buffer
 242        :active (or (valid-specifier-tag-p 'msprinter)
 243                    (and (not (eq system-type 'windows-nt))
 244                         (fboundp 'lpr-region)))
 245        :suffix (if (region-active-p) "Selection..."
 246                  (if put-buffer-names-in-file-menu (concat (buffer-name) "...")
 247                    "..."))]
 248       ,@(unless (valid-specifier-tag-p 'msprinter)
 249           '(["Prett%_y-Print" ps-print-buffer-with-faces
 250              :active (fboundp 'ps-print-buffer-with-faces)
 251              :suffix (if put-buffer-names-in-file-menu (buffer-name) "")]))
 252       "-----"
 253       ["%_Revert Buffer" revert-buffer
 254        :active (or buffer-file-name revert-buffer-function)
 255        :suffix (if put-buffer-names-in-file-menu (buffer-name) "")]
 256       ["Re%_cover File..." recover-file]
 257       ["Recover S%_ession..." recover-session]
 258       "-----"
 259       ["E%_xit XEmacs" save-buffers-kill-emacs]
 260       )
 261
 262      ("%_Edit"
 263       ["%_Undo" advertised-undo
 264        :active (and (not (eq buffer-undo-list t))
 265                     (or buffer-undo-list pending-undo-list))
 266        :suffix (if (or (eq last-command 'undo)
 267                        (eq last-command 'advertised-undo))
 268                    "More" "")]
 269       ["%_Redo" redo
 270        :included (fboundp 'redo)
 271        :active (not (or (eq buffer-undo-list t)
 272                         (eq last-buffer-undo-list nil)
 273                         (not (or (eq last-buffer-undo-list buffer-undo-list)
 274                                  (and (null (car-safe buffer-undo-list))
 275                                       (eq last-buffer-undo-list
 276                                           (cdr-safe buffer-undo-list)))))
 277                         (or (eq buffer-undo-list pending-undo-list)
 278                             (eq (cdr buffer-undo-list) pending-undo-list))))
 279        :suffix (if (eq last-command 'redo) "More" "")]
 280       "----"
 281       ["Cu%_t" kill-primary-selection
 282        :active (selection-owner-p)]
 283       ["%_Copy" copy-primary-selection
 284        :active (selection-owner-p)]
 285       ["%_Paste" yank-clipboard-selection
 286        :active (selection-exists-p 'CLIPBOARD)]
 287       ["%_Delete" delete-primary-selection
 288        :active (selection-owner-p)]
 289       "----"
 290       ["Select %_All" mark-whole-buffer]
 291       ["Select Pa%_ge" mark-page]
 292       "----"
 293       ["%_Find..." menu-item-search]
 294       ["R%_eplace..." query-replace]
 295       ["Replace (Rege%_xp)..." query-replace-regexp]
 296       ["%_List Matching Lines..." list-matching-lines]
 297       ,@(when (featurep 'mule)
 298          '("----"
 299            ("%_Multilingual (\"Mule\")"
 300             ("%_Describe Language Support")
 301             ("%_Set Language Environment")
 302             "--"
 303             ["T%_oggle Input Method" toggle-input-method]
 304             ["Select %_Input Method" set-input-method]
 305             ["D%_escribe Input Method" describe-input-method]
 306             "--"
 307             ["Describe Current %_Coding Systems"
 308              describe-current-coding-system]
 309             ["Set Coding System of %_Buffer File..."
 310              set-buffer-file-coding-system]
 311             ;; not implemented yet
 312             ["Set Coding System of %_Terminal..."
 313              set-terminal-coding-system :active nil]
 314             ;; not implemented yet
 315             ["Set Coding System of %_Keyboard..."
 316              set-keyboard-coding-system :active nil]
 317             ["Set Coding System of %_Process..."
 318              set-buffer-process-coding-system
 319              :active (get-buffer-process (current-buffer))]
 320             "--"
 321             ["Show Cha%_racter Table" view-charset-by-menu]
 322             ;; not implemented yet
 323             ["Show Dia%_gnosis for MULE" mule-diag :active nil]
 324             ["Show \"%_hello\" in Many Languages" view-hello-file]))
 325          )
 326       )
 327
 328      ("%_View"
 329       ["%_New Frame" make-frame]
 330       ["Frame on Other Displa%_y..." make-frame-on-display
 331        :active (fboundp 'make-frame-on-display)]
 332       ["%_Delete Frame" delete-frame
 333        :active (not (eq (next-frame (selected-frame) 'nomini 'window-system)
 334                         (selected-frame)))]
 335       "-----"
 336       ["%_Split Window" split-window-vertically]
 337       ["S%_plit Window (Side by Side)" split-window-horizontally]
 338       ["%_Un-Split (Keep This)" delete-other-windows
 339        :active (not (one-window-p t))]
 340       ["Un-Split (Keep %_Others)" delete-window
 341        :active (not (one-window-p t))]
 342       "----"
 343       ("N%_arrow"
 344        ["%_Narrow to Region" narrow-to-region :active (region-exists-p)]
 345        ["Narrow to %_Page" narrow-to-page]
 346        ["Narrow to %_Defun" narrow-to-defun]
 347       "----"
 348        ["%_Widen" widen :active (or (/= (point-min) 1)
 349                                     (/= (point-max) (1+ (buffer-size))))]
 350        )
 351       "----"
 352       ["Show Message %_Log" show-message-log]
 353       "----"
 354       ["%_Goto Line..." goto-line]
 355       ["%_What Line" what-line]
 356       ("%_Bookmarks"
 357        :filter bookmark-menu-filter)
 358       "----"
 359       ["%_Jump to Previous Mark" (set-mark-command t)
 360        :active (mark t)]
 361       )
 362
 363      ("C%_mds"
 364       ["Repeat %_Last Complex Command..." repeat-complex-command]
 365       ["E%_valuate Lisp Expression..." eval-expression]
 366       ["Execute %_Named Command..." execute-extended-command]
 367       "----"
 368       ["Start %_Macro Recording" start-kbd-macro
 369        :included (not defining-kbd-macro)]
 370       ["End %_Macro Recording" end-kbd-macro
 371        :included defining-kbd-macro]
 372       ["E%_xecute Last Macro" call-last-kbd-macro
 373        :active last-kbd-macro]
 374       ("%_Other Macro"
 375        ["%_Append to Last Macro" (start-kbd-macro t)
 376         :active (and (not defining-kbd-macro) last-kbd-macro)]
 377        ["%_Query User During Macro" kbd-macro-query
 378         :active defining-kbd-macro]
 379        ["Enter %_Recursive Edit During Macro" (kbd-macro-query t)
 380         :active defining-kbd-macro]
 381        "---"
 382        ["E%_xecute Last Macro on Region Lines"
 383         :active (and last-kbd-macro (region-exists-p))]
 384        "---"
 385        ["%_Name Last Macro..." name-last-kbd-macro
 386         :active last-kbd-macro]
 387        ["Assign Last Macro to %_Key..." assign-last-kbd-macro-to-key
 388         :active (and last-kbd-macro
 389                      (fboundp 'assign-last-kbd-macro-to-key))]
 390        "---"
 391        ["%_Edit Macro..." edit-kbd-macro]
 392        ["Edit %_Last Macro" edit-last-kbd-macro
 393         :active last-kbd-macro]
 394        "---"
 395        ["%_Insert Named Macro into Buffer..." insert-kbd-macro]
 396        ["Read Macro from Re%_gion" read-kbd-macro
 397         :active (region-exists-p)]
 398        )
 399       "----"
 400       ("%_Abbrev"
 401        ["D%_ynamic Abbrev Expand" dabbrev-expand]
 402        ["Dynamic Abbrev %_Complete" dabbrev-completion]
 403        ["Dynamic Abbrev Complete in %_All Buffers" (dabbrev-completion 16)]
 404        "----"
 405        "----"
 406        ["%_Define Global Abbrev for " add-global-abbrev
 407         :suffix (abbrev-string-to-be-defined nil)
 408         :active abbrev-mode]
 409        ["Define %_Mode-Specific Abbrev for " add-mode-abbrev
 410         :suffix (abbrev-string-to-be-defined nil)
 411         :active abbrev-mode]
 412        ["Define Global Ex%_pansion for " inverse-add-global-abbrev
 413         :suffix (inverse-abbrev-string-to-be-defined 1)
 414         :active abbrev-mode]
 415        ["Define Mode-Specific Expa%_nsion for " inverse-add-mode-abbrev
 416         :suffix (inverse-abbrev-string-to-be-defined 1)
 417         :active abbrev-mode]
 418        "---"
 419        ["E%_xpand Abbrev" expand-abbrev]
 420        ["Expand Abbrevs in Re%_gion" expand-region-abbrevs
 421         :active (region-exists-p)]
 422        ["%_Unexpand Last Abbrev" unexpand-abbrev
 423         :active (and (stringp last-abbrev-text)
 424                      (> last-abbrev-location 0))]
 425        "---"
 426        ["%_Kill All Abbrevs" kill-all-abbrevs]
 427        ["%_Insert All Abbrevs into Buffer" insert-abbrevs]
 428        ["%_List Abbrevs" list-abbrevs]
 429        "---"
 430        ["%_Edit Abbrevs" edit-abbrevs]
 431        ["%_Redefine Abbrevs from Buffer" edit-abbrevs-redefine
 432         :active (eq major-mode 'edit-abbrevs-mode)]
 433        "---"
 434        ["%_Save Abbrevs As..." write-abbrev-file]
 435        ["L%_oad Abbrevs..." read-abbrev-file]
 436        )
 437       ("%_Register"
 438        ["%_Copy to Register..." copy-to-register :active (region-exists-p)]
 439        ["%_Paste Register..." insert-register]
 440        "---"
 441        ["%_Save Point to Register" point-to-register]
 442        ["%_Jump to Register"  register-to-point]
 443        )
 444       ("R%_ectangles"
 445        ["%_Kill Rectangle" kill-rectangle]
 446        ["%_Yank Rectangle" yank-rectangle]
 447        ["Rectangle %_to Register" copy-rectangle-to-register]
 448        ["Rectangle %_from Register" insert-register]
 449        ["%_Clear Rectangle" clear-rectangle]
 450        ["%_Open Rectangle" open-rectangle]
 451        ["%_Prefix Rectangle..." string-rectangle]
 452        ["Rectangle %_Mousing"
 453         (customize-set-variable 'mouse-track-rectangle-p
 454                                 (not mouse-track-rectangle-p))
 455         :style toggle :selected mouse-track-rectangle-p]
 456        )
 457       ("%_Sort"
 458        ["%_Lines in Region" sort-lines :active (region-exists-p)]
 459        ["%_Paragraphs in Region" sort-paragraphs :active (region-exists-p)]
 460        ["P%_ages in Region" sort-pages :active (region-exists-p)]
 461        ["%_Columns in Region" sort-columns :active (region-exists-p)]
 462        ["%_Regexp..." sort-regexp-fields :active (region-exists-p)]
 463        )
 464       ("%_Change Case"
 465        ["%_Upcase Region" upcase-region :active (region-exists-p)]
 466        ["%_Downcase Region" downcase-region :active (region-exists-p)]
 467        ["%_Capitalize Region" capitalize-region :active (region-exists-p)]
 468        ["%_Title-Case Region" capitalize-region-as-title
 469         :active (region-exists-p)]
 470        )
 471       ("Ce%_nter"
 472        ["%_Line" center-line]
 473        ["%_Paragraph" center-paragraph]
 474        ["%_Region" center-region :active (region-exists-p)]
 475        )
 476       ("%_Indent"
 477        ["%_As Previous Line" indent-relative]
 478        ["%_To Column..." indent-to-column]
 479        "---"
 480        ["%_Region" indent-region :active (region-exists-p)]
 481        ["%_Balanced Expression" indent-sexp]
 482        ["%_C Expression" indent-c-exp]
 483        )
 484       ("S%_pell-Check"
 485        ["%_Buffer" ispell-buffer
 486         :active (fboundp 'ispell-buffer)]
 487        "---"
 488        ["%_Word" ispell-word]
 489        ["%_Complete Word" ispell-complete-word]
 490        ["%_Region" ispell-region]
 491        )
 492       )
 493
 494      ("%_Tools"
 495       ("%_Packages"
 496        ("%_Set Download Site"
 497         ("%_Official Releases"
 498          :filter (lambda (&rest junk)
 499                    (menu-split-long-menu
 500                     (submenu-generate-accelerator-spec
 501                      (package-ui-download-menu)))))
 502         ("%_Pre-Releases"
 503          :filter (lambda (&rest junk)
 504                    (menu-split-long-menu
 505                     (submenu-generate-accelerator-spec
 506                      (package-ui-pre-release-download-menu)))))
 507         ("%_Site Releases"
 508          :filter (lambda (&rest junk)
 509                    (menu-split-long-menu
 510                     (submenu-generate-accelerator-spec
 511                      (package-ui-site-release-download-menu))))))
 512        "--:shadowEtchedIn"
 513        ["%_Update Package Index" package-get-update-base]
 514        ["%_List and Install" pui-list-packages]
 515        ["U%_pdate Installed Packages" package-get-update-all]
 516        ["%_Help" (Info-goto-node "(xemacs)Packages")])
 517       ("%_Internet"
 518        ["Read Mail %_1 (VM)..." vm
 519         :active (fboundp 'vm)]
 520        ["Read Mail %_2 (MH)..." (mh-rmail t)
 521         :active (fboundp 'mh-rmail)]
 522        ["Send %_Mail..." compose-mail
 523         :active (fboundp 'compose-mail)]
 524        ["Usenet %_News" gnus
 525         :active (fboundp 'gnus)]
 526        ["Browse the %_Web" w3
 527         :active (fboundp 'w3)])
 528       "---"
 529       ("%_Grep"
 530        :filter
 531        (lambda (menu)
 532          (if (or (not (boundp 'grep-history)) (null grep-history))
 533              menu
 534            (let ((items
 535                   (submenu-generate-accelerator-spec
 536                    (mapcar #'(lambda (label-value)
 537                                (vector (first label-value)
 538                                        (list 'grep (second label-value))))
 539                            (Menubar-items-truncate-history
 540                             grep-history 10 50)))))
 541              (append menu '("---") items))))
 542        ["%_Grep..." grep :active (fboundp 'grep)]
 543        ["%_Kill Grep" kill-compilation
 544         :active (and (fboundp 'kill-compilation)
 545                      (fboundp 'compilation-find-buffer)
 546                      (let ((buffer (condition-case nil
 547                                        (compilation-find-buffer)
 548                                      (error nil))))
 549                        (and buffer (get-buffer-process buffer))))]
 550        "---"
 551        ["Grep %_All Files in Current Directory..."
 552         (progn
 553           (require 'compile)
 554           (let ((grep-command
 555                  (cons (concat grep-command " *")
 556                        (length grep-command))))
 557             (call-interactively 'grep)))
 558         :active (fboundp 'grep)]
 559        ["Grep %_C and C Header Files in Current Directory..."
 560         (progn
 561           (require 'compile)
 562           (let ((grep-command
 563                  (cons (concat grep-command " *.[chCH]"
 564                                         ; i wanted to also use *.cc and *.hh.
 565                                         ; see long comment below under Perl.
 566                                )
 567                        (length grep-command))))
 568             (call-interactively 'grep)))
 569         :active (fboundp 'grep)]
 570        ["Grep C Hea%_der Files in Current Directory..."
 571         (progn
 572           (require 'compile)
 573           (let ((grep-command
 574                  (cons (concat grep-command " *.[hH]"
 575                                         ; i wanted to also use *.hh.
 576                                         ; see long comment below under Perl.
 577                                )
 578                        (length grep-command))))
 579             (call-interactively 'grep)))
 580         :active (fboundp 'grep)]
 581        ["Grep %_E-Lisp Files in Current Directory..."
 582         (progn
 583           (require 'compile)
 584           (let ((grep-command
 585                  (cons (concat grep-command " *.el")
 586                        (length grep-command))))
 587             (call-interactively 'grep)))
 588         :active (fboundp 'grep)]
 589        ["Grep %_Perl Files in Current Directory..."
 590         (progn
 591           (require 'compile)
 592           (let ((grep-command
 593                  (cons (concat grep-command " *.pl"
 594                                         ; i wanted to use this:
 595                                         ; " *.pl *.pm *.am"
 596                                         ; but grep complains if it can't
 597                                         ; match anything in a glob, and
 598                                         ; that screws other things up.
 599                                         ; perhaps we need to first scan
 600                                         ; each separate glob in the directory
 601                                         ; to see if there are any files in
 602                                         ; that glob, and if not, omit it.
 603                                )
 604                        (length grep-command))))
 605             (call-interactively 'grep)))
 606         :active (fboundp 'grep)]
 607        ["Grep %_HTML Files in Current Directory..."
 608         (progn
 609           (require 'compile)
 610           (let ((grep-command
 611                  (cons (concat grep-command " *.*htm*")
 612                        (length grep-command))))
 613             (call-interactively 'grep)))
 614         :active (fboundp 'grep)]
 615        "---"
 616        ["%_Next Match" next-error
 617         :active (and (fboundp 'compilation-errors-exist-p)
 618                      (compilation-errors-exist-p))]
 619        ["Pre%_vious Match" previous-error
 620         :active (and (fboundp 'compilation-errors-exist-p)
 621                      (compilation-errors-exist-p))]
 622        ["%_First Match" first-error
 623         :active (and (fboundp 'compilation-errors-exist-p)
 624                      (compilation-errors-exist-p))]
 625        ["G%_oto Match" compile-goto-error
 626         :active (and (fboundp 'compilation-errors-exist-p)
 627                      (compilation-errors-exist-p))]
 628        "---"
 629        ["%_Set Grep Command..."
 630         (progn
 631           (require 'compile)
 632           (customize-set-variable
 633            'grep-command
 634            (read-shell-command "Default Grep Command: " grep-command)))
 635         :active (fboundp 'grep)
 636         ]
 637        )
 638       ("%_Compile"
 639        :filter
 640        (lambda (menu)
 641          (if (or (not (boundp 'compile-history)) (null compile-history))
 642              menu
 643            (let ((items
 644                   (submenu-generate-accelerator-spec
 645                    (mapcar #'(lambda (label-value)
 646                                (vector (first label-value)
 647                                        (list 'compile (second label-value))))
 648                            (Menubar-items-truncate-history
 649                             compile-history 10 50)))))
 650              (append menu '("---") items))))
 651        ["%_Compile..." compile :active (fboundp 'compile)]
 652        ["%_Repeat Compilation" recompile :active (fboundp 'recompile)]
 653        ["%_Kill Compilation" kill-compilation
 654         :active (and (fboundp 'kill-compilation)
 655                      (fboundp 'compilation-find-buffer)
 656                      (let ((buffer (condition-case nil
 657                                        (compilation-find-buffer)
 658                                      (error nil))))
 659                        (and buffer (get-buffer-process buffer))))]
 660        "---"
 661        ["%_Next Error" next-error
 662         :active (and (fboundp 'compilation-errors-exist-p)
 663                      (compilation-errors-exist-p))]
 664        ["Pre%_vious Error" previous-error
 665         :active (and (fboundp 'compilation-errors-exist-p)
 666                      (compilation-errors-exist-p))]
 667        ["%_First Error" first-error
 668         :active (and (fboundp 'compilation-errors-exist-p)
 669                      (compilation-errors-exist-p))]
 670        ["G%_oto Error" compile-goto-error
 671         :active (and (fboundp 'compilation-errors-exist-p)
 672                      (compilation-errors-exist-p))]
 673        )
 674       ("%_Debug"
 675        ["%_GDB..." gdb
 676         :active (fboundp 'gdb)]
 677        ["%_DBX..." dbx
 678         :active (fboundp 'dbx)])
 679       ("%_Shell"
 680        ["%_Shell" shell
 681         :active (fboundp 'shell)]
 682        ["S%_hell Command..." shell-command
 683         :active (fboundp 'shell-command)]
 684        ["Shell Command on %_Region..." shell-command-on-region
 685        :active (and (fboundp 'shell-command-on-region) (region-exists-p))])
 686
 687       ("%_Tags"
 688        ["%_Find Tag..." find-tag]
 689        ["Find %_Other Window..." find-tag-other-window]
 690        ["%_Next Tag..." (find-tag nil)]
 691        ["N%_ext Other Window..." (find-tag-other-window nil)]
 692        ["Next %_File" next-file]
 693        "-----"
 694        ["Tags %_Search..." tags-search]
 695        ["Tags %_Replace..." tags-query-replace]
 696        ["%_Continue Search/Replace" tags-loop-continue]
 697        "-----"
 698        ["%_Pop stack" pop-tag-mark]
 699        ["%_Apropos..." tags-apropos]
 700        "-----"
 701        ["%_Set Tags Table File..." visit-tags-table]
 702        )
 703
 704       "----"
 705
 706       ("Ca%_lendar"
 707        ["%_3-Month Calendar" calendar
 708         :active (fboundp 'calendar)]
 709        ["%_Diary" diary
 710         :active (fboundp 'diary)]
 711        ["%_Holidays" holidays
 712         :active (fboundp 'holidays)]
 713        ;; we're all pagans at heart ...
 714        ["%_Phases of the Moon" phases-of-moon
 715         :active (fboundp 'phases-of-moon)]
 716        ["%_Sunrise/Sunset" sunrise-sunset
 717         :active (fboundp 'sunrise-sunset)])
 718
 719       ("Ga%_mes"
 720        ["%_Mine Game" xmine
 721         :active (fboundp 'xmine)]
 722        ["%_Tetris" tetris
 723         :active (fboundp 'tetris)]
 724        ["%_Sokoban" sokoban
 725         :active (fboundp 'sokoban)]
 726        ["Quote from %_Zippy" yow
 727         :active (fboundp 'yow)]
 728        ["%_Psychoanalyst" doctor
 729         :active (fboundp 'doctor)]
 730        ["Ps%_ychoanalyze Zippy!" psychoanalyze-pinhead
 731         :active (fboundp 'psychoanalyze-pinhead)]
 732        ["%_Random Flames" flame
 733         :active (fboundp 'flame)]
 734        ["%_Dunnet (Adventure)" dunnet
 735         :active (fboundp 'dunnet)]
 736        ["Towers of %_Hanoi" hanoi
 737         :active (fboundp 'hanoi)]
 738        ["Game of %_Life" life
 739         :active (fboundp 'life)]
 740        ["M%_ultiplication Puzzle" mpuz
 741         :active (fboundp 'mpuz)])
 742
 743       "----"
 744       )
 745
 746      ("%_Options"
 747       ("%_Advanced (Customize)"
 748        ("%_Emacs" :filter (lambda (&rest junk)
 749                             (cdr (custom-menu-create 'emacs))))
 750        ["%_Group..." customize-group]
 751        ["%_Variable..." customize-variable]
 752        ["%_Face..." customize-face]
 753        ["%_Saved..." customize-saved]
 754        ["Se%_t..." customize-customized]
 755        ["%_Apropos..." customize-apropos]
 756        ["%_Browse..." customize-browse])
 757       "---"
 758       ("%_Editing"
 759        ["This Buffer %_Read Only" (toggle-read-only)
 760         :style toggle :selected buffer-read-only]
 761        ["%_Yank/Kill Interact With Clipboard"
 762         (if (eq interprogram-cut-function 'own-clipboard)
 763             (progn
 764               (customize-set-variable 'interprogram-cut-function nil)
 765               (customize-set-variable 'interprogram-paste-function nil))
 766           (customize-set-variable 'interprogram-cut-function 'own-clipboard)
 767           (customize-set-variable 'interprogram-paste-function 'get-clipboard))
 768         :style toggle
 769         :selected (eq interprogram-cut-function 'own-clipboard)]
 770        ["%_Overstrike"
 771         (progn
 772           (setq overwrite-mode (if overwrite-mode nil 'overwrite-mode-textual))
 773           (customize-set-variable 'overwrite-mode overwrite-mode))
 774         :style toggle :selected overwrite-mode]
 775        ["%_Abbrev Mode"
 776         (customize-set-variable 'abbrev-mode
 777                                 (not (default-value 'abbrev-mode)))
 778         :style toggle
 779         :selected (default-value 'abbrev-mode)]
 780        ["Active Re%_gions"
 781         (customize-set-variable 'zmacs-regions (not zmacs-regions))
 782         :style toggle :selected zmacs-regions]
 783        "---"
 784        ["%_Case Sensitive Search"
 785         (customize-set-variable 'case-fold-search
 786                                 (setq case-fold-search (not case-fold-search)))
 787         :style toggle :selected (not case-fold-search)]
 788        ["Case %_Matching Replace"
 789         (customize-set-variable 'case-replace (not case-replace))
 790         :style toggle :selected case-replace]
 791        "---"
 792        ("%_Newline at End of File..."
 793         ["%_Don't Require"
 794          (customize-set-variable 'require-final-newline nil)
 795          :style radio :selected (not require-final-newline)]
 796         ["%_Require"
 797          (customize-set-variable 'require-final-newline t)
 798          :style radio :selected (eq require-final-newline t)]
 799         ["%_Ask"
 800          (customize-set-variable 'require-final-newline 'ask)
 801          :style radio :selected (and require-final-newline
 802                                      (not (eq require-final-newline t)))])
 803        ["Add Newline When Moving Past %_End"
 804         (customize-set-variable 'next-line-add-newlines
 805                                 (not next-line-add-newlines))
 806         :style toggle :selected next-line-add-newlines])
 807       ("%_Keyboard and Mouse"
 808        ["%_Delete Key Deletes Selection"
 809         (customize-set-variable 'pending-delete-mode (not pending-delete-mode))
 810         :style toggle
 811         :selected (and (boundp 'pending-delete-mode) pending-delete-mode)
 812         :active (boundp 'pending-delete-mode)]
 813        ["`%_kill-line' Kills Whole Line at %_Beg"
 814          (customize-set-variable 'kill-whole-line (not kill-whole-line))
 815          :style toggle
 816          :selected kill-whole-line]
 817        ["Size for %_Block-Movement Commands..."
 818         (customize-set-variable 'block-movement-size
 819                                 (read-number "Block Movement Size: "
 820                                               t block-movement-size))]
 821        ["%_VI Emulation"
 822         (progn
 823           (toggle-viper-mode)
 824           (customize-set-variable 'viper-mode viper-mode))
 825         :style toggle :selected (and (boundp 'viper-mode) viper-mode)
 826         :active (fboundp 'toggle-viper-mode)]
 827        "----"
 828        ["S%_hifted Motion Keys Select Region"
 829          (customize-set-variable 'shifted-motion-keys-select-region
 830                                  (not shifted-motion-keys-select-region))
 831          :style toggle
 832          :selected shifted-motion-keys-select-region]
 833        ["%_After Shifted Motion, Unshifted Motion Keys Deselect"
 834          (customize-set-variable 'unshifted-motion-keys-deselect-region
 835                                  (not unshifted-motion-keys-deselect-region))
 836          :style toggle
 837          :selected unshifted-motion-keys-deselect-region]
 838        "----"
 839        ["%_Set Key..." global-set-key]
 840        ["%_Unset Key..." global-unset-key]
 841        "---"
 842        ["%_Mouse Paste at Text Cursor (not Clicked Location)"
 843         (customize-set-variable 'mouse-yank-at-point (not mouse-yank-at-point))
 844         :style toggle :selected mouse-yank-at-point]
 845        "---"
 846        ["%_Teach Extended Commands"
 847         (customize-set-variable 'teach-extended-commands-p
 848                                 (not teach-extended-commands-p))
 849         :style toggle :selected teach-extended-commands-p]
 850        )
 851       ("%_Printing"
 852        ["Set Printer %_Name for Generic Print Support..."
 853         (customize-set-variable
 854          'printer-name
 855          (read-string "Set printer name: " printer-name))]
 856        "---"
 857        ["Command-Line %_Switches for `lpr'/`lp'..."
 858         ;; better to directly open a customization buffer, since the value
 859         ;; must be a list of strings, which is somewhat complex to prompt for.
 860         (customize-variable 'lpr-switches)
 861         (boundp 'lpr-switches)]
 862        ("%_Pretty-Print Paper Size"
 863         ["%_Letter"
 864          (customize-set-variable 'ps-paper-type 'letter)
 865          :style radio
 866          :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'letter))
 867          :active (boundp 'ps-paper-type)]
 868         ["Lette%_r-Small"
 869          (customize-set-variable 'ps-paper-type 'letter-small)
 870          :style radio
 871          :selected (and (boundp 'ps-paper-type)
 872                         (eq ps-paper-type 'letter-small))
 873          :active (boundp 'ps-paper-type)]
 874         ["Le%_gal"
 875          (customize-set-variable 'ps-paper-type 'legal)
 876          :style radio
 877          :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'legal))
 878          :active (boundp 'ps-paper-type)]
 879         ["%_Statement"
 880          (customize-set-variable 'ps-paper-type 'statement)
 881          :style radio
 882          :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'statement))
 883          :active (boundp 'ps-paper-type)]
 884         ["%_Executive"
 885          (customize-set-variable 'ps-paper-type 'executive)
 886          :style radio
 887          :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'executive))
 888          :active (boundp 'ps-paper-type)]
 889         ["%_Tabloid"
 890          (customize-set-variable 'ps-paper-type 'tabloid)
 891          :style radio
 892          :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'tabloid))
 893          :active (boundp 'ps-paper-type)]
 894         ["Le%_dger"
 895          (customize-set-variable 'ps-paper-type 'ledger)
 896          :style radio
 897          :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'ledger))
 898          :active (boundp 'ps-paper-type)]
 899         ["A%_3"
 900          (customize-set-variable 'ps-paper-type 'a3)
 901          :style radio
 902          :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'a3))
 903          :active (boundp 'ps-paper-type)]
 904         ["%_A4"
 905          (customize-set-variable 'ps-paper-type 'a4)
 906          :style radio
 907          :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'a4))
 908          :active (boundp 'ps-paper-type)]
 909         ["A4s%_mall"
 910          (customize-set-variable 'ps-paper-type 'a4small)
 911          :style radio
 912          :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'a4small))
 913          :active (boundp 'ps-paper-type)]
 914         ["B%_4"
 915          (customize-set-variable 'ps-paper-type 'b4)
 916          :style radio
 917          :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'b4))
 918          :active (boundp 'ps-paper-type)]
 919         ["%_B5"
 920          (customize-set-variable 'ps-paper-type 'b5)
 921          :style radio
 922          :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'b5))
 923          :active (boundp 'ps-paper-type)]
 924         )
 925        ["%_Color Printing"
 926         (cond (ps-print-color-p
 927                (customize-set-variable 'ps-print-color-p nil)
 928                ;; I'm wondering whether all this muck is useful.
 929                (and (boundp 'original-face-background)
 930                     original-face-background
 931                     (set-face-background 'default original-face-background)))
 932               (t
 933                (customize-set-variable 'ps-print-color-p t)
 934                (setq original-face-background
 935                      (face-background-instance 'default))
 936                (set-face-background 'default "white")))
 937         :style toggle
 938         :selected (and (boundp 'ps-print-color-p) ps-print-color-p)
 939         :active (boundp 'ps-print-color-p)])
 940       ("%_Internet"
 941        ("%_Compose Mail With"
 942         ["Default Emacs Mailer"
 943          (customize-set-variable 'mail-user-agent 'sendmail-user-agent)
 944          :style radio
 945          :selected (eq mail-user-agent 'sendmail-user-agent)]
 946         ["MH"
 947          (customize-set-variable 'mail-user-agent 'mh-e-user-agent)
 948          :style radio
 949          :selected (eq mail-user-agent 'mh-e-user-agent)
 950          :active (get 'mh-e-user-agent 'composefunc)]
 951         ["GNUS"
 952          (customize-set-variable 'mail-user-agent 'message-user-agent)
 953          :style radio
 954          :selected (eq mail-user-agent 'message-user-agent)
 955          :active (get 'message-user-agent 'composefunc)]
 956         )
 957        ["Set My %_Email Address..."
 958         (customize-set-variable
 959          'user-mail-address
 960          (read-string "Set email address: " user-mail-address))]
 961        ["Set %_Machine Email Name..."
 962         (customize-set-variable
 963          'mail-host-address
 964          (read-string "Set machine email name: " mail-host-address))]
 965        ["Set %_SMTP Server..."
 966         (progn
 967           (require 'smtpmail)
 968           (customize-set-variable
 969            'smtpmail-smtp-server
 970            (read-string "Set SMTP server: " smtpmail-smtp-server)))
 971         :active (and (boundp 'send-mail-function)
 972                      (eq send-mail-function 'smtpmail-send-it))]
 973        ["SMTP %_Debug Info"
 974         (progn
 975           (require 'smtpmail)
 976           (customize-set-variable 'smtpmail-debug-info
 977                                   (not smtpmail-debug-info)))
 978         :style toggle
 979         :selected (and (boundp 'smtpmail-debug-info) smtpmail-debug-info)
 980         :active (and (boundp 'send-mail-function)
 981                      (eq send-mail-function 'smtpmail-send-it))]
 982        "---"
 983        ("%_Open URLs With"
 984         ["%_Emacs-W3"
 985          (customize-set-variable 'browse-url-browser-function 'browse-url-w3)
 986          :style radio
 987          :selected (and (boundp 'browse-url-browser-function)
 988                         (eq browse-url-browser-function 'browse-url-w3))
 989          :active (and (boundp 'browse-url-browser-function)
 990                       (fboundp 'browse-url-w3)
 991                       (fboundp 'w3-fetch))]
 992         ["Emacs-%_W3 (gnudoit)"
 993          (customize-set-variable 'browse-url-browser-function 'browse-url-w3-gnudoit)
 994          :style radio
 995          :selected (and (boundp 'browse-url-browser-function)
 996                         (eq browse-url-browser-function
 997                             'browse-url-w3-gnudoit))
 998          :active (and (boundp 'browse-url-browser-function)
 999                       (fboundp 'browse-url-w3-gnudoit))]
1000         ["%_Netscape"
1001          (customize-set-variable 'browse-url-browser-function
1002                                  'browse-url-netscape)
1003          :style radio
1004          :selected (and (boundp 'browse-url-browser-function)
1005                         (eq browse-url-browser-function 'browse-url-netscape))
1006          :active (and (boundp 'browse-url-browser-function)
1007                       (fboundp 'browse-url-netscape))]
1008         ["%_Mosaic"
1009          (customize-set-variable 'browse-url-browser-function
1010                                  'browse-url-mosaic)
1011          :style radio
1012          :selected (and (boundp 'browse-url-browser-function)
1013                         (eq browse-url-browser-function 'browse-url-mosaic))
1014          :active (and (boundp 'browse-url-browser-function)
1015                       (fboundp 'browse-url-mosaic))]
1016         ["Mosaic (%_CCI)"
1017          (customize-set-variable 'browse-url-browser-function 'browse-url-cci)
1018          :style radio
1019          :selected (and (boundp 'browse-url-browser-function)
1020                         (eq browse-url-browser-function 'browse-url-cci))
1021          :active (and (boundp 'browse-url-browser-function)
1022                       (fboundp 'browse-url-cci))]
1023         ["%_IXI Mosaic"
1024          (customize-set-variable 'browse-url-browser-function
1025                                  'browse-url-iximosaic)
1026          :style radio
1027          :selected (and (boundp 'browse-url-browser-function)
1028                         (eq browse-url-browser-function 'browse-url-iximosaic))
1029          :active (and (boundp 'browse-url-browser-function)
1030                       (fboundp 'browse-url-iximosaic))]
1031         ["%_Lynx (xterm)"
1032          (customize-set-variable 'browse-url-browser-function
1033                                  'browse-url-lynx-xterm)
1034          :style radio
1035          :selected (and (boundp 'browse-url-browser-function)
1036                         (eq browse-url-browser-function 'browse-url-lynx-xterm))
1037          :active (and (boundp 'browse-url-browser-function)
1038                       (fboundp 'browse-url-lynx-xterm))]
1039         ["L%_ynx (xemacs)"
1040          (customize-set-variable 'browse-url-browser-function
1041                                  'browse-url-lynx-emacs)
1042          :style radio
1043          :selected (and (boundp 'browse-url-browser-function)
1044                         (eq browse-url-browser-function 'browse-url-lynx-emacs))
1045          :active (and (boundp 'browse-url-browser-function)
1046                       (fboundp 'browse-url-lynx-emacs))]
1047         ["%_Grail"
1048          (customize-set-variable 'browse-url-browser-function
1049                                  'browse-url-grail)
1050          :style radio
1051          :selected (and (boundp 'browse-url-browser-function)
1052                         (eq browse-url-browser-function 'browse-url-grail))
1053          :active (and (boundp 'browse-url-browser-function)
1054                       (fboundp 'browse-url-grail))]
1055         ["%_KDE"
1056          (customize-set-variable 'browse-url-browser-function
1057                                  'browse-url-kde)
1058          :style radio
1059          :selected (and (boundp 'browse-url-browser-function)
1060                         (eq browse-url-browser-function 'browse-url-kde))
1061          :active (and (boundp 'browse-url-browser-function)
1062                       (fboundp 'browse-url-kde))]
1063         ["Mo%_zilla"
1064          (customize-set-variable 'browse-url-browser-function
1065                                  'browse-url-mozilla)
1066          :style radio
1067          :selected (and (boundp 'browse-url-browser-function)
1068                         (eq browse-url-browser-function 'browse-url-mozilla))
1069          :active (and (boundp 'browse-url-browser-function)
1070                       (fboundp 'browse-url-mozilla))]
1071         ["G%_aleon"
1072          (customize-set-variable 'browse-url-browser-function
1073                                  'browse-url-galeon)
1074          :style radio
1075          :selected (and (boundp 'browse-url-browser-function)
1076                         (eq browse-url-browser-function 'browse-url-galeon))
1077          :active (and (boundp 'browse-url-browser-function)
1078                       (fboundp 'browse-url-galeon))]
1079         ["%_Opera"
1080          (customize-set-variable 'browse-url-browser-function
1081                                  'browse-url-opera)
1082          :style radio
1083          :selected (and (boundp 'browse-url-browser-function)
1084                         (eq browse-url-browser-function 'browse-url-opera))
1085          :active (and (boundp 'browse-url-browser-function)
1086                       (fboundp 'browse-url-opera))]
1087         ["%_MMM"
1088          (customize-set-variable 'browse-url-browser-function
1089                                  'browse-url-mmm)
1090          :style radio
1091          :selected (and (boundp 'browse-url-browser-function)
1092                         (eq browse-url-browser-function 'browse-url-mmm))
1093          :active (and (boundp 'browse-url-browser-function)
1094                       (fboundp 'browse-url-mmm))]
1095         ["MS-Windows Default %_Browser"
1096          (customize-set-variable 'browse-url-browser-function
1097                                  'browse-url-default-windows-browser)
1098          :style radio
1099          :selected (and (boundp 'browse-url-browser-function)
1100                         (eq browse-url-browser-function
1101                             'browse-url-default-windows-browser))
1102          :active (and (boundp 'browse-url-browser-function)
1103                       (fboundp 'mswindows-shell-execute)
1104                       (fboundp 'browse-url-default-windows-browser))]
1105         ["G%_eneric Browser"
1106          (customize-set-variable 'browse-url-browser-function
1107                                  'browse-url-generic)
1108          :style radio
1109          :selected (and (boundp 'browse-url-browser-function)
1110                         (eq browse-url-browser-function 'browse-url-generic))
1111          :active (and (boundp 'browse-url-browser-function)
1112                       (boundp 'browse-url-generic-program)
1113                       browse-url-generic-program
1114                       (fboundp 'browse-url-generic))]
1115         ))
1116       ("%_Troubleshooting"
1117        ["%_Debug on Error"
1118         (customize-set-variable 'debug-on-error (not debug-on-error))
1119         :style toggle :selected debug-on-error]
1120        ["Debug on %_Quit"
1121         (customize-set-variable 'debug-on-quit (not debug-on-quit))
1122         :style toggle :selected debug-on-quit]
1123        ["Debug on S%_ignal"
1124         (customize-set-variable 'debug-on-signal (not debug-on-signal))
1125         :style toggle :selected debug-on-signal]
1126        ["%_Stack Trace on Error"
1127         (customize-set-variable 'stack-trace-on-error
1128                                 (not stack-trace-on-error))
1129         :style toggle :selected stack-trace-on-error]
1130        ["Stack Trace on Si%_gnal"
1131         (customize-set-variable 'stack-trace-on-signal
1132                                 (not stack-trace-on-signal))
1133         :style toggle :selected stack-trace-on-signal]
1134        )
1135       "-----"
1136       ("%_Display"
1137        ,@(if (featurep 'scrollbar)
1138              '(["%_Scrollbars"
1139                 (customize-set-variable 'scrollbars-visible-p
1140                                         (not scrollbars-visible-p))
1141                 :style toggle
1142                 :selected scrollbars-visible-p]))
1143        ["%_Wrap Long Lines"
1144         (progn;; becomes buffer-local
1145           (setq truncate-lines (not truncate-lines))
1146           (customize-set-variable 'truncate-lines truncate-lines))
1147         :style toggle
1148         :selected (not truncate-lines)]
1149        "----"
1150        ["%_3D Modeline"
1151         (customize-set-variable 'modeline-3d-p
1152                                 (not modeline-3d-p))
1153         :style toggle
1154         :selected modeline-3d-p]
1155        ("Modeline %_Horizontal Scrolling"
1156         ["%_None"
1157          (customize-set-variable 'modeline-scrolling-method nil)
1158          :style radio
1159          :selected (not modeline-scrolling-method)]
1160         ["As %_Text"
1161          (customize-set-variable 'modeline-scrolling-method t)
1162          :style radio
1163          :selected (eq modeline-scrolling-method t)]
1164         ["As %_Scrollbar"
1165          (customize-set-variable 'modeline-scrolling-method 'scrollbar)
1166          :style radio
1167          :selected (eq modeline-scrolling-method 'scrollbar)]
1168         )
1169        ,@(if (featurep 'toolbar)
1170              '("---"
1171                ["%_Toolbars Visible"
1172                 (customize-set-variable 'toolbar-visible-p
1173                                         (not toolbar-visible-p))
1174                 :style toggle
1175                 :selected toolbar-visible-p]
1176                ["Toolbars Ca%_ptioned"
1177                 (customize-set-variable 'toolbar-captioned-p
1178                                         (not toolbar-captioned-p))
1179                 :style toggle
1180                 :active toolbar-visible-p
1181                 :selected toolbar-captioned-p]
1182                ("Default Toolba%_r Location"
1183                 ["%_Top"
1184                  (customize-set-variable 'default-toolbar-position 'top)
1185                  :style radio
1186                  :active toolbar-visible-p
1187                  :selected (eq default-toolbar-position 'top)]
1188                 ["%_Bottom"
1189                  (customize-set-variable 'default-toolbar-position 'bottom)
1190                  :style radio
1191                  :active toolbar-visible-p
1192                  :selected (eq default-toolbar-position 'bottom)]
1193                 ["%_Left"
1194                  (customize-set-variable 'default-toolbar-position 'left)
1195                  :style radio
1196                  :active toolbar-visible-p
1197                  :selected (eq default-toolbar-position 'left)]
1198                 ["%_Right"
1199                  (customize-set-variable 'default-toolbar-position 'right)
1200                  :style radio
1201                  :active toolbar-visible-p
1202                  :selected (eq default-toolbar-position 'right)]
1203                 )
1204                ))
1205        ,@(if (featurep 'gutter)
1206              '("---"
1207                ["B%_uffers Tab Visible"
1208                 (customize-set-variable 'gutter-buffers-tab-visible-p
1209                                         (not gutter-buffers-tab-visible-p))
1210                 :style toggle
1211                 :selected gutter-buffers-tab-visible-p]
1212                ("Default %_Gutter Location"
1213                 ["%_Top"
1214                  (customize-set-variable 'default-gutter-position 'top)
1215                  :style radio
1216                  :selected (eq default-gutter-position 'top)]
1217                 ["%_Bottom"
1218                  (customize-set-variable 'default-gutter-position 'bottom)
1219                  :style radio
1220                  :selected (eq default-gutter-position 'bottom)]
1221                 ["%_Left"
1222                  (customize-set-variable 'default-gutter-position 'left)
1223                  :style radio
1224                  :selected (eq default-gutter-position 'left)]
1225                 ["%_Right"
1226                  (customize-set-variable 'default-gutter-position 'right)
1227                  :style radio
1228                  :selected (eq default-gutter-position 'right)]
1229                 )
1230                ))
1231        "-----"
1232        ["%_Blinking Cursor"
1233         (customize-set-variable 'blink-cursor-mode (not blink-cursor-mode))
1234         :style toggle
1235         :selected (and (boundp 'blink-cursor-mode) blink-cursor-mode)
1236         :active (boundp 'blink-cursor-mode)]
1237        ["Bl%_ock Cursor"
1238         (progn
1239           (customize-set-variable 'bar-cursor nil)
1240           (force-cursor-redisplay))
1241         :style radio
1242         :selected (null bar-cursor)]
1243        ["Bar Cursor (%_1 Pixel)"
1244         (progn
1245           (customize-set-variable 'bar-cursor t)
1246           (force-cursor-redisplay))
1247         :style radio
1248         :selected (eq bar-cursor t)]
1249        ["Bar Cursor (%_2 Pixels)"
1250         (progn
1251           (customize-set-variable 'bar-cursor 2)
1252           (force-cursor-redisplay))
1253         :style radio
1254         :selected (and bar-cursor (not (eq bar-cursor t)))]
1255        "----"
1256        ("Pa%_ren Highlighting"
1257        ["%_None"
1258         (customize-set-variable 'paren-mode nil)
1259         :style radio
1260         :selected (and (boundp 'paren-mode) (not paren-mode))
1261         :active (boundp 'paren-mode)]
1262        ["%_Blinking Paren"
1263         (customize-set-variable 'paren-mode 'blink-paren)
1264         :style radio
1265         :selected (and (boundp 'paren-mode) (eq paren-mode 'blink-paren))
1266         :active (boundp 'paren-mode)]
1267        ["%_Steady Paren"
1268         (customize-set-variable 'paren-mode 'paren)
1269         :style radio
1270         :selected (and (boundp 'paren-mode) (eq paren-mode 'paren))
1271         :active (boundp 'paren-mode)]
1272        ["%_Expression"
1273         (customize-set-variable 'paren-mode 'sexp)
1274         :style radio
1275         :selected (and (boundp 'paren-mode) (eq paren-mode 'sexp))
1276         :active (boundp 'paren-mode)]
1277        ;;        ["Nes%_ted Shading"
1278        ;;         (customize-set-variable 'paren-mode 'nested)
1279        ;;         :style radio
1280        ;;         :selected (and (boundp 'paren-mode) (eq paren-mode 'nested))
1281        ;;         :active (boundp 'paren-mode)]
1282        )
1283        "------"
1284        ["%_Line Numbers"
1285         (progn
1286           (customize-set-variable 'line-number-mode (not line-number-mode))
1287           (redraw-modeline))
1288         :style toggle :selected line-number-mode]
1289        ["%_Column Numbers"
1290         (progn
1291           (customize-set-variable 'column-number-mode
1292                                   (not column-number-mode))
1293           (redraw-modeline))
1294         :style toggle :selected column-number-mode]
1295
1296        ("\"Other %_Window\" Location"
1297         ["%_Always in Same Frame"
1298          (customize-set-variable
1299           'get-frame-for-buffer-default-instance-limit nil)
1300          :style radio
1301          :selected (null get-frame-for-buffer-default-instance-limit)]
1302         ["Other Frame (%_2 Frames Max)"
1303          (customize-set-variable 'get-frame-for-buffer-default-instance-limit
1304                                  2)
1305          :style radio
1306          :selected (eq 2 get-frame-for-buffer-default-instance-limit)]
1307         ["Other Frame (%_3 Frames Max)"
1308          (customize-set-variable 'get-frame-for-buffer-default-instance-limit
1309                                  3)
1310          :style radio
1311          :selected (eq 3 get-frame-for-buffer-default-instance-limit)]
1312         ["Other Frame (%_4 Frames Max)"
1313          (customize-set-variable 'get-frame-for-buffer-default-instance-limit
1314                                  4)
1315          :style radio
1316          :selected (eq 4 get-frame-for-buffer-default-instance-limit)]
1317         ["Other Frame (%_5 Frames Max)"
1318          (customize-set-variable 'get-frame-for-buffer-default-instance-limit
1319                                  5)
1320          :style radio
1321          :selected (eq 5 get-frame-for-buffer-default-instance-limit)]
1322         ["Always Create %_New Frame"
1323          (customize-set-variable 'get-frame-for-buffer-default-instance-limit
1324                                  0)
1325          :style radio
1326          :selected (eq 0 get-frame-for-buffer-default-instance-limit)]
1327         "-----"
1328         ["%_Temp Buffers Always in Same Frame"
1329          (customize-set-variable 'temp-buffer-show-function
1330                                  'show-temp-buffer-in-current-frame)
1331          :style radio
1332          :selected (eq temp-buffer-show-function
1333                        'show-temp-buffer-in-current-frame)]
1334         ["Temp Buffers %_Like Other Buffers"
1335          (customize-set-variable 'temp-buffer-show-function nil)
1336          :style radio
1337          :selected (null temp-buffer-show-function)]
1338         "-----"
1339         ["%_Make Current Frame Gnuserv Target"
1340          (customize-set-variable 'gnuserv-frame (if (eq gnuserv-frame t) nil
1341                                                   t))
1342          :style toggle
1343          :selected (and (boundp 'gnuserv-frame) (eq gnuserv-frame t))
1344          :active (boundp 'gnuserv-frame)]
1345         )
1346        )
1347       ("%_Menubars"
1348        ["%_Frame-Local Font Menu"
1349         (customize-set-variable 'font-menu-this-frame-only-p
1350                                 (not font-menu-this-frame-only-p))
1351         :style toggle
1352         :selected (and (boundp 'font-menu-this-frame-only-p)
1353                        font-menu-this-frame-only-p)]
1354        ["%_Alt/Meta Selects Menu Items"
1355         (if (eq menu-accelerator-enabled 'menu-force)
1356             (customize-set-variable 'menu-accelerator-enabled nil)
1357           (customize-set-variable 'menu-accelerator-enabled 'menu-force))
1358         :style toggle
1359         :selected (eq menu-accelerator-enabled 'menu-force)]
1360        "----"
1361        ["Buffers Menu %_Length..."
1362         (customize-set-variable
1363          'buffers-menu-max-size
1364          ;; would it be better to open a customization buffer ?
1365          (let ((val
1366                 (read-number
1367                  "Enter number of buffers to display (or 0 for unlimited): ")))
1368            (if (eq val 0) nil val)))]
1369        ["%_Multi-Operation Buffers Sub-Menus"
1370         (customize-set-variable 'complex-buffers-menu-p
1371                                 (not complex-buffers-menu-p))
1372         :style toggle
1373         :selected complex-buffers-menu-p]
1374        ["S%_ubmenus for Buffer Groups"
1375         (customize-set-variable 'buffers-menu-submenus-for-groups-p
1376                                 (not buffers-menu-submenus-for-groups-p))
1377         :style toggle
1378         :selected buffers-menu-submenus-for-groups-p]
1379        ["%_Verbose Buffer Menu Entries"
1380         (if (eq buffers-menu-format-buffer-line-function
1381                 'slow-format-buffers-menu-line)
1382             (customize-set-variable 'buffers-menu-format-buffer-line-function
1383                                     'format-buffers-menu-line)
1384           (customize-set-variable 'buffers-menu-format-buffer-line-function
1385                                   'slow-format-buffers-menu-line))
1386         :style toggle
1387         :selected (eq buffers-menu-format-buffer-line-function
1388                       'slow-format-buffers-menu-line)]
1389        ("Buffers Menu %_Sorting"
1390         ["%_Most Recently Used"
1391          (progn
1392            (customize-set-variable 'buffers-menu-sort-function nil)
1393            (customize-set-variable 'buffers-menu-grouping-function nil))
1394          :style radio
1395          :selected (null buffers-menu-sort-function)]
1396         ["%_Alphabetically"
1397          (progn
1398            (customize-set-variable 'buffers-menu-sort-function
1399                                    'sort-buffers-menu-alphabetically)
1400            (customize-set-variable 'buffers-menu-grouping-function nil))
1401          :style radio
1402          :selected (eq 'sort-buffers-menu-alphabetically
1403                        buffers-menu-sort-function)]
1404         ["%_By Major Mode, Then Alphabetically"
1405          (progn
1406            (customize-set-variable
1407             'buffers-menu-sort-function
1408             'sort-buffers-menu-by-mode-then-alphabetically)
1409            (customize-set-variable
1410             'buffers-menu-grouping-function
1411             'group-buffers-menu-by-mode-then-alphabetically))
1412          :style radio
1413          :selected (eq 'sort-buffers-menu-by-mode-then-alphabetically
1414                        buffers-menu-sort-function)])
1415        "---"
1416        ["%_Ignore Scaled Fonts"
1417         (customize-set-variable 'font-menu-ignore-scaled-fonts
1418                                 (not font-menu-ignore-scaled-fonts))
1419         :style toggle
1420         :selected (and (boundp 'font-menu-ignore-scaled-fonts)
1421                        font-menu-ignore-scaled-fonts)]
1422        )
1423       ("S%_yntax Highlighting"
1424        ["%_In This Buffer"
1425         (progn;; becomes buffer local
1426           (font-lock-mode)
1427           (customize-set-variable 'font-lock-mode font-lock-mode))
1428         :style toggle
1429         :selected (and (boundp 'font-lock-mode) font-lock-mode)
1430         :active (boundp 'font-lock-mode)]
1431        ["%_Automatic"
1432         (customize-set-variable 'font-lock-auto-fontify
1433                                 (not font-lock-auto-fontify))
1434         :style toggle
1435         :selected (and (boundp 'font-lock-auto-fontify) font-lock-auto-fontify)
1436         :active (fboundp 'font-lock-mode)]
1437        "-----"
1438        ["Force %_Rehighlight in this Buffer"
1439         (customize-set-variable 'font-lock-auto-fontify
1440                                 (not font-lock-auto-fontify))
1441         :style toggle
1442         :selected (and (boundp 'font-lock-auto-fontify) font-lock-auto-fontify)
1443         :active (fboundp 'font-lock-mode)]
1444        "-----"
1445        ["%_Fonts"
1446         (progn
1447           (require 'font-lock)
1448           (font-lock-use-default-fonts)
1449           (customize-set-variable 'font-lock-use-fonts t)
1450           (customize-set-variable 'font-lock-use-colors nil)
1451           (font-lock-mode 1))
1452         :style radio
1453         :selected (and (boundp 'font-lock-use-fonts) font-lock-use-fonts)
1454         :active (fboundp 'font-lock-mode)]
1455        ["%_Colors"
1456         (progn
1457           (require 'font-lock)
1458           (font-lock-use-default-colors)
1459           (customize-set-variable 'font-lock-use-colors t)
1460           (customize-set-variable 'font-lock-use-fonts nil)
1461           (font-lock-mode 1))
1462         :style radio
1463         :selected (and (boundp 'font-lock-use-colors) font-lock-use-colors)
1464         :active (boundp 'font-lock-mode)]
1465        "-----"
1466        ["%_1 Least"
1467         (progn
1468           (require 'font-lock)
1469           (if (or (and (not (integerp font-lock-maximum-decoration))
1470                        (not (eq t font-lock-maximum-decoration)))
1471                   (and (integerp font-lock-maximum-decoration)
1472                        (<= font-lock-maximum-decoration 0)))
1473               nil
1474             (customize-set-variable 'font-lock-maximum-decoration nil)
1475             (font-lock-recompute-variables)))
1476         :style radio
1477         :active (fboundp 'font-lock-mode)
1478         :selected (and (boundp 'font-lock-maximum-decoration)
1479                        (or (and (not (integerp font-lock-maximum-decoration))
1480                                 (not (eq t font-lock-maximum-decoration)))
1481                            (and (integerp font-lock-maximum-decoration)
1482                                 (<= font-lock-maximum-decoration 0))))]
1483        ["%_2 More"
1484         (progn
1485           (require 'font-lock)
1486           (if (and (integerp font-lock-maximum-decoration)
1487                    (= 1 font-lock-maximum-decoration))
1488               nil
1489             (customize-set-variable 'font-lock-maximum-decoration 1)
1490             (font-lock-recompute-variables)))
1491         :style radio
1492         :active (fboundp 'font-lock-mode)
1493         :selected (and (boundp 'font-lock-maximum-decoration)
1494                        (integerp font-lock-maximum-decoration)
1495                        (= 1 font-lock-maximum-decoration))]
1496        ["%_3 Even More"
1497         (progn
1498           (require 'font-lock)
1499           (if (and (integerp font-lock-maximum-decoration)
1500                    (= 2 font-lock-maximum-decoration))
1501               nil
1502             (customize-set-variable 'font-lock-maximum-decoration 2)
1503             (font-lock-recompute-variables)))
1504         :style radio
1505         :active (fboundp 'font-lock-mode)
1506         :selected (and (boundp 'font-lock-maximum-decoration)
1507                        (integerp font-lock-maximum-decoration)
1508                        (= 2 font-lock-maximum-decoration))]
1509        ["%_4 Most"
1510         (progn
1511           (require 'font-lock)
1512           (if (or (eq font-lock-maximum-decoration t)
1513                   (and (integerp font-lock-maximum-decoration)
1514                        (>= font-lock-maximum-decoration 3)))
1515               nil
1516             (customize-set-variable 'font-lock-maximum-decoration t)
1517             (font-lock-recompute-variables)))
1518         :style radio
1519         :active (fboundp 'font-lock-mode)
1520         :selected (and (boundp 'font-lock-maximum-decoration)
1521                        (or (eq font-lock-maximum-decoration t)
1522                            (and (integerp font-lock-maximum-decoration)
1523                                 (>= font-lock-maximum-decoration 3))))]
1524        "-----"
1525        ["Lazy %_Lock"
1526         (progn;; becomes buffer local
1527           (lazy-lock-mode)
1528           (customize-set-variable 'lazy-lock-mode lazy-lock-mode)
1529           ;; this shouldn't be necessary so there has to
1530           ;; be a redisplay bug lurking somewhere (or
1531           ;; possibly another event handler bug)
1532           (redraw-modeline))
1533         :active (and (boundp 'font-lock-mode) (boundp 'lazy-lock-mode)
1534                      font-lock-mode)
1535         :style toggle
1536         :selected (and (boundp 'lazy-lock-mode) lazy-lock-mode)]
1537        ["Lazy %_Shot"
1538         (progn;; becomes buffer local
1539           (lazy-shot-mode)
1540           (customize-set-variable 'lazy-shot-mode lazy-shot-mode)
1541           ;; this shouldn't be necessary so there has to
1542           ;; be a redisplay bug lurking somewhere (or
1543           ;; possibly another event handler bug)
1544           (redraw-modeline))
1545         :active (and (boundp 'font-lock-mode) (boundp 'lazy-shot-mode)
1546                      font-lock-mode)
1547         :style toggle
1548         :selected (and (boundp 'lazy-shot-mode) lazy-shot-mode)]
1549        ["Cac%_hing"
1550         (progn;; becomes buffer local
1551           (fast-lock-mode)
1552           (customize-set-variable 'fast-lock-mode fast-lock-mode)
1553           ;; this shouldn't be necessary so there has to
1554           ;; be a redisplay bug lurking somewhere (or
1555           ;; possibly another event handler bug)
1556           (redraw-modeline))
1557         :active (and (boundp 'font-lock-mode) (boundp 'fast-lock-mode)
1558                      font-lock-mode)
1559         :style toggle
1560         :selected (and (boundp 'fast-lock-mode) fast-lock-mode)]
1561        )
1562       ("%_Font" :filter font-menu-family-constructor)
1563       ("Font Si%_ze" :filter font-menu-size-constructor)
1564       ;;      ("Font Weig%_ht" :filter font-menu-weight-constructor)
1565       ["Edit Fa%_ces..." (customize-face nil)]
1566       "-----"
1567       ["Edit I%_nit File"
1568        ;; #### there should be something that holds the name that the init
1569        ;; file should be created as, when it's not present.
1570        (progn (find-file (or user-init-file "~/.xemacs/init.el"))
1571               (or (eq major-mode 'emacs-lisp-mode)
1572                   (emacs-lisp-mode)))]
1573       ["%_Save Options to Custom File" customize-save-customized]
1574       )
1575
1576      ("%_Buffers"
1577       :filter buffers-menu-filter
1578       ["Go To %_Previous Buffer" switch-to-other-buffer]
1579       ["Go To %_Buffer..." switch-to-buffer]
1580       "----"
1581       ["%_List All Buffers" list-buffers]
1582       ["%_Delete Buffer" kill-this-buffer
1583        :suffix (if put-buffer-names-in-file-menu (buffer-name) "")]
1584       "----"
1585       )
1586
1587      nil        ; the partition: menus after this are flushright
1588
1589      ("%_Help"
1590       ["%_About XEmacs..." about-xemacs]
1591       "-----"
1592       ["What's %_New in XEmacs" view-emacs-news]
1593       ["%_Obtaining XEmacs" describe-distribution]
1594       "-----"
1595       ("%_Info (Online Docs)"
1596        ["%_Info Contents" info]
1597        ["Lookup %_Key Binding..." Info-goto-emacs-key-command-node]
1598        ["Lookup %_Command..." Info-goto-emacs-command-node]
1599        ["Lookup %_Function..." Info-elisp-ref]
1600        ["Lookup %_Topic..." Info-query])
1601       ("XEmacs %_FAQ"
1602        ["%_FAQ (local)" xemacs-local-faq]
1603        ["FAQ via %_WWW" xemacs-www-faq
1604         :active (fboundp 'browse-url)]
1605        ["%_Home Page" xemacs-www-page
1606         :active (fboundp 'browse-url)])
1607       ("%_Tutorials"
1608        :filter tutorials-menu-filter)
1609       ("%_Samples"
1610        ["Sample %_init.el"
1611         (find-file (locate-data-file "sample.init.el"))
1612         :active (locate-data-file "sample.init.el")]
1613        ["Sample .%_gtkrc"
1614         (find-file (locate-data-file "sample.gtkrc"))
1615         :included (featurep 'gtk)
1616         :active (locate-data-file "sample.gtkrc")]
1617        ["Sample .%_Xdefaults"
1618         (find-file (locate-data-file "sample.Xdefaults"))
1619         :included (featurep 'x)
1620         :active (locate-data-file "sample.Xdefaults")]
1621        ["Sample %_enriched"
1622         (find-file (locate-data-file "enriched.doc"))
1623         :active (locate-data-file "enriched.doc")])
1624       ("%_Commands & Keys"
1625        ["%_Mode" describe-mode]
1626        ["%_Apropos..." hyper-apropos]
1627        ["Apropos %_Docs..." apropos-documentation]
1628        "-----"
1629        ["%_Key..." describe-key]
1630        ["%_Bindings" describe-bindings]
1631        ["%_Mouse Bindings" describe-pointer]
1632        ["%_Recent Keys" view-lossage]
1633        "-----"
1634        ["%_Function..." describe-function]
1635        ["%_Variable..." describe-variable]
1636        ["%_Locate Command..." where-is])
1637       "-----"
1638       ["%_Recent Messages" view-lossage]
1639       ("%_Misc"
1640        ["%_Current Installation Info" describe-installation
1641         :active (boundp 'Installation-string)]
1642        ["%_No Warranty" describe-no-warranty]
1643        ["XEmacs %_License" describe-copying]
1644        ["Find %_Packages" finder-by-keyword]
1645        ["View %_Splash Screen" xemacs-splash-buffer]
1646        ["%_Unix Manual..." manual-entry])
1647       ["Send %_Bug Report..." report-xemacs-bug
1648        :active (fboundp 'report-xemacs-bug)])))
1649
1650 \f
1651 (defun maybe-add-init-button ()
1652   "Don't call this.
1653 Adds `Load .emacs' button to menubar when starting up with -q."
1654   (when (and (not load-user-init-file-p)
1655              (file-exists-p (expand-file-name ".emacs" "~")))
1656     (add-menu-button
1657      nil
1658      ["%_Load .emacs"
1659       (progn
1660         (mapc #'(lambda (buf)
1661                  (with-current-buffer buf
1662                    (delete-menu-item '("Load .emacs"))))
1663               (buffer-list))
1664         (load-user-init-file))
1665       ]
1666      "Help")))
1667
1668 (add-hook 'before-init-hook 'maybe-add-init-button)
1669
1670 \f
1671 ;;; The File menu
1672
1673 (defvar put-buffer-names-in-file-menu t)
1674
1675 \f
1676 ;;; The Bookmarks menu
1677
1678 (defun bookmark-menu-filter (&rest ignore)
1679   (declare (special bookmark-alist))
1680   (let ((definedp (and (boundp 'bookmark-alist)
1681                        bookmark-alist
1682                        t)))
1683     `(,(if definedp
1684            '("%_Jump to Bookmark"
1685              :filter (lambda (&rest junk)
1686                        (submenu-generate-accelerator-spec
1687                         (mapcar #'(lambda (bmk)
1688                                     `[,bmk (bookmark-jump ',bmk)])
1689                                 (bookmark-all-names)))))
1690          ["%_Jump to Bookmark" nil nil])
1691       ["Set %_Bookmark" bookmark-set
1692        :active (fboundp 'bookmark-set)]
1693       "---"
1694       ["Insert %_Contents" bookmark-menu-insert
1695        :active (fboundp 'bookmark-menu-insert)]
1696       ["Insert L%_ocation" bookmark-menu-locate
1697        :active (fboundp 'bookmark-menu-locate)]
1698       "---"
1699       ["%_Rename Bookmark" bookmark-menu-rename
1700        :active (fboundp 'bookmark-menu-rename)]
1701       ,(if definedp
1702            '("%_Delete Bookmark"
1703              :filter (lambda (&rest junk)
1704                        (submenu-generate-accelerator-spec
1705                         (mapcar #'(lambda (bmk)
1706                                     `[,bmk (bookmark-delete ',bmk)])
1707                                 (bookmark-all-names)))))
1708          ["%_Delete Bookmark" nil nil])
1709       ["%_Edit Bookmark List" bookmark-bmenu-list       ,definedp]
1710       "---"
1711       ["%_Save Bookmarks"        bookmark-save          ,definedp]
1712       ["Save Bookmarks %_As..."  bookmark-write         ,definedp]
1713       ["%_Load a Bookmark File" bookmark-load
1714        :active (fboundp 'bookmark-load)])))
1715
1716 ;;; The Buffers menu
1717
1718 (defgroup buffers-menu nil
1719   "Customization of `Buffers' menu."
1720   :group 'menu)
1721
1722 (defvar buffers-menu-omit-chars-list '(?b ?p ?l ?d))
1723
1724 (defcustom buffers-menu-max-size 25
1725   "*Maximum number of entries which may appear on the \"Buffers\" menu.
1726 If this is 10, then only the ten most-recently-selected buffers will be
1727 shown.  If this is nil, then all buffers will be shown.  Setting this to
1728 a large number or nil will slow down menu responsiveness."
1729   :type '(choice (const :tag "Show all" nil)
1730                  (integer 10))
1731   :group 'buffers-menu)
1732
1733 (defcustom complex-buffers-menu-p nil
1734   "*If non-nil, the buffers menu will contain several commands.
1735 Commands will be presented as submenus of each buffer line.  If this
1736 is false, then there will be only one command: select that buffer."
1737   :type 'boolean
1738   :group 'buffers-menu)
1739
1740 (defcustom buffers-menu-submenus-for-groups-p nil
1741   "*If non-nil, the buffers menu will contain one submenu per group of buffers.
1742 The grouping function is specified in `buffers-menu-grouping-function'.
1743 If this is an integer, do not build submenus if the number of buffers
1744 is not larger than this value."
1745   :type '(choice (const :tag "No Subgroups" nil)
1746                  (integer :tag "Max. submenus" 10)
1747                  (sexp :format "%t\n" :tag "Allow Subgroups" :value t))
1748   :group 'buffers-menu)
1749
1750 (defcustom buffers-menu-switch-to-buffer-function 'switch-to-buffer
1751   "*The function to call to select a buffer from the buffers menu.
1752 `switch-to-buffer' is a good choice, as is `pop-to-buffer'."
1753   :type '(radio (function-item switch-to-buffer)
1754                 (function-item pop-to-buffer)
1755                 (function :tag "Other"))
1756   :group 'buffers-menu)
1757
1758 (defcustom buffers-menu-omit-function 'buffers-menu-omit-invisible-buffers
1759   "*If non-nil, a function specifying the buffers to omit from the buffers menu.
1760 This is passed a buffer and should return non-nil if the buffer should be
1761 omitted.  The default value `buffers-menu-omit-invisible-buffers' omits
1762 buffers that are normally considered \"invisible\" (those whose name
1763 begins with a space)."
1764   :type '(choice (const :tag "None" nil)
1765                  function)
1766   :group 'buffers-menu)
1767
1768 (defcustom buffers-menu-format-buffer-line-function 'format-buffers-menu-line
1769   "*The function to call to return a string to represent a buffer in
1770 the buffers menu.  The function is passed a buffer and a number
1771 (starting with 1) indicating which buffer line in the menu is being
1772 processed and should return a string containing an accelerator
1773 spec. (Check out `menu-item-generate-accelerator-spec' as a convenient
1774 way of generating the accelerator specs.) The default value
1775 `format-buffers-menu-line' just returns the name of the buffer and
1776 uses the number as the accelerator.  Also check out
1777 `slow-format-buffers-menu-line' which returns a whole bunch of info
1778 about a buffer.
1779
1780 Note: Gross Compatibility Hack: Older versions of this function prototype
1781 only expected one argument, not two.  We deal gracefully with such
1782 functions by simply calling them with one argument and leaving out the
1783 line number.  However, this may go away at any time, so make sure to
1784 update all of your functions of this type."
1785   :type 'function
1786   :group 'buffers-menu)
1787
1788 (defcustom buffers-menu-sort-function
1789   'sort-buffers-menu-by-mode-then-alphabetically
1790   "*If non-nil, a function to sort the list of buffers in the buffers menu.
1791 It will be passed two arguments (two buffers to compare) and should return
1792 t if the first is \"less\" than the second.  One possible value is
1793 `sort-buffers-menu-alphabetically'; another is
1794 `sort-buffers-menu-by-mode-then-alphabetically'."
1795   :type '(choice (const :tag "None" nil)
1796                  function)
1797   :group 'buffers-menu)
1798
1799 (defcustom buffers-menu-grouping-function
1800   'group-buffers-menu-by-mode-then-alphabetically
1801   "*If non-nil, a function to group buffers in the buffers menu together.
1802 It will be passed two arguments, successive members of the sorted buffers
1803 list after being passed through `buffers-menu-sort-function'.  It should
1804 return non-nil if the second buffer begins a new group.  The return value
1805 should be the name of the old group, which may be used in hierarchical
1806 buffers menus.  The last invocation of the function contains nil as the
1807 second argument, so that the name of the last group can be determined.
1808
1809 The sensible values of this function are dependent on the value specified
1810 for `buffers-menu-sort-function'."
1811   :type '(choice (const :tag "None" nil)
1812                  function)
1813   :group 'buffers-menu)
1814
1815 (defun sort-buffers-menu-alphabetically (buf1 buf2)
1816   "For use as a value of `buffers-menu-sort-function'.
1817 Sorts the buffers in alphabetical order by name, but puts buffers beginning
1818 with a star at the end of the list."
1819   (let* ((nam1 (buffer-name buf1))
1820          (nam2 (buffer-name buf2))
1821          (inv1p (not (null (string-match "\\` " nam1))))
1822          (inv2p (not (null (string-match "\\` " nam2))))
1823          (star1p (not (null (string-match "\\`*" nam1))))
1824          (star2p (not (null (string-match "\\`*" nam2)))))
1825     (cond ((not (eq inv1p inv2p))
1826            (not inv1p))
1827           ((not (eq star1p star2p))
1828            (not star1p))
1829           (t
1830            (string-lessp nam1 nam2)))))
1831
1832 (defun sort-buffers-menu-by-mode-then-alphabetically (buf1 buf2)
1833   "For use as a value of `buffers-menu-sort-function'.
1834 Sorts first by major mode and then alphabetically by name, but puts buffers
1835 beginning with a star at the end of the list."
1836   (let* ((nam1 (buffer-name buf1))
1837          (nam2 (buffer-name buf2))
1838          (inv1p (not (null (string-match "\\` " nam1))))
1839          (inv2p (not (null (string-match "\\` " nam2))))
1840          (star1p (not (null (string-match "\\`*" nam1))))
1841          (star2p (not (null (string-match "\\`*" nam2))))
1842          (mode1 (symbol-value-in-buffer 'major-mode buf1))
1843          (mode2 (symbol-value-in-buffer 'major-mode buf2)))
1844     (cond ((not (eq inv1p inv2p))
1845            (not inv1p))
1846           ((not (eq star1p star2p))
1847            (not star1p))
1848           ((and star1p star2p (string-lessp nam1 nam2)))
1849           ((string-lessp mode1 mode2)
1850            t)
1851           ((string-lessp mode2 mode1)
1852            nil)
1853           (t
1854            (string-lessp nam1 nam2)))))
1855
1856 ;; this version is too slow on some machines.
1857 ;; (vintage 1990, that is)
1858 (defun slow-format-buffers-menu-line (buffer n)
1859   "For use as a value of `buffers-menu-format-buffer-line-function'.
1860 This returns a string containing a bunch of info about the buffer."
1861   (concat (menu-item-generate-accelerator-spec n buffers-menu-omit-chars-list)
1862           (format "%s%s %-19s %6s %-15s %s"
1863                   (if (buffer-modified-p buffer) "*" " ")
1864                   (if (symbol-value-in-buffer 'buffer-read-only buffer)
1865                       "%" " ")
1866                   (buffer-name buffer)
1867                   (buffer-size buffer)
1868                   (symbol-value-in-buffer 'mode-name buffer)
1869                   (or (buffer-file-name buffer) ""))))
1870
1871 (defun format-buffers-menu-line (buffer n)
1872   "For use as a value of `buffers-menu-format-buffer-line-function'.
1873 This just returns the buffer's name."
1874   (concat (menu-item-generate-accelerator-spec n buffers-menu-omit-chars-list)
1875           (buffer-name buffer)))
1876
1877 (defun group-buffers-menu-by-mode-then-alphabetically (buf1 buf2)
1878   "For use as a value of `buffers-menu-grouping-function'.
1879 This groups buffers by major mode.  It only really makes sense if
1880 `buffers-menu-sorting-function' is
1881 `sort-buffers-menu-by-mode-then-alphabetically'."
1882   (cond ((string-match "\\`*" (buffer-name buf1))
1883          (and (null buf2) "*Misc*"))
1884         ((or (null buf2)
1885              (string-match "\\`*" (buffer-name buf2))
1886              (not (eq (symbol-value-in-buffer 'major-mode buf1)
1887                       (symbol-value-in-buffer 'major-mode buf2))))
1888          (symbol-value-in-buffer 'mode-name buf1))
1889         (t nil)))
1890
1891 (defun buffer-menu-save-buffer (buffer)
1892   (save-excursion
1893     (set-buffer buffer)
1894     (save-buffer)))
1895
1896 (defun buffer-menu-write-file (buffer)
1897   (save-excursion
1898     (set-buffer buffer)
1899     (write-file (read-file-name
1900                  (format "Write %s to file: "
1901                          (buffer-name (current-buffer)))))))
1902
1903 (defsubst build-buffers-menu-internal (buffers)
1904   (let (name line (n 0))
1905     (mapcar
1906      #'(lambda (buffer)
1907          (if (eq buffer t)
1908              "---"
1909            (setq n (1+ n))
1910            (setq line
1911                  ; #### a truly Kyle-friendly hack.
1912                  (let ((fn buffers-menu-format-buffer-line-function))
1913                    (if (= (function-max-args fn) 1)
1914                        (funcall fn buffer)
1915                      (funcall fn buffer n))))
1916            (if complex-buffers-menu-p
1917                (delq nil
1918                      (list line
1919                            (vector "S%_witch to Buffer"
1920                                    (list buffers-menu-switch-to-buffer-function
1921                                          (setq name (buffer-name buffer)))
1922                                    t)
1923                            (if (eq buffers-menu-switch-to-buffer-function
1924                                    'switch-to-buffer)
1925                                (vector "Switch to Buffer, Other %_Frame"
1926                                        (list 'switch-to-buffer-other-frame
1927                                              (setq name (buffer-name buffer)))
1928                                        t)
1929                              nil)
1930                            (if (and (buffer-modified-p buffer)
1931                                     (buffer-file-name buffer))
1932                                (vector "%_Save Buffer"
1933                                        (list 'buffer-menu-save-buffer name) t)
1934                              ["%_Save Buffer" nil nil]
1935                              )
1936                            (vector "Save %_As..."
1937                                    (list 'buffer-menu-write-file name) t)
1938                            (vector "%_Delete Buffer" (list 'kill-buffer name)
1939                                    t)))
1940              ;; #### We don't want buffer names to be translated,
1941              ;; #### so we put the buffer name in the suffix.
1942              ;; #### Also, avoid losing with non-ASCII buffer names.
1943              ;; #### We still lose, however, if complex-buffers-menu-p. --mrb
1944              (vector ""
1945                      (list buffers-menu-switch-to-buffer-function
1946                            (buffer-name buffer))
1947                      t line))))
1948      buffers)))
1949
1950 (defun buffers-menu-filter (menu)
1951   "This is the menu filter for the top-level buffers \"Buffers\" menu.
1952 It dynamically creates a list of buffers to use as the contents of the menu.
1953 Only the most-recently-used few buffers will be listed on the menu, for
1954 efficiency reasons.  You can control how many buffers will be shown by
1955 setting `buffers-menu-max-size'.  You can control the text of the menu
1956 items by redefining the function `format-buffers-menu-line'."
1957   (let ((buffers (delete-if buffers-menu-omit-function (buffer-list))))
1958     (and (integerp buffers-menu-max-size)
1959          (> buffers-menu-max-size 1)
1960          (> (length buffers) buffers-menu-max-size)
1961          ;; shorten list of buffers (not with submenus!)
1962          (not (and buffers-menu-grouping-function
1963                    buffers-menu-submenus-for-groups-p))
1964          (setcdr (nthcdr buffers-menu-max-size buffers) nil))
1965     (if buffers-menu-sort-function
1966         (setq buffers (sort buffers buffers-menu-sort-function)))
1967     (if (and buffers-menu-grouping-function
1968              buffers-menu-submenus-for-groups-p
1969              (or (not (integerp buffers-menu-submenus-for-groups-p))
1970                  (> (length buffers) buffers-menu-submenus-for-groups-p)))
1971         (let (groups groupnames current-group)
1972           (mapl
1973            #'(lambda (sublist)
1974                (let ((groupname (funcall buffers-menu-grouping-function
1975                                          (car sublist) (cadr sublist))))
1976                  (setq current-group (cons (car sublist) current-group))
1977                  (if groupname
1978                      (progn
1979                        (setq groups (cons (nreverse current-group)
1980                                           groups))
1981                        (setq groupnames (cons groupname groupnames))
1982                        (setq current-group nil)))))
1983            buffers)
1984           (setq buffers
1985                 (mapcar*
1986                  #'(lambda (groupname group)
1987                      (cons groupname (build-buffers-menu-internal group)))
1988                  (nreverse groupnames)
1989                  (nreverse groups))))
1990       (if buffers-menu-grouping-function
1991           (progn
1992             (setq buffers
1993                   (mapcon
1994                    #'(lambda (sublist)
1995                        (cond ((funcall buffers-menu-grouping-function
1996                                        (car sublist) (cadr sublist))
1997                               (list (car sublist) t))
1998                              (t (list (car sublist)))))
1999                    buffers))
2000             ;; remove a trailing separator.
2001             (and (>= (length buffers) 2)
2002                  (let ((lastcdr (nthcdr (- (length buffers) 2) buffers)))
2003                    (if (eq t (cadr lastcdr))
2004                        (setcdr lastcdr nil))))))
2005       (setq buffers (build-buffers-menu-internal buffers)))
2006     (append menu buffers)
2007     ))
2008
2009 (defun language-environment-menu-filter (menu)
2010   "This is the menu filter for the \"Language Environment\" submenu."
2011   (declare (special language-environment-list))
2012   (let ((n 0))
2013     (mapcar (lambda (env-sym)
2014               (setq n (1+ n))
2015               `[ ,(concat (menu-item-generate-accelerator-spec n)
2016                           (capitalize (symbol-name env-sym)))
2017                  (set-language-environment ',env-sym)])
2018             language-environment-list)))
2019
2020 \f
2021 ;;; The Options menu
2022
2023 ;; We'll keep those variables here for a while, in order to provide a
2024 ;; function for porting the old options file that a user may own to Custom.
2025
2026 (defvar options-save-faces nil
2027   "*Non-nil value means save-options will save information about faces.
2028 A nil value means save-options will not save face information.
2029 Set this non-nil only if you use M-x edit-faces to change face
2030 settings.  If you use M-x customize-face or the \"Browse Faces...\"
2031 menu entry, you will see a button in the Customize Face buffer that you
2032 can use to permanently save your face changes.
2033
2034 M-x edit-faces is deprecated.  Support for it and this variable will
2035 be discontinued in a future release.")
2036
2037 (defvar save-options-init-file nil
2038   "File into which to save forms to load the options file (nil for .emacs).
2039 Normally this is nil, which means save into your .emacs file (the value
2040 of `user-init-file'.")
2041
2042 (defvar save-options-file ".xemacs-options"
2043   "File to save options into.
2044 This file is loaded from your .emacs file.
2045 If this is a relative filename, it is put into the same directory as your
2046 .emacs file.")
2047
2048
2049 \f
2050 ;;; The Help menu
2051
2052 (defun tutorials-menu-filter (menu-items)
2053   (declare (special language-info-alist
2054                     current-language-environment
2055                     tutorial-supported-languages))
2056   (append
2057    (if (featurep 'mule)
2058        (if (assq 'tutorial
2059                  (assoc current-language-environment language-info-alist))
2060            `([,(concat "%_Default (" current-language-environment ")")
2061               help-with-tutorial]))
2062      '(["%_English" help-with-tutorial]))
2063    (submenu-generate-accelerator-spec
2064     (if (featurep 'mule)
2065         ;; Mule tutorials.
2066         (mapcan #'(lambda (lang)
2067                     (let ((tut (assq 'tutorial lang)))
2068                       (and tut
2069                            (not (string= (car lang) "ASCII"))
2070                            ;; skip current language, since we already
2071                            ;; included it first
2072                            (not (string= (car lang)
2073                                          current-language-environment))
2074                            `([,(car lang)
2075                               (help-with-tutorial nil ,(cdr tut))]))))
2076                 language-info-alist)
2077       ;; Non mule tutorials.
2078       (mapcar #'(lambda (lang)
2079                   `[,(car lang)
2080                     (help-with-tutorial ,(format "TUTORIAL.%s"
2081                                                  (cadr lang)))])
2082               tutorial-supported-languages)))))
2083
2084 (set-menubar default-menubar)
2085
2086 \f
2087 ;;; Popup menus.
2088
2089 (defconst default-popup-menu
2090   '("XEmacs Commands"
2091     ["%_Undo" advertised-undo
2092      :active (and (not (eq buffer-undo-list t))
2093                   (or buffer-undo-list pending-undo-list))
2094      :suffix (if (or (eq last-command 'undo)
2095                      (eq last-command 'advertised-undo))
2096                  "More" "")]
2097     ["Cu%_t" kill-primary-selection
2098      :active (selection-owner-p)]
2099     ["%_Copy" copy-primary-selection
2100      :active (selection-owner-p)]
2101     ["%_Paste" yank-clipboard-selection
2102      :active (selection-exists-p 'CLIPBOARD)]
2103     ["%_Delete" delete-primary-selection
2104      :active (selection-owner-p)]
2105     "-----"
2106     ["Select %_Block" mark-paragraph]
2107     ["Sp%_lit Window" split-window-vertically]
2108     ["U%_nsplit Window" delete-other-windows]
2109     ))
2110
2111 ;; In an effort to avoid massive menu clutter, this mostly worthless menu is
2112 ;; superseded by any local popup menu...
2113 (setq-default mode-popup-menu default-popup-menu)
2114
2115 \f
2116 ;; misc
2117
2118 (defun xemacs-splash-buffer ()
2119   "Redisplay XEmacs splash screen in a buffer."
2120   (interactive)
2121   (let ((buffer (get-buffer-create "*Splash*"))
2122         tmout)
2123     (set-buffer buffer)
2124     (setq buffer-read-only t)
2125     (erase-buffer buffer)
2126     (setq tmout (display-splash-frame))
2127     (when tmout
2128       (make-local-hook 'kill-buffer-hook)
2129       (add-hook 'kill-buffer-hook
2130                 `(lambda ()
2131                    (disable-timeout ,tmout))
2132                 nil t))
2133     (pop-to-buffer buffer)
2134     (delete-other-windows)))
2135
2136 \f
2137 ;;; backwards compatibility
2138 (provide 'x-menubar)
2139 (provide 'menubar-items)
2140
2141 ;;; menubar-items.el ends here.