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

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