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