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