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