cgit.sxemacs.org Git - sxemacs/blob - lisp/menubar-items.el

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