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