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