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

   1 ;;; menubar-items.el --- Menubar and popup-menu content for XEmacs.
   2
   3 ;; Copyright (C) 1991-1995, 1997-1998 Free Software Foundation, Inc.
   4 ;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
   5 ;; Copyright (C) 1995 Sun Microsystems.
   6 ;; Copyright (C) 1995, 1996 Ben Wing.
   7 ;; Copyright (C) 1997 MORIOKA Tomohiko
   8
   9 ;; Maintainer: XEmacs Development Team
  10 ;; Keywords: frames, extensions, internal, dumped
  11
  12 ;; This file is part of XEmacs.
  13
  14 ;; XEmacs is free software; you can redistribute it and/or modify it
  15 ;; under the terms of the GNU General Public License as published by
  16 ;; the Free Software Foundation; either version 2, or (at your option)
  17 ;; any later version.
  18
  19 ;; XEmacs is distributed in the hope that it will be useful, but
  20 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  22 ;; General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with Xmacs; see the file COPYING.  If not, write to the
  26 ;; Free Software Foundation, 59 Temple Place - Suite 330,
  27 ;; Boston, MA 02111-1307, USA.
  28
  29 ;;; Commentary:
  30
  31 ;; This file is dumped with XEmacs (when window system and menubar support is
  32 ;; compiled in).
  33
  34 ;;; Code:
  35
  36 ;;; Warning-free compile
  37 (eval-when-compile
  38   (defvar language-environment-list)
  39   (defvar bookmark-alist)
  40   (defvar language-info-alist)
  41   (defvar current-language-environment)
  42   (defvar tutorial-supported-languages))
  43
  44 (defconst default-menubar
  45   (purecopy-menubar
  46    ;; note backquote.
  47    `(
  48      ("File"
  49       ["Open..." find-file]
  50       ["Open in Other Window..." find-file-other-window]
  51       ["Open in New Frame..." find-file-other-frame]
  52       ["Insert File..." insert-file]
  53       ["View File..." view-file]
  54       "------"
  55       ["Save" save-buffer
  56        :active (buffer-modified-p)
  57        :suffix (if put-buffer-names-in-file-menu (buffer-name) "")]
  58       ["Save As..." write-file]
  59       ["Save Some Buffers" save-some-buffers]
  60       "-----"
  61       ["Print Buffer" lpr-buffer
  62        :active (fboundp 'lpr-buffer)
  63        :suffix (if put-buffer-names-in-file-menu (buffer-name) "")]
  64       ["Pretty-Print Buffer" ps-print-buffer-with-faces
  65        :active (fboundp 'ps-print-buffer-with-faces)
  66        :suffix (if put-buffer-names-in-file-menu (buffer-name) "")]
  67       "-----"
  68       ["New Frame" make-frame]
  69       ["Frame on Other Display..." make-frame-on-display]
  70       ["Delete Frame" delete-frame
  71        :active (not (eq (next-frame (selected-frame) 'nomini 'window-system)
  72                         (selected-frame)))]
  73       "-----"
  74       ["Split Window" split-window-vertically]
  75       ["Un-Split (Keep This)" delete-other-windows
  76        :active (not (one-window-p t))]
  77       ["Un-Split (Keep Others)" delete-window
  78        :active (not (one-window-p t))]
  79       "-----"
  80       ["Revert Buffer" revert-buffer
  81        :active (or buffer-file-name revert-buffer-function)
  82        :suffix (if put-buffer-names-in-file-menu (buffer-name) "")]
  83       ["Delete Buffer" kill-this-buffer
  84        :active t
  85        :suffix (if put-buffer-names-in-file-menu (buffer-name) "")]
  86       "-----"
  87       ["Exit XEmacs" save-buffers-kill-emacs]
  88       )
  89
  90      ("Edit"
  91       ["Undo" advertised-undo
  92        :active (and (not (eq buffer-undo-list t))
  93                     (or buffer-undo-list pending-undo-list))
  94        :suffix (if (or (eq last-command 'undo)
  95                        (eq last-command 'advertised-undo))
  96                    "More" "")]
  97       ["Redo" redo
  98        :included (fboundp 'redo)
  99        :active (not (or (eq buffer-undo-list t)
 100                         (eq last-buffer-undo-list nil)
 101                         (not (or (eq last-buffer-undo-list buffer-undo-list)
 102                                  (and (null (car-safe buffer-undo-list))
 103                                       (eq last-buffer-undo-list
 104                                           (cdr-safe buffer-undo-list)))))
 105                         (or (eq buffer-undo-list pending-undo-list)
 106                             (eq (cdr buffer-undo-list) pending-undo-list))))
 107        :suffix (if (eq last-command 'redo) "More" "")]
 108       ["Cut" kill-primary-selection
 109        :active (selection-owner-p)]
 110       ["Copy" copy-primary-selection
 111        :active (selection-owner-p)]
 112       ["Paste" yank-clipboard-selection
 113        :active (selection-exists-p 'CLIPBOARD)]
 114       ["Clear" delete-primary-selection
 115        :active (selection-owner-p)]
 116       "----"
 117       ["Search..." isearch-forward]
 118       ["Search Backward..." isearch-backward]
 119       ["Replace..." query-replace]
 120       "----"
 121       ["Search (Regexp)..." isearch-forward-regexp]
 122       ["Search Backward (Regexp)..." isearch-backward-regexp]
 123       ["Replace (Regexp)..." query-replace-regexp]
 124       "----"
 125       ["Goto Line..." goto-line]
 126       ["What Line" what-line]
 127       ("Bookmarks"
 128        :filter bookmark-menu-filter)
 129       "----"
 130       ["Start Macro Recording" start-kbd-macro
 131        :active (not defining-kbd-macro)]
 132       ["End Macro Recording" end-kbd-macro
 133        :active defining-kbd-macro]
 134       ["Execute Last Macro" call-last-kbd-macro
 135        :active last-kbd-macro]
 136       "----"
 137       ["Show Message Log" show-message-log]
 138       )
 139
 140      ,@(when (featurep 'mule)
 141          '(("Mule"
 142             ("Describe language support")
 143             ("Set language environment")
 144             "--"
 145             ["Toggle input method" toggle-input-method]
 146             ["Select input method" set-input-method]
 147             ["Describe input method" describe-input-method]
 148             "--"
 149             ["Describe current coding systems"
 150              describe-current-coding-system]
 151             ["Set coding system of buffer file"
 152              set-buffer-file-coding-system]
 153             ;; not implemented yet
 154             ["Set coding system of terminal"
 155              set-terminal-coding-system :active nil]
 156             ;; not implemented yet
 157             ["Set coding system of keyboard"
 158              set-keyboard-coding-system :active nil]
 159             ["Set coding system of process"
 160              set-buffer-process-coding-system
 161              :active (get-buffer-process (current-buffer))]
 162             "--"
 163             ["Show character table" view-charset-by-menu]
 164             ;; not implemented yet
 165             ["Show diagnosis for MULE" mule-diag :active nil]
 166             ["Show many languages" view-hello-file])))
 167
 168      ("Apps"
 169       ["Read Mail (VM)..." vm
 170        :active (fboundp 'vm)]
 171       ["Read Mail (MH)..." (mh-rmail t)
 172        :active (fboundp 'mh-rmail)]
 173       ["Send mail..." compose-mail
 174        :active (fboundp 'compose-mail)]
 175       ["Usenet News" gnus
 176        :active (fboundp 'gnus)]
 177       ["Browse the Web" w3
 178        :active (fboundp 'w3)]
 179       "----"
 180       ["Spell-Check Buffer" ispell-buffer
 181        :active (fboundp 'ispell-buffer)]
 182       ["Toggle VI emulation" toggle-viper-mode
 183        :active (fboundp 'toggle-viper-mode)]
 184       "----"
 185       ("Calendar"
 186        ["3-Month Calendar" calendar
 187         :active (fboundp 'calendar)]
 188        ["Diary" diary
 189         :active (fboundp 'diary)]
 190        ["Holidays" holidays
 191         :active (fboundp 'holidays)]
 192        ;; we're all pagans at heart ...
 193        ["Phases of the Moon" phases-of-moon
 194         :active (fboundp 'phases-of-moon)]
 195        ["Sunrise/Sunset" sunrise-sunset
 196         :active (fboundp 'sunrise-sunset)])
 197
 198       ("Games"
 199        ["Mine Game" xmine
 200         :active (fboundp 'xmine)]
 201        ["Tetris" tetris
 202         :active (fboundp 'tetris)]
 203        ["Sokoban" sokoban
 204         :active (fboundp 'sokoban)]
 205        ["Quote from Zippy" yow
 206         :active (fboundp 'yow)]
 207        ["Psychoanalyst" doctor
 208         :active (fboundp 'doctor)]
 209        ["Psychoanalyze Zippy!" psychoanalyze-pinhead
 210         :active (fboundp 'psychoanalyze-pinhead)]
 211        ["Random Flames" flame
 212         :active (fboundp 'flame)]
 213        ["Dunnet (Adventure)" dunnet
 214         :active (fboundp 'dunnet)]
 215        ["Towers of Hanoi" hanoi
 216         :active (fboundp 'hanoi)]
 217        ["Game of Life" life
 218         :active (fboundp 'life)]
 219        ["Multiplication Puzzle" mpuz
 220         :active (fboundp 'mpuz)]))
 221
 222      ("Options"
 223       ("Customize"
 224        ("Emacs" :filter (lambda (&rest junk)
 225                           (cdr (custom-menu-create 'emacs))))
 226        ["Group..." customize-group]
 227        ["Variable..." customize-variable]
 228        ["Face..." customize-face]
 229        ["Saved..." customize-saved]
 230        ["Set..." customize-customized]
 231        ["Apropos..." customize-apropos]
 232        ["Browse..." customize-browse])
 233
 234       ("Manage Packages"
 235        ("Add Download Site"
 236         :filter (lambda (&rest junk)
 237                   (package-get-download-menu)))
 238        ["Update Package Index" package-get-update-base]
 239        ["List & Install" pui-list-packages]
 240        ["Update Installed Packages" package-get-update-all]
 241        ;; hack-o-matic, we can't force a load of package-base here
 242        ;; since it triggers dialog box interactions which we can't
 243        ;; deal with while using a menu
 244        ("Using Custom"
 245         :filter (lambda (&rest junk)
 246                   (if package-get-base
 247                       (cdr (custom-menu-create 'packages))
 248                     '(["Please load Package Index" (lamda (&rest junk) ()) nil]))))
 249
 250        ["Help" (Info-goto-node "(xemacs)Packages")])
 251
 252       "---"
 253
 254       ("Editing Options"
 255        ["Overstrike"
 256         (progn
 257           (setq overwrite-mode (if overwrite-mode nil 'overwrite-mode-textual))
 258           (customize-set-variable 'overwrite-mode overwrite-mode))
 259         :style toggle :selected overwrite-mode]
 260        ["Case Sensitive Search"
 261         (customize-set-variable 'case-fold-search
 262                                 (setq case-fold-search (not case-fold-search)))
 263         :style toggle :selected (not case-fold-search)]
 264        ["Case Matching Replace"
 265         (customize-set-variable 'case-replace (not case-replace))
 266         :style toggle :selected case-replace]
 267        ["Auto Delete Selection"
 268         (customize-set-variable 'pending-delete-mode (not pending-delete-mode))
 269         :style toggle
 270         :selected (and (boundp 'pending-delete-mode) pending-delete-mode)
 271         :active (boundp 'pending-delete-mode)]
 272        ["Active Regions"
 273         (customize-set-variable 'zmacs-regions (not zmacs-regions))
 274         :style toggle :selected zmacs-regions]
 275        ["Mouse Paste At Text Cursor"
 276         (customize-set-variable 'mouse-yank-at-point (not mouse-yank-at-point))
 277         :style toggle :selected mouse-yank-at-point]
 278        ("Newline at end of file..."
 279         ["Don't require"
 280          (customize-set-variable 'require-final-newline nil)
 281          :style radio :selected (not require-final-newline)]
 282         ["Require"
 283          (customize-set-variable 'require-final-newline t)
 284          :style radio :selected (eq require-final-newline t)]
 285         ["Ask"
 286          (customize-set-variable 'require-final-newline 'ask)
 287          :style radio :selected (and require-final-newline
 288                                      (not (eq require-final-newline t)))])
 289        ["Add Newline When Moving Past End"
 290         (customize-set-variable 'next-line-add-newlines
 291                                 (not next-line-add-newlines))
 292         :style toggle :selected next-line-add-newlines]
 293        )
 294       ("General Options"
 295        ["Teach Extended Commands"
 296         (customize-set-variable 'teach-extended-commands-p
 297                                 (not teach-extended-commands-p))
 298         :style toggle :selected teach-extended-commands-p]
 299        ["Debug On Error"
 300         (customize-set-variable 'debug-on-error (not debug-on-error))
 301         :style toggle :selected debug-on-error]
 302        ["Debug On Quit"
 303         (customize-set-variable 'debug-on-quit (not debug-on-quit))
 304         :style toggle :selected debug-on-quit]
 305        )
 306       ("Printing Options"
 307        ["Command-Line Switches for `lpr'/`lp'..."
 308         ;; better to directly open a customization buffer, since the value
 309         ;; must be a list of strings, which is somewhat complex to prompt for.
 310         (customize-variable 'lpr-switches)
 311         (boundp 'lpr-switches)]
 312        ("Pretty-Print Paper Size"
 313         ["Letter"
 314          (customize-set-variable 'ps-paper-type 'letter)
 315          :style radio
 316          :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'letter))
 317          :active (boundp 'ps-paper-type)]
 318         ["Letter-small"
 319          (customize-set-variable 'ps-paper-type 'letter-small)
 320          :style radio
 321          :selected (and (boundp 'ps-paper-type)
 322                         (eq ps-paper-type 'letter-small))
 323          :active (boundp 'ps-paper-type)]
 324         ["Legal"
 325          (customize-set-variable 'ps-paper-type 'legal)
 326          :style radio
 327          :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'legal))
 328          :active (boundp 'ps-paper-type)]
 329         ["Statement"
 330          (customize-set-variable 'ps-paper-type 'statement)
 331          :style radio
 332          :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'statement))
 333          :active (boundp 'ps-paper-type)]
 334         ["Executive"
 335          (customize-set-variable 'ps-paper-type 'executive)
 336          :style radio
 337          :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'executive))
 338          :active (boundp 'ps-paper-type)]
 339         ["Tabloid"
 340          (customize-set-variable 'ps-paper-type 'tabloid)
 341          :style radio
 342          :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'tabloid))
 343          :active (boundp 'ps-paper-type)]
 344         ["Ledger"
 345          (customize-set-variable 'ps-paper-type 'ledger)
 346          :style radio
 347          :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'ledger))
 348          :active (boundp 'ps-paper-type)]
 349         ["A3"
 350          (customize-set-variable 'ps-paper-type 'a3)
 351          :style radio
 352          :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'a3))
 353          :active (boundp 'ps-paper-type)]
 354         ["A4"
 355          (customize-set-variable 'ps-paper-type 'a4)
 356          :style radio
 357          :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'a4))
 358          :active (boundp 'ps-paper-type)]
 359         ["A4small"
 360          (customize-set-variable 'ps-paper-type 'a4small)
 361          :style radio
 362          :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'a4small))
 363          :active (boundp 'ps-paper-type)]
 364         ["B4"
 365          (customize-set-variable 'ps-paper-type 'b4)
 366          :style radio
 367          :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'b4))
 368          :active (boundp 'ps-paper-type)]
 369         ["B5"
 370          (customize-set-variable 'ps-paper-type 'b5)
 371          :style radio
 372          :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'b5))
 373          :active (boundp 'ps-paper-type)]
 374         )
 375        ["Color Printing"
 376         (cond (ps-print-color-p
 377                (customize-set-variable 'ps-print-color-p nil)
 378                ;; I'm wondering whether all this muck is useful.
 379                (and (boundp 'original-face-background)
 380                     original-face-background
 381                     (set-face-background 'default original-face-background)))
 382               (t
 383                (customize-set-variable 'ps-print-color-p t)
 384                (setq original-face-background
 385                      (face-background-instance 'default))
 386                (set-face-background 'default "white")))
 387         :style toggle
 388         :selected (and (boundp 'ps-print-color-p) ps-print-color-p)
 389         :active (boundp 'ps-print-color-p)])
 390       ("\"Other Window\" Location"
 391        ["Always in Same Frame"
 392         (customize-set-variable
 393          'get-frame-for-buffer-default-instance-limit nil)
 394         :style radio
 395         :selected (null get-frame-for-buffer-default-instance-limit)]
 396        ["Other Frame (2 Frames Max)"
 397         (customize-set-variable 'get-frame-for-buffer-default-instance-limit 2)
 398         :style radio
 399         :selected (eq 2 get-frame-for-buffer-default-instance-limit)]
 400        ["Other Frame (3 Frames Max)"
 401         (customize-set-variable 'get-frame-for-buffer-default-instance-limit 3)
 402         :style radio
 403         :selected (eq 3 get-frame-for-buffer-default-instance-limit)]
 404        ["Other Frame (4 Frames Max)"
 405         (customize-set-variable 'get-frame-for-buffer-default-instance-limit 4)
 406         :style radio
 407         :selected (eq 4 get-frame-for-buffer-default-instance-limit)]
 408        ["Other Frame (5 Frames Max)"
 409         (customize-set-variable 'get-frame-for-buffer-default-instance-limit 5)
 410         :style radio
 411         :selected (eq 5 get-frame-for-buffer-default-instance-limit)]
 412        ["Always Create New Frame"
 413         (customize-set-variable 'get-frame-for-buffer-default-instance-limit 0)
 414         :style radio
 415         :selected (eq 0 get-frame-for-buffer-default-instance-limit)]
 416        "-----"
 417        ["Temp Buffers Always in Same Frame"
 418         (customize-set-variable 'temp-buffer-show-function
 419                                 'show-temp-buffer-in-current-frame)
 420         :style radio
 421         :selected (eq temp-buffer-show-function
 422                       'show-temp-buffer-in-current-frame)]
 423        ["Temp Buffers Like Other Buffers"
 424         (customize-set-variable 'temp-buffer-show-function nil)
 425         :style radio
 426         :selected (null temp-buffer-show-function)]
 427        "-----"
 428        ["Make current frame gnuserv target"
 429         (customize-set-variable 'gnuserv-frame (if (eq gnuserv-frame t) nil t))
 430         :style toggle
 431         :selected (and (boundp 'gnuserv-frame) (eq gnuserv-frame t))
 432         :active (boundp 'gnuserv-frame)]
 433        )
 434       "-----"
 435       ("Syntax Highlighting"
 436        ["In This Buffer"
 437         (progn ;; becomes buffer local
 438           (font-lock-mode)
 439           (customize-set-variable 'font-lock-mode font-lock-mode))
 440         :style toggle
 441         :selected (and (boundp 'font-lock-mode) font-lock-mode)
 442         :active (boundp 'font-lock-mode)]
 443        ["Automatic"
 444         (customize-set-variable 'font-lock-auto-fontify
 445                                 (not font-lock-auto-fontify))
 446         :style toggle
 447         :selected (and (boundp 'font-lock-auto-fontify) font-lock-auto-fontify)
 448         :active (fboundp 'font-lock-mode)]
 449        "-----"
 450        ["Fonts"
 451         (progn
 452           (require 'font-lock)
 453           (font-lock-use-default-fonts)
 454           (customize-set-variable 'font-lock-use-fonts t)
 455           (customize-set-variable 'font-lock-use-colors nil)
 456           (font-lock-mode 1))
 457         :style radio
 458         :selected (and (boundp 'font-lock-use-fonts) font-lock-use-fonts)
 459         :active (fboundp 'font-lock-mode)]
 460        ["Colors"
 461         (progn
 462           (require 'font-lock)
 463           (font-lock-use-default-colors)
 464           (customize-set-variable 'font-lock-use-colors t)
 465           (customize-set-variable 'font-lock-use-fonts nil)
 466           (font-lock-mode 1))
 467         :style radio
 468         :selected (and (boundp 'font-lock-use-colors) font-lock-use-colors)
 469         :active (boundp 'font-lock-mode)]
 470        "-----"
 471        ["Least"
 472         (progn
 473           (require 'font-lock)
 474           (if (or (and (not (integerp font-lock-maximum-decoration))
 475                        (not (eq t font-lock-maximum-decoration)))
 476                   (and (integerp font-lock-maximum-decoration)
 477                        (<= font-lock-maximum-decoration 0)))
 478               nil
 479             (customize-set-variable 'font-lock-maximum-decoration nil)
 480             (font-lock-recompute-variables)))
 481         :style radio
 482         :active (fboundp 'font-lock-mode)
 483         :selected (and (boundp 'font-lock-maximium-decoration)
 484                        (or (and (not (integerp font-lock-maximum-decoration))
 485                                 (not (eq t font-lock-maximum-decoration)))
 486                            (and (integerp font-lock-maximum-decoration)
 487                                 (<= font-lock-maximum-decoration 0))))]
 488        ["More"
 489         (progn
 490           (require 'font-lock)
 491           (if (and (integerp font-lock-maximum-decoration)
 492                    (= 1 font-lock-maximum-decoration))
 493               nil
 494             (customize-set-variable 'font-lock-maximum-decoration 1)
 495             (font-lock-recompute-variables)))
 496         :style radio
 497         :active (fboundp 'font-lock-mode)
 498         :selected (and (boundp 'font-lock-maximium-decoration)
 499                        (integerp font-lock-maximum-decoration)
 500                        (= 1 font-lock-maximum-decoration))]
 501        ["Even More"
 502         (progn
 503           (require 'font-lock)
 504           (if (and (integerp font-lock-maximum-decoration)
 505                    (= 2 font-lock-maximum-decoration))
 506               nil
 507             (customize-set-variable 'font-lock-maximum-decoration 2)
 508             (font-lock-recompute-variables)))
 509         :style radio
 510         :active (fboundp 'font-lock-mode)
 511         :selected (and (boundp 'font-lock-maximum-decoration)
 512                        (integerp font-lock-maximum-decoration)
 513                        (= 2 font-lock-maximum-decoration))]
 514        ["Most"
 515         (progn
 516           (require 'font-lock)
 517           (if (or (eq font-lock-maximum-decoration t)
 518                   (and (integerp font-lock-maximum-decoration)
 519                        (>= font-lock-maximum-decoration 3)))
 520               nil
 521             (customize-set-variable 'font-lock-maximum-decoration t)
 522             (font-lock-recompute-variables)))
 523         :style radio
 524         :active (fboundp 'font-lock-mode)
 525         :selected (and (boundp 'font-lock-maximum-decoration)
 526                        (or (eq font-lock-maximum-decoration t)
 527                            (and (integerp font-lock-maximum-decoration)
 528                                 (>= font-lock-maximum-decoration 3))))]
 529        "-----"
 530        ["Lazy"
 531         (progn ;; becomes buffer local
 532           (lazy-shot-mode)
 533           (customize-set-variable 'lazy-shot-mode lazy-shot-mode)
 534           ;; this shouldn't be necessary so there has to
 535           ;; be a redisplay bug lurking somewhere (or
 536           ;; possibly another event handler bug)
 537           (redraw-modeline))
 538         :active (and (boundp 'font-lock-mode) (boundp 'lazy-shot-mode)
 539                      font-lock-mode)
 540         :style toggle
 541         :selected (and (boundp 'lazy-shot-mode) lazy-shot-mode)]
 542        ["Caching"
 543         (progn ;; becomes buffer local
 544           (fast-lock-mode)
 545           (customize-set-variable 'fast-lock-mode fast-lock-mode)
 546           ;; this shouldn't be necessary so there has to
 547           ;; be a redisplay bug lurking somewhere (or
 548           ;; possibly another event handler bug)
 549           (redraw-modeline))
 550         :active (and (boundp 'font-lock-mode) (boundp 'fast-lock-mode)
 551                      font-lock-mode)
 552         :style toggle
 553         :selected (and (boundp 'fast-lock-mode) fast-lock-mode)]
 554        )
 555       ("Paren Highlighting"
 556        ["None"
 557         (customize-set-variable 'paren-mode nil)
 558         :style radio
 559         :selected (and (boundp 'paren-mode) (not paren-mode))
 560         :active (boundp 'paren-mode)]
 561        ["Blinking Paren"
 562         (customize-set-variable 'paren-mode 'blink-paren)
 563         :style radio
 564         :selected (and (boundp 'paren-mode) (eq paren-mode 'blink-paren))
 565         :active (boundp 'paren-mode)]
 566        ["Steady Paren"
 567         (customize-set-variable 'paren-mode 'paren)
 568         :style radio
 569         :selected (and (boundp 'paren-mode) (eq paren-mode 'paren))
 570         :active (boundp 'paren-mode)]
 571        ["Expression"
 572         (customize-set-variable 'paren-mode 'sexp)
 573         :style radio
 574         :selected (and (boundp 'paren-mode) (eq paren-mode 'sexp))
 575         :active (boundp 'paren-mode)]
 576 ;;       ["Nested Shading"
 577 ;;        (customize-set-variable 'paren-mode 'nested)
 578 ;;        :style radio
 579 ;;        :selected (and (boundp 'paren-mode) (eq paren-mode 'nested))
 580 ;;        :active (boundp 'paren-mode)]
 581        )
 582       "-----"
 583       ("Frame Appearance"
 584        ["Frame-Local Font Menu"
 585         (customize-set-variable 'font-menu-this-frame-only-p
 586                                 (not font-menu-this-frame-only-p))
 587         :style toggle
 588         :selected (and (boundp 'font-menu-this-frame-only-p)
 589                        font-menu-this-frame-only-p)]
 590        ,@(if (featurep 'scrollbar)
 591              '(["Scrollbars"
 592                 (customize-set-variable 'scrollbars-visible-p
 593                                         (not scrollbars-visible-p))
 594                 :style toggle
 595                 :selected scrollbars-visible-p]))
 596        ;; I don't think this is of any interest. - dverna apr. 98
 597        ;; #### I beg to differ!  Many FSFmacs converts hate the 3D
 598        ;; modeline, and it was perfectly fine to be able to turn them
 599        ;; off through the Options menu.  I would have uncommented this
 600        ;; source, but the code for saving options would not save the
 601        ;; modeline 3D-ness.  Grrr.  --hniksic
 602 ;;       ["3D Modeline"
 603 ;;        (progn
 604 ;;          (if (zerop (specifier-instance modeline-shadow-thickness))
 605 ;;              (set-specifier modeline-shadow-thickness 2)
 606 ;;            (set-specifier modeline-shadow-thickness 0))
 607 ;;          (redraw-modeline t))
 608 ;;        :style toggle
 609 ;;        :selected (let ((thickness
 610 ;;                         (specifier-instance modeline-shadow-thickness)))
 611 ;;                    (and (integerp thickness)
 612 ;;                         (> thickness 0)))]
 613        ["Truncate Lines"
 614         (progn ;; becomes buffer-local
 615           (setq truncate-lines (not truncate-lines))
 616           (customize-set-variable 'truncate-lines truncate-lines))
 617         :style toggle
 618         :selected truncate-lines]
 619        ["Blinking Cursor"
 620         (customize-set-variable 'blink-cursor-mode (not blink-cursor-mode))
 621         :style toggle
 622         :selected (and (boundp 'blink-cursor-mode) blink-cursor-mode)
 623         :active (boundp 'blink-cursor-mode)]
 624        "-----"
 625        ["Block cursor"
 626         (progn
 627           (customize-set-variable 'bar-cursor nil)
 628           (force-cursor-redisplay))
 629         :style radio
 630         :selected (null bar-cursor)]
 631        ["Bar cursor (1 pixel)"
 632         (progn
 633           (customize-set-variable 'bar-cursor t)
 634           (force-cursor-redisplay))
 635         :style radio
 636         :selected (eq bar-cursor t)]
 637        ["Bar cursor (2 pixels)"
 638         (progn
 639           (customize-set-variable 'bar-cursor 2)
 640           (force-cursor-redisplay))
 641         :style radio
 642         :selected (and bar-cursor (not (eq bar-cursor t)))]
 643        "------"
 644        ["Line Numbers"
 645         (progn
 646           (customize-set-variable 'line-number-mode (not line-number-mode))
 647           (redraw-modeline))
 648         :style toggle :selected line-number-mode]
 649        ["Column Numbers"
 650         (progn
 651           (customize-set-variable 'column-number-mode
 652                                   (not column-number-mode))
 653           (redraw-modeline))
 654         :style toggle :selected column-number-mode]
 655        )
 656       ("Menubar Appearance"
 657        ["Buffers Menu Length..."
 658         (customize-set-variable
 659          'buffers-menu-max-size
 660          ;; would it be better to open a customization buffer ?
 661          (let ((val
 662                 (read-number
 663                  "Enter number of buffers to display (or 0 for unlimited): ")))
 664            (if (eq val 0) nil val)))]
 665        ["Multi-Operation Buffers Sub-Menus"
 666         (customize-set-variable 'complex-buffers-menu-p
 667                                 (not complex-buffers-menu-p))
 668         :style toggle
 669         :selected complex-buffers-menu-p]
 670        ("Buffers Menu Sorting"
 671         ["Most Recently Used"
 672          (progn
 673            (customize-set-variable 'buffers-menu-sort-function nil)
 674            (customize-set-variable 'buffers-menu-grouping-function nil))
 675          :style radio
 676          :selected (null buffers-menu-sort-function)]
 677         ["Alphabetically"
 678          (progn
 679            (customize-set-variable 'buffers-menu-sort-function
 680                                    'sort-buffers-menu-alphabetically)
 681            (customize-set-variable 'buffers-menu-grouping-function nil))
 682          :style radio
 683          :selected (eq 'sort-buffers-menu-alphabetically
 684                        buffers-menu-sort-function)]
 685         ["By Major Mode, Then Alphabetically"
 686          (progn
 687            (customize-set-variable
 688             'buffers-menu-sort-function
 689             'sort-buffers-menu-by-mode-then-alphabetically)
 690            (customize-set-variable
 691             'buffers-menu-grouping-function
 692             'group-buffers-menu-by-mode-then-alphabetically))
 693          :style radio
 694          :selected (eq 'sort-buffers-menu-by-mode-then-alphabetically
 695                        buffers-menu-sort-function)])
 696        ["Submenus for Buffer Groups"
 697         (customize-set-variable 'buffers-menu-submenus-for-groups-p
 698                                 (not buffers-menu-submenus-for-groups-p))
 699         :style toggle
 700         :selected buffers-menu-submenus-for-groups-p]
 701        "---"
 702        ["Ignore Scaled Fonts"
 703         (customize-set-variable 'font-menu-ignore-scaled-fonts
 704                                 (not font-menu-ignore-scaled-fonts))
 705         :style toggle
 706         :selected (and (boundp 'font-menu-ignore-scaled-fonts)
 707                        font-menu-ignore-scaled-fonts)]
 708        )
 709       ,@(if (featurep 'toolbar)
 710             '(("Toolbar Appearance"
 711                ["Visible"
 712                 (customize-set-variable 'toolbar-visible-p
 713                                         (not toolbar-visible-p))
 714                 :style toggle
 715                 :selected toolbar-visible-p]
 716                ["Captioned"
 717                 (customize-set-variable 'toolbar-captioned-p
 718                                         (not toolbar-captioned-p))
 719                 :style toggle
 720                 :selected toolbar-captioned-p]
 721                ("Default Location"
 722                 ["Top"
 723                  (customize-set-variable 'default-toolbar-position 'top)
 724                  :style radio
 725                  :selected (eq default-toolbar-position 'top)]
 726                 ["Bottom"
 727                  (customize-set-variable 'default-toolbar-position 'bottom)
 728                  :style radio
 729                  :selected (eq default-toolbar-position 'bottom)]
 730                 ["Left"
 731                  (customize-set-variable 'default-toolbar-position 'left)
 732                  :style radio
 733                  :selected (eq default-toolbar-position 'left)]
 734                 ["Right"
 735                  (customize-set-variable 'default-toolbar-position 'right)
 736                  :style radio
 737                  :selected (eq default-toolbar-position 'right)]
 738                 )
 739                )))
 740       ,@(if (featurep 'gutter)
 741             '(("Gutter Appearance"
 742                ["Visible"
 743                 (customize-set-variable 'gutter-visible-p
 744                                         (not gutter-visible-p))
 745                 :style toggle
 746                 :selected gutter-visible-p]
 747                ("Default Location"
 748                 ["Top"
 749                  (customize-set-variable 'default-gutter-position 'top)
 750                  :style radio
 751                  :selected (eq default-gutter-position 'top)]
 752                 ["Bottom"
 753                  (customize-set-variable 'default-gutter-position 'bottom)
 754                  :style radio
 755                  :selected (eq default-gutter-position 'bottom)]
 756                 ["Left"
 757                  (customize-set-variable 'default-gutter-position 'left)
 758                  :style radio
 759                  :selected (eq default-gutter-position 'left)]
 760                 ["Right"
 761                  (customize-set-variable 'default-gutter-position 'right)
 762                  :style radio
 763                  :selected (eq default-gutter-position 'right)]
 764                 )
 765                )))
 766       ("Mouse"
 767        ["Avoid Text..."
 768         (customize-set-variable 'mouse-avoidance-mode
 769                                 (if mouse-avoidance-mode nil 'banish))
 770         :style toggle
 771         :selected (and (boundp 'mouse-avoidance-mode) mouse-avoidance-mode)
 772         :active (and (boundp 'mouse-avoidance-mode)
 773                      (device-on-window-system-p))]
 774        ["strokes-mode"
 775         (customize-set-variable 'strokes-mode (not strokes-mode))
 776         :style toggle
 777         :selected (and (boundp 'strokes-mode) strokes-mode)
 778         :active (and (boundp 'strokes-mode)
 779                      (device-on-window-system-p))]
 780        )
 781       ("Open URLs With"
 782        ["Emacs-W3"
 783         (customize-set-variable 'browse-url-browser-function 'browse-url-w3)
 784         :style radio
 785         :selected (and (boundp 'browse-url-browser-function)
 786                        (eq browse-url-browser-function 'browse-url-w3))
 787         :active (and (boundp 'browse-url-browser-function)
 788                      (fboundp 'browse-url-w3)
 789                      (fboundp 'w3-fetch))]
 790        ["Netscape"
 791         (customize-set-variable 'browse-url-browser-function
 792                                 'browse-url-netscape)
 793         :style radio
 794         :selected (and (boundp 'browse-url-browser-function)
 795                        (eq browse-url-browser-function 'browse-url-netscape))
 796         :active (and (boundp 'browse-url-browser-function)
 797                      (fboundp 'browse-url-netscape))]
 798        ["Mosaic"
 799         (customize-set-variable 'browse-url-browser-function
 800                                 'browse-url-mosaic)
 801         :style radio
 802         :selected (and (boundp 'browse-url-browser-function)
 803                        (eq browse-url-browser-function 'browse-url-mosaic))
 804         :active (and (boundp 'browse-url-browser-function)
 805                      (fboundp 'browse-url-mosaic))]
 806        ["Mosaic (CCI)"
 807         (customize-set-variable 'browse-url-browser-function 'browse-url-cci)
 808         :style radio
 809         :selected (and (boundp 'browse-url-browser-function)
 810                        (eq browse-url-browser-function 'browse-url-cci))
 811         :active (and (boundp 'browse-url-browser-function)
 812                      (fboundp 'browse-url-cci))]
 813        ["IXI Mosaic"
 814         (customize-set-variable 'browse-url-browser-function
 815                                 'browse-url-iximosaic)
 816         :style radio
 817         :selected (and (boundp 'browse-url-browser-function)
 818                        (eq browse-url-browser-function 'browse-url-iximosaic))
 819         :active (and (boundp 'browse-url-browser-function)
 820                      (fboundp 'browse-url-iximosaic))]
 821        ["Lynx (xterm)"
 822         (customize-set-variable 'browse-url-browser-function
 823                                 'browse-url-lynx-xterm)
 824         :style radio
 825         :selected (and (boundp 'browse-url-browser-function)
 826                        (eq browse-url-browser-function 'browse-url-lynx-xterm))
 827         :active (and (boundp 'browse-url-browser-function)
 828                      (fboundp 'browse-url-lynx-xterm))]
 829        ["Lynx (xemacs)"
 830         (customize-set-variable 'browse-url-browser-function
 831                                 'browse-url-lynx-emacs)
 832         :style radio
 833         :selected (and (boundp 'browse-url-browser-function)
 834                        (eq browse-url-browser-function 'browse-url-lynx-emacs))
 835         :active (and (boundp 'browse-url-browser-function)
 836                      (fboundp 'browse-url-lynx-emacs))]
 837        ["Grail"
 838         (customize-set-variable 'browse-url-browser-function
 839                                 'browse-url-grail)
 840         :style radio
 841         :selected (and (boundp 'browse-url-browser-function)
 842                        (eq browse-url-browser-function 'browse-url-grail))
 843         :active (and (boundp 'browse-url-browser-function)
 844                      (fboundp 'browse-url-grail))]
 845        ["Kfm"
 846         (customize-set-variable 'browse-url-browser-function
 847                                 'browse-url-kfm)
 848         :style radio
 849         :selected (and (boundp 'browse-url-browser-function)
 850                        (eq browse-url-browser-function 'browse-url-kfm))
 851         :active (and (boundp 'browse-url-browser-function)
 852                      (fboundp 'browse-url-kfm))]
 853        )
 854       "-----"
 855       ["Edit Faces..." (customize-face nil)]
 856       ("Font"   :filter font-menu-family-constructor)
 857       ("Size"   :filter font-menu-size-constructor)
 858 ;      ("Weight"        :filter font-menu-weight-constructor)
 859       "-----"
 860       ["Save Options" customize-save-customized]
 861       )
 862
 863      ("Buffers"
 864       :filter buffers-menu-filter
 865       ["Read Only" (toggle-read-only)
 866        :style toggle :selected buffer-read-only]
 867       ["List All Buffers" list-buffers]
 868       "--"
 869       )
 870
 871      ("Tools"
 872       ["Grep..." grep
 873        :active (fboundp 'grep)]
 874       ["Compile..." compile
 875        :active (fboundp 'compile)]
 876       ["Shell" shell
 877        :active (fboundp 'shell)]
 878       ["Shell Command..." shell-command
 879        :active (fboundp 'shell-command)]
 880       ["Shell Command on Region..." shell-command-on-region
 881        :active (and (fboundp 'shell-command-on-region) (region-exists-p))]
 882       ["Debug (GDB)..." gdb
 883        :active (fboundp 'gdb)]
 884       ["Debug (DBX)..." dbx
 885        :active (fboundp 'dbx)]
 886       "-----"
 887       ("Tags"
 888        ["Find Tag..." find-tag]
 889        ["Find Other Window..." find-tag-other-window]
 890        ["Next Tag..." (find-tag nil)]
 891        ["Next Other Window..." (find-tag-other-window nil)]
 892        ["Next File" next-file]
 893        "-----"
 894        ["Tags Search..." tags-search]
 895        ["Tags Replace..." tags-query-replace]
 896        ["Continue Search/Replace" tags-loop-continue]
 897        "-----"
 898        ["Pop stack" pop-tag-mark]
 899        ["Apropos..." tags-apropos]
 900        "-----"
 901        ["Set Tags Table File..." visit-tags-table]
 902        ))
 903
 904      nil                                ; the partition: menus after this are flushright
 905
 906      ("Help"
 907       ["About XEmacs..." about-xemacs]
 908       ("Basics"
 909        ["Installation" describe-installation
 910         :active (boundp 'Installation-string)]
 911        ;; Tutorials.
 912        ,(if (featurep 'mule)
 913             ;; Mule tutorials.
 914             (let ((lang language-info-alist)
 915                   submenu tut)
 916               (while lang
 917                 (and (setq tut (assq 'tutorial (car lang)))
 918                      (not (string= (caar lang) "ASCII"))
 919                      (setq
 920                       submenu
 921                       (cons
 922                        `[,(caar lang) (help-with-tutorial nil ,(cdr tut))]
 923                        submenu)))
 924                 (setq lang (cdr lang)))
 925               (append `("Tutorials"
 926                         :filter tutorials-menu-filter
 927                         ["Default" help-with-tutorial t
 928                          ,(concat "(" current-language-environment ")")])
 929                       submenu))
 930           ;; Non mule tutorials.
 931           (let ((lang tutorial-supported-languages)
 932                 submenu)
 933             (while lang
 934               (setq submenu
 935                     (cons
 936                      `[,(caar lang)
 937                        (help-with-tutorial ,(format "TUTORIAL.%s"
 938                                                     (cadr (car lang))))]
 939                      submenu))
 940               (setq lang (cdr lang)))
 941             (append '("Tutorials"
 942                       ["English" help-with-tutorial])
 943                     submenu)))
 944        ["News" view-emacs-news]
 945        ["Packages" finder-by-keyword]
 946        ["Splash" xemacs-splash-buffer])
 947       "-----"
 948       ("XEmacs FAQ"
 949        ["FAQ (local)" xemacs-local-faq]
 950        ["FAQ via WWW" xemacs-www-faq    (boundp 'browse-url-browser-function)]
 951        ["Home Page" xemacs-www-page             (boundp 'browse-url-browser-function)])
 952       ("Samples"
 953        ["Sample .emacs" (find-file (locate-data-file "sample.emacs")) (locate-data-file "sample.emacs")]
 954        ["Sample .Xdefaults" (find-file (locate-data-file "sample.Xdefaults")) (locate-data-file "sample.Xdefaults")]
 955        ["Sample enriched" (find-file (locate-data-file "enriched.doc")) (locate-data-file "enriched.doc")])
 956       "-----"
 957       ("Lookup in Info"
 958        ["Key Binding..." Info-goto-emacs-key-command-node]
 959        ["Command..." Info-goto-emacs-command-node]
 960        ["Function..." Info-elisp-ref]
 961        ["Topic..." Info-query])
 962       ("Manuals"
 963        ["Info" info]
 964        ["Unix Manual..." manual-entry])
 965       ("Commands & Keys"
 966        ["Mode" describe-mode]
 967        ["Apropos..." hyper-apropos]
 968        ["Apropos Docs..." apropos-documentation]
 969        "-----"
 970        ["Key..." describe-key]
 971        ["Bindings" describe-bindings]
 972        ["Mouse Bindings" describe-pointer]
 973        ["Recent Keys" view-lossage]
 974        "-----"
 975        ["Function..." describe-function]
 976        ["Variable..." describe-variable]
 977        ["Locate Command..." where-is])
 978       "-----"
 979       ["Recent Messages" view-lossage]
 980       ("Misc"
 981        ["No Warranty" describe-no-warranty]
 982        ["XEmacs License" describe-copying]
 983        ["The Latest Version" describe-distribution])
 984       ["Send Bug Report..." report-emacs-bug
 985        :active (fboundp 'report-emacs-bug)]))))
 986
 987 \f
 988 (defun maybe-add-init-button ()
 989   "Don't call this.
 990 Adds `Load .emacs' button to menubar when starting up with -q."
 991   ;; by Stig@hackvan.com
 992   (cond
 993    (load-user-init-file-p nil)
 994    ((file-exists-p (expand-file-name ".emacs" "~"))
 995     (add-menu-button nil
 996                      ["Load .emacs"
 997                       (progn (delete-menu-item '("Load .emacs"))
 998                              (load-user-init-file))
 999                       ]
1000                      "Help"))
1001    (t nil)))
1002
1003 (add-hook 'before-init-hook 'maybe-add-init-button)
1004
1005 \f
1006 ;;; The File menu
1007
1008 (defvar put-buffer-names-in-file-menu t)
1009
1010 \f
1011 ;;; The Bookmarks menu
1012
1013 (defun bookmark-menu-filter (&rest ignore)
1014   (let ((definedp (and (boundp 'bookmark-alist)
1015                        bookmark-alist
1016                        t)))
1017     `(,(if definedp
1018            '("Jump to Bookmark"
1019              :filter (lambda (&rest junk)
1020                        (mapcar #'(lambda (bmk)
1021                                    `[,bmk (bookmark-jump ',bmk)])
1022                                (bookmark-all-names))))
1023          ["Jump to Bookmark" nil nil])
1024       ["Set bookmark" bookmark-set
1025        :active (fboundp 'bookmark-set)]
1026       "---"
1027       ["Insert contents" bookmark-menu-insert
1028        :active (fboundp 'bookmark-menu-insert)]
1029       ["Insert location" bookmark-menu-locate
1030        :active (fboundp 'bookmark-menu-locate)]
1031       "---"
1032       ["Rename bookmark" bookmark-menu-rename
1033        :active (fboundp 'bookmark-menu-rename)]
1034       ,(if definedp
1035            '("Delete Bookmark"
1036              :filter (lambda (&rest junk)
1037                        (mapcar #'(lambda (bmk)
1038                                    `[,bmk (bookmark-delete ',bmk)])
1039                                (bookmark-all-names))))
1040          ["Delete Bookmark" nil nil])
1041       ["Edit Bookmark List" bookmark-bmenu-list ,definedp]
1042       "---"
1043       ["Save bookmarks"        bookmark-save            ,definedp]
1044       ["Save bookmarks as..."  bookmark-write           ,definedp]
1045       ["Load a bookmark file" bookmark-load
1046        :active (fboundp 'bookmark-load)])))
1047
1048 ;;; The Buffers menu
1049
1050 (defgroup buffers-menu nil
1051   "Customization of `Buffers' menu."
1052   :group 'menu)
1053
1054 (defcustom buffers-menu-max-size 25
1055   "*Maximum number of entries which may appear on the \"Buffers\" menu.
1056 If this is 10, then only the ten most-recently-selected buffers will be
1057 shown.  If this is nil, then all buffers will be shown.  Setting this to
1058 a large number or nil will slow down menu responsiveness."
1059   :type '(choice (const :tag "Show all" nil)
1060                  (integer 10))
1061   :group 'buffers-menu)
1062
1063 (defcustom complex-buffers-menu-p nil
1064   "*If non-nil, the buffers menu will contain several commands.
1065 Commands will be presented as submenus of each buffer line.  If this
1066 is false, then there will be only one command: select that buffer."
1067   :type 'boolean
1068   :group 'buffers-menu)
1069
1070 (defcustom buffers-menu-submenus-for-groups-p nil
1071   "*If non-nil, the buffers menu will contain one submenu per group of buffers.
1072 The grouping function is specified in `buffers-menu-grouping-function'.
1073 If this is an integer, do not build submenus if the number of buffers
1074 is not larger than this value."
1075   :type '(choice (const :tag "No Subgroups" nil)
1076                  (integer :tag "Max. submenus" 10)
1077                  (sexp :format "%t\n" :tag "Allow Subgroups" :value t))
1078   :group 'buffers-menu)
1079
1080 (defcustom buffers-menu-switch-to-buffer-function 'switch-to-buffer
1081   "*The function to call to select a buffer from the buffers menu.
1082 `switch-to-buffer' is a good choice, as is `pop-to-buffer'."
1083   :type '(radio (function-item switch-to-buffer)
1084                 (function-item pop-to-buffer)
1085                 (function :tag "Other"))
1086   :group 'buffers-menu)
1087
1088 (defcustom buffers-menu-omit-function 'buffers-menu-omit-invisible-buffers
1089   "*If non-nil, a function specifying the buffers to omit from the buffers menu.
1090 This is passed a buffer and should return non-nil if the buffer should be
1091 omitted.  The default value `buffers-menu-omit-invisible-buffers' omits
1092 buffers that are normally considered \"invisible\" (those whose name
1093 begins with a space)."
1094   :type '(choice (const :tag "None" nil)
1095                  function)
1096   :group 'buffers-menu)
1097
1098 (defcustom buffers-menu-format-buffer-line-function 'format-buffers-menu-line
1099   "*The function to call to return a string to represent a buffer in the
1100 buffers menu.  The function is passed a buffer and should return a string.
1101 The default value `format-buffers-menu-line' just returns the name of
1102 the buffer.  Also check out `slow-format-buffers-menu-line' which
1103 returns a whole bunch of info about a buffer."
1104   :type 'function
1105   :group 'buffers-menu)
1106
1107 (defcustom buffers-menu-sort-function
1108   'sort-buffers-menu-by-mode-then-alphabetically
1109   "*If non-nil, a function to sort the list of buffers in the buffers menu.
1110 It will be passed two arguments (two buffers to compare) and should return
1111 t if the first is \"less\" than the second.  One possible value is
1112 `sort-buffers-menu-alphabetically'; another is
1113 `sort-buffers-menu-by-mode-then-alphabetically'."
1114   :type '(choice (const :tag "None" nil)
1115                  function)
1116   :group 'buffers-menu)
1117
1118 (defcustom buffers-menu-grouping-function
1119   'group-buffers-menu-by-mode-then-alphabetically
1120   "*If non-nil, a function to group buffers in the buffers menu together.
1121 It will be passed two arguments, successive members of the sorted buffers
1122 list after being passed through `buffers-menu-sort-function'.  It should
1123 return non-nil if the second buffer begins a new group.  The return value
1124 should be the name of the old group, which may be used in hierarchical
1125 buffers menus.  The last invocation of the function contains nil as the
1126 second argument, so that the name of the last group can be determined.
1127
1128 The sensible values of this function are dependent on the value specified
1129 for `buffers-menu-sort-function'."
1130   :type '(choice (const :tag "None" nil)
1131                  function)
1132   :group 'buffers-menu)
1133
1134 (defun buffers-menu-omit-invisible-buffers (buf)
1135   "For use as a value of `buffers-menu-omit-function'.
1136 Omits normally invisible buffers (those whose name begins with a space)."
1137   (not (null (string-match "\\` " (buffer-name buf)))))
1138
1139 (defun sort-buffers-menu-alphabetically (buf1 buf2)
1140   "For use as a value of `buffers-menu-sort-function'.
1141 Sorts the buffers in alphabetical order by name, but puts buffers beginning
1142 with a star at the end of the list."
1143   (let* ((nam1 (buffer-name buf1))
1144          (nam2 (buffer-name buf2))
1145          (inv1p (not (null (string-match "\\` " nam1))))
1146          (inv2p (not (null (string-match "\\` " nam2))))
1147          (star1p (not (null (string-match "\\`*" nam1))))
1148          (star2p (not (null (string-match "\\`*" nam2)))))
1149     (cond ((not (eq inv1p inv2p))
1150            (not inv1p))
1151           ((not (eq star1p star2p))
1152            (not star1p))
1153           (t
1154            (string-lessp nam1 nam2)))))
1155
1156 (defun sort-buffers-menu-by-mode-then-alphabetically (buf1 buf2)
1157   "For use as a value of `buffers-menu-sort-function'.
1158 Sorts first by major mode and then alphabetically by name, but puts buffers
1159 beginning with a star at the end of the list."
1160   (let* ((nam1 (buffer-name buf1))
1161          (nam2 (buffer-name buf2))
1162          (inv1p (not (null (string-match "\\` " nam1))))
1163          (inv2p (not (null (string-match "\\` " nam2))))
1164          (star1p (not (null (string-match "\\`*" nam1))))
1165          (star2p (not (null (string-match "\\`*" nam2))))
1166          (mode1 (symbol-value-in-buffer 'major-mode buf1))
1167          (mode2 (symbol-value-in-buffer 'major-mode buf2)))
1168     (cond ((not (eq inv1p inv2p))
1169            (not inv1p))
1170           ((not (eq star1p star2p))
1171            (not star1p))
1172           ((and star1p star2p (string-lessp nam1 nam2)))
1173           ((string-lessp mode1 mode2)
1174            t)
1175           ((string-lessp mode2 mode1)
1176            nil)
1177           (t
1178            (string-lessp nam1 nam2)))))
1179
1180 ;; this version is too slow on some machines.
1181 (defun slow-format-buffers-menu-line (buffer)
1182   "For use as a value of `buffers-menu-format-buffer-line-function'.
1183 This returns a string containing a bunch of info about the buffer."
1184   (format "%s%s %-19s %6s %-15s %s"
1185           (if (buffer-modified-p buffer) "*" " ")
1186           (if (symbol-value-in-buffer 'buffer-read-only buffer) "%" " ")
1187           (buffer-name buffer)
1188           (buffer-size buffer)
1189           (symbol-value-in-buffer 'mode-name buffer)
1190           (or (buffer-file-name buffer) "")))
1191
1192 (defun format-buffers-menu-line (buffer)
1193   "For use as a value of `buffers-menu-format-buffer-line-function'.
1194 This just returns the buffer's name."
1195   (buffer-name buffer))
1196
1197 (defun group-buffers-menu-by-mode-then-alphabetically (buf1 buf2)
1198   "For use as a value of `buffers-menu-grouping-function'.
1199 This groups buffers by major mode.  It only really makes sense if
1200 `buffers-menu-sorting-function' is
1201 `sort-buffers-menu-by-mode-then-alphabetically'."
1202   (cond ((string-match "\\`*" (buffer-name buf1))
1203          (and (null buf2) "*Misc*"))
1204         ((or (null buf2)
1205              (string-match "\\`*" (buffer-name buf2))
1206              (not (eq (symbol-value-in-buffer 'major-mode buf1)
1207                       (symbol-value-in-buffer 'major-mode buf2))))
1208          (symbol-value-in-buffer 'mode-name buf1))
1209         (t nil)))
1210
1211 (defun buffer-menu-save-buffer (buffer)
1212   (save-excursion
1213     (set-buffer buffer)
1214     (save-buffer)))
1215
1216 (defun buffer-menu-write-file (buffer)
1217   (save-excursion
1218     (set-buffer buffer)
1219     (write-file (read-file-name
1220                  (format "Write %s to file: "
1221                          (buffer-name (current-buffer)))))))
1222
1223 (defsubst build-buffers-menu-internal (buffers)
1224   (let (name line)
1225     (mapcar
1226      #'(lambda (buffer)
1227          (if (eq buffer t)
1228              "---"
1229            (setq line (funcall buffers-menu-format-buffer-line-function
1230                                buffer))
1231            (if complex-buffers-menu-p
1232                (delq nil
1233                      (list line
1234                            (vector "Switch to Buffer"
1235                                    (list buffers-menu-switch-to-buffer-function
1236                                          (setq name (buffer-name buffer)))
1237                                    t)
1238                            (if (eq buffers-menu-switch-to-buffer-function
1239                                    'switch-to-buffer)
1240                                (vector "Switch to Buffer, Other Frame"
1241                                        (list 'switch-to-buffer-other-frame
1242                                              (setq name (buffer-name buffer)))
1243                                        t)
1244                              nil)
1245                            (if (and (buffer-modified-p buffer)
1246                                     (buffer-file-name buffer))
1247                                (vector "Save Buffer"
1248                                        (list 'buffer-menu-save-buffer name) t)
1249                              ["Save Buffer" nil nil]
1250                              )
1251                            (vector "Save As..."
1252                                    (list 'buffer-menu-write-file name) t)
1253                            (vector "Delete Buffer" (list 'kill-buffer name)
1254                                    t)))
1255              ;; #### We don't want buffer names to be translated,
1256              ;; #### so we put the buffer name in the suffix.
1257              ;; #### Also, avoid losing with non-ASCII buffer names.
1258              ;; #### We still lose, however, if complex-buffers-menu-p. --mrb
1259              (vector ""
1260                      (list buffers-menu-switch-to-buffer-function
1261                            (buffer-name buffer))
1262                      t line))))
1263      buffers)))
1264
1265 (defun buffers-menu-filter (menu)
1266   "This is the menu filter for the top-level buffers \"Buffers\" menu.
1267 It dynamically creates a list of buffers to use as the contents of the menu.
1268 Only the most-recently-used few buffers will be listed on the menu, for
1269 efficiency reasons.  You can control how many buffers will be shown by
1270 setting `buffers-menu-max-size'.  You can control the text of the menu
1271 items by redefining the function `format-buffers-menu-line'."
1272   (let ((buffers (delete-if buffers-menu-omit-function (buffer-list))))
1273     (and (integerp buffers-menu-max-size)
1274          (> buffers-menu-max-size 1)
1275          (> (length buffers) buffers-menu-max-size)
1276          ;; shorten list of buffers (not with submenus!)
1277          (not (and buffers-menu-grouping-function
1278                    buffers-menu-submenus-for-groups-p))
1279          (setcdr (nthcdr buffers-menu-max-size buffers) nil))
1280     (if buffers-menu-sort-function
1281         (setq buffers (sort buffers buffers-menu-sort-function)))
1282     (if (and buffers-menu-grouping-function
1283              buffers-menu-submenus-for-groups-p
1284              (or (not (integerp buffers-menu-submenus-for-groups-p))
1285                  (> (length buffers) buffers-menu-submenus-for-groups-p)))
1286         (let (groups groupnames current-group)
1287           (mapl
1288            #'(lambda (sublist)
1289                (let ((groupname (funcall buffers-menu-grouping-function
1290                                          (car sublist) (cadr sublist))))
1291                  (setq current-group (cons (car sublist) current-group))
1292                  (if groupname
1293                      (progn
1294                        (setq groups (cons (nreverse current-group)
1295                                           groups))
1296                        (setq groupnames (cons groupname groupnames))
1297                        (setq current-group nil)))))
1298            buffers)
1299           (setq buffers
1300                 (mapcar*
1301                  #'(lambda (groupname group)
1302                      (cons groupname (build-buffers-menu-internal group)))
1303                  (nreverse groupnames)
1304                  (nreverse groups))))
1305       (if buffers-menu-grouping-function
1306           (progn
1307             (setq buffers
1308                   (mapcon
1309                    #'(lambda (sublist)
1310                        (cond ((funcall buffers-menu-grouping-function
1311                                        (car sublist) (cadr sublist))
1312                               (list (car sublist) t))
1313                              (t (list (car sublist)))))
1314                    buffers))
1315             ;; remove a trailing separator.
1316             (and (>= (length buffers) 2)
1317                  (let ((lastcdr (nthcdr (- (length buffers) 2) buffers)))
1318                    (if (eq t (cadr lastcdr))
1319                        (setcdr lastcdr nil))))))
1320       (setq buffers (build-buffers-menu-internal buffers)))
1321     (append menu buffers)
1322     ))
1323
1324 (defun language-environment-menu-filter (menu)
1325   "This is the menu filter for the \"Language Environment\" submenu."
1326   (mapcar (lambda (env-sym)
1327             `[ ,(capitalize (symbol-name env-sym))
1328                (set-language-environment ',env-sym)])
1329           language-environment-list))
1330
1331 \f
1332 ;;; The Options menu
1333
1334 ;; We'll keep those variables here for a while, in order to provide a
1335 ;; function for porting the old options file that a user may own to Custom.
1336
1337 (defvar options-save-faces nil
1338   "*Non-nil value means save-options will save information about faces.
1339 A nil value means save-options will not save face information.
1340 Set this non-nil only if you use M-x edit-faces to change face
1341 settings.  If you use M-x customize-face or the \"Browse Faces...\"
1342 menu entry, you will see a button in the Customize Face buffer that you
1343 can use to permanently save your face changes.
1344
1345 M-x edit-faces is deprecated.  Support for it and this variable will
1346 be discontinued in a future release.")
1347
1348 (defvar save-options-init-file nil
1349   "File into which to save forms to load the options file (nil for .emacs).
1350 Normally this is nil, which means save into your .emacs file (the value
1351 of `user-init-file'.")
1352
1353 (defvar save-options-file ".xemacs-options"
1354   "File to save options into.
1355 This file is loaded from your .emacs file.
1356 If this is a relative filename, it is put into the same directory as your
1357 .emacs file.")
1358
1359
1360 \f
1361 ;;; The Help menu
1362
1363 (if (featurep 'mule)
1364     (defun tutorials-menu-filter (menu-items)
1365       ;; If there's a tutorial for the current language environment, make it
1366       ;; appear first as the default one. Otherwise, use the english one.
1367       (let* ((menu menu-items)
1368              (item (pop menu-items)))
1369         (aset
1370          item 3
1371          (concat "("
1372                  (if (assoc
1373                       'tutorial
1374                       (assoc current-language-environment language-info-alist))
1375                      current-language-environment
1376                    "English")
1377                  ")"))
1378         menu)))
1379
1380 \f
1381 (set-menubar default-menubar)
1382
1383 \f
1384 ;;; Popup menus.
1385
1386 (defconst default-popup-menu
1387   '("XEmacs Commands"
1388     ["Undo" advertised-undo
1389      :active (and (not (eq buffer-undo-list t))
1390                   (or buffer-undo-list pending-undo-list))
1391      :suffix (if (or (eq last-command 'undo)
1392                      (eq last-command 'advertised-undo))
1393                  "More" "")]
1394     ["Cut" kill-primary-selection
1395      :active (selection-owner-p)]
1396     ["Copy" copy-primary-selection
1397      :active (selection-owner-p)]
1398     ["Paste" yank-clipboard-selection
1399      :active (selection-exists-p 'CLIPBOARD)]
1400     ["Clear" delete-primary-selection
1401      :active (selection-owner-p)]
1402     "-----"
1403     ["Select Block" mark-paragraph]
1404     ["Split Window" split-window-vertically]
1405     ["Unsplit Window" delete-other-windows]
1406     ))
1407
1408 (defvar global-popup-menu nil
1409   "The global popup menu.  This is present in all modes.
1410 See the function `popup-menu' for a description of menu syntax.")
1411
1412 (defvar mode-popup-menu nil
1413   "The mode-specific popup menu.  Automatically buffer local.
1414 This is appended to the default items in `global-popup-menu'.
1415 See the function `popup-menu' for a description of menu syntax.")
1416 (make-variable-buffer-local 'mode-popup-menu)
1417
1418 ;; In an effort to avoid massive menu clutter, this mostly worthless menu is
1419 ;; superseded by any local popup menu...
1420 (setq-default mode-popup-menu default-popup-menu)
1421
1422 (defvar activate-popup-menu-hook nil
1423   "Function or functions run before a mode-specific popup menu is made visible.
1424 These functions are called with no arguments, and should interrogate and
1425 modify the value of `global-popup-menu' or `mode-popup-menu' as desired.
1426 Note: this hook is only run if you use `popup-mode-menu' for activating the
1427 global and mode-specific commands; if you have your own binding for button3,
1428 this hook won't be run.")
1429
1430 (defun popup-mode-menu ()
1431   "Pop up a menu of global and mode-specific commands.
1432 The menu is computed by combining `global-popup-menu' and `mode-popup-menu'."
1433   (interactive "@_")
1434   (run-hooks 'activate-popup-menu-hook)
1435   (popup-menu
1436    (cond ((and global-popup-menu mode-popup-menu)
1437           ;; Merge global-popup-menu and mode-popup-menu
1438           (check-menu-syntax mode-popup-menu)
1439           (let* ((title (car mode-popup-menu))
1440                  (items (cdr mode-popup-menu))
1441                  mode-filters)
1442             ;; Strip keywords from local menu for attaching them at the top
1443             (while (and items
1444                         (keywordp (car items)))
1445               ;; Push both keyword and its argument.
1446               (push (pop items) mode-filters)
1447               (push (pop items) mode-filters))
1448             (setq mode-filters (nreverse mode-filters))
1449             ;; If mode-filters contains a keyword already present in
1450             ;; `global-popup-menu', you will probably lose.
1451             (append (list (car global-popup-menu))
1452                     mode-filters
1453                     (cdr global-popup-menu)
1454                     '("---" "---")
1455                     (if popup-menu-titles (list title))
1456                     (if popup-menu-titles '("---" "---"))
1457                     items)))
1458          (t
1459           (or mode-popup-menu
1460               global-popup-menu
1461               (error "No menu defined in this buffer"))))))
1462
1463 (defun popup-buffer-menu (event)
1464   "Pop up a copy of the Buffers menu (from the menubar) where the mouse is clicked."
1465   (interactive "e")
1466   (let ((window (and (event-over-text-area-p event) (event-window event)))
1467         (bmenu nil))
1468     (or window
1469         (error "Pointer must be in a normal window"))
1470     (select-window window)
1471     (if current-menubar
1472         (setq bmenu (assoc "Buffers" current-menubar)))
1473     (if (null bmenu)
1474         (setq bmenu (assoc "Buffers" default-menubar)))
1475     (if (null bmenu)
1476         (error "Can't find the Buffers menu"))
1477     (popup-menu bmenu)))
1478
1479 (defun popup-menubar-menu (event)
1480   "Pop up a copy of menu that also appears in the menubar"
1481   ;; by Stig@hackvan.com
1482   (interactive "e")
1483   (let ((window (and (event-over-text-area-p event) (event-window event)))
1484         popup-menubar)
1485     (or window
1486         (error "Pointer must be in a normal window"))
1487     (select-window window)
1488     (and current-menubar (run-hooks 'activate-menubar-hook))
1489     ;; ##### Instead of having to copy this just to safely get rid of
1490     ;; any nil what we should really do is fix up the internal menubar
1491     ;; code to just ignore nil if generating a popup menu
1492     (setq popup-menubar (delete nil (copy-sequence (or current-menubar
1493                                                        default-menubar))))
1494     (popup-menu (cons "Menubar Menu" popup-menubar))
1495     ))
1496
1497 (global-set-key 'button3 'popup-mode-menu)
1498 ;; shift button3 and shift button2 are reserved for Hyperbole
1499 (global-set-key '(meta control button3) 'popup-buffer-menu)
1500 ;; The following command is way too dangerous with Custom.
1501 ;; (global-set-key '(meta shift button3) 'popup-menubar-menu)
1502
1503 ;; Here's a test of the cool new menu features (from Stig).
1504
1505 ;;(setq mode-popup-menu
1506 ;;      '("Test Popup Menu"
1507 ;;        :filter cdr
1508 ;;        ["this item won't appear because of the menu filter" ding t]
1509 ;;        "--:singleLine"
1510 ;;        "singleLine"
1511 ;;        "--:doubleLine"
1512 ;;        "doubleLine"
1513 ;;        "--:singleDashedLine"
1514 ;;        "singleDashedLine"
1515 ;;        "--:doubleDashedLine"
1516 ;;        "doubleDashedLine"
1517 ;;        "--:noLine"
1518 ;;        "noLine"
1519 ;;        "--:shadowEtchedIn"
1520 ;;        "shadowEtchedIn"
1521 ;;        "--:shadowEtchedOut"
1522 ;;        "shadowEtchedOut"
1523 ;;        "--:shadowDoubleEtchedIn"
1524 ;;        "shadowDoubleEtchedIn"
1525 ;;        "--:shadowDoubleEtchedOut"
1526 ;;        "shadowDoubleEtchedOut"
1527 ;;        "--:shadowEtchedInDash"
1528 ;;        "shadowEtchedInDash"
1529 ;;        "--:shadowEtchedOutDash"
1530 ;;        "shadowEtchedOutDash"
1531 ;;        "--:shadowDoubleEtchedInDash"
1532 ;;        "shadowDoubleEtchedInDash"
1533 ;;        "--:shadowDoubleEtchedOutDash"
1534 ;;        "shadowDoubleEtchedOutDash"
1535 ;;        ))
1536
1537 (defun xemacs-splash-buffer ()
1538   "Redisplay XEmacs splash screen in a buffer."
1539   (interactive)
1540   (let ((buffer (get-buffer-create "*Splash*"))
1541         tmout)
1542     (set-buffer buffer)
1543     (setq buffer-read-only t)
1544     (erase-buffer buffer)
1545     (setq tmout (display-splash-frame))
1546     (when tmout
1547       (make-local-hook 'kill-buffer-hook)
1548       (add-hook 'kill-buffer-hook
1549                 `(lambda ()
1550                    (disable-timeout ,tmout))
1551                 nil t))
1552     (pop-to-buffer buffer)
1553     (delete-other-windows)))
1554
1555 \f
1556 ;;; backwards compatibility
1557 (provide 'x-menubar)
1558 (provide 'menubar-items)
1559
1560 ;;; menubar-items.el ends here.