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