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