1 ;;; menubar-items.el --- Menubar and popup-menu content for XEmacs.
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
9 ;; Maintainer: XEmacs Development Team
10 ;; Keywords: frames, extensions, internal, dumped
12 ;; This file is part of XEmacs.
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)
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.
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.
31 ;; This file is dumped with XEmacs (when window system and menubar support is
36 ;;; Warning-free 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))
44 (defconst default-menubar
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]
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]
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) "")]
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)
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))]
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
85 :suffix (if put-buffer-names-in-file-menu (buffer-name) "")]
87 ["Exit XEmacs" save-buffers-kill-emacs]
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))
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)]
117 ["Search..." isearch-forward]
118 ["Search Backward..." isearch-backward]
119 ["Replace..." query-replace]
121 ["Search (Regexp)..." isearch-forward-regexp]
122 ["Search Backward (Regexp)..." isearch-backward-regexp]
123 ["Replace (Regexp)..." query-replace-regexp]
125 ["Goto Line..." goto-line]
126 ["What Line" what-line]
128 :filter bookmark-menu-filter)
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]
137 ["Show Message Log" show-message-log]
140 ,@(when (featurep 'mule)
142 ("Describe language support")
143 ("Set language environment")
145 ["Toggle input method" toggle-input-method]
146 ["Select input method" set-input-method]
147 ["Describe input method" describe-input-method]
149 ["Describe current coding systems"
150 describe-current-coding-system]
151 ["Set coding system of buffer file"
152 set-buffer-file-coding-system]
153 ;; not implemented yet
154 ["Set coding system of terminal"
155 set-terminal-coding-system :active nil]
156 ;; not implemented yet
157 ["Set coding system of keyboard"
158 set-keyboard-coding-system :active nil]
159 ["Set coding system of process"
160 set-buffer-process-coding-system
161 :active (get-buffer-process (current-buffer))]
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])))
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)]
176 :active (fboundp 'gnus)]
178 :active (fboundp 'w3)]
180 ["Spell-Check Buffer" ispell-buffer
181 :active (fboundp 'ispell-buffer)]
182 ["Toggle VI emulation" toggle-viper-mode
183 :active (fboundp 'toggle-viper-mode)]
186 ["3-Month Calendar" calendar
187 :active (fboundp 'calendar)]
189 :active (fboundp 'diary)]
191 :active (fboundp 'holidays)]
192 ;; we're all pagans at heart ...
193 ["Phases of the Moon" phases-of-moon
194 :active (fboundp 'phases-of-moon)]
195 ["Sunrise/Sunset" sunrise-sunset
196 :active (fboundp 'sunrise-sunset)])
200 :active (fboundp 'xmine)]
202 :active (fboundp 'tetris)]
204 :active (fboundp 'sokoban)]
205 ["Quote from Zippy" yow
206 :active (fboundp 'yow)]
207 ["Psychoanalyst" doctor
208 :active (fboundp 'doctor)]
209 ["Psychoanalyze Zippy!" psychoanalyze-pinhead
210 :active (fboundp 'psychoanalyze-pinhead)]
211 ["Random Flames" flame
212 :active (fboundp 'flame)]
213 ["Dunnet (Adventure)" dunnet
214 :active (fboundp 'dunnet)]
215 ["Towers of Hanoi" hanoi
216 :active (fboundp 'hanoi)]
218 :active (fboundp 'life)]
219 ["Multiplication Puzzle" mpuz
220 :active (fboundp 'mpuz)]))
224 ("Emacs" :filter (lambda (&rest junk)
225 (cdr (custom-menu-create 'emacs))))
226 ["Group..." customize-group]
227 ["Variable..." customize-variable]
228 ["Face..." customize-face]
229 ["Saved..." customize-saved]
230 ["Set..." customize-customized]
231 ["Apropos..." customize-apropos]
232 ["Browse..." customize-browse])
236 :filter (lambda (&rest junk)
237 (package-get-download-menu)))
238 ["Update Package Index" package-get-update-base]
239 ["List & Install" pui-list-packages]
240 ["Update Installed Packages" package-get-update-all]
241 ;; hack-o-matic, we can't force a laod of package-base here
242 ;; since it triggers dialog box interactions which we can't
243 ;; deal while using a menu
245 :filter (lambda (&rest junk)
247 (cdr (custom-menu-create 'packages))
248 '(["Please load Package Index" (lamda (&rest junk) ()) nil]))))
250 ["Help" (Info-goto-node "(xemacs)Packages")])
257 (setq overwrite-mode (if overwrite-mode nil 'overwrite-mode-textual))
258 (customize-set-variable 'overwrite-mode overwrite-mode))
259 :style toggle :selected overwrite-mode]
260 ["Case Sensitive Search"
261 (customize-set-variable 'case-fold-search
262 (setq case-fold-search (not case-fold-search)))
263 :style toggle :selected (not case-fold-search)]
264 ["Case Matching Replace"
265 (customize-set-variable 'case-replace (not case-replace))
266 :style toggle :selected case-replace]
267 ["Auto Delete Selection"
268 (customize-set-variable 'pending-delete-mode (not pending-delete-mode))
270 :selected (and (boundp 'pending-delete-mode) pending-delete-mode)
271 :active (boundp 'pending-delete-mode)]
273 (customize-set-variable 'zmacs-regions (not zmacs-regions))
274 :style toggle :selected zmacs-regions]
275 ["Mouse Paste At Text Cursor"
276 (customize-set-variable 'mouse-yank-at-point (not mouse-yank-at-point))
277 :style toggle :selected mouse-yank-at-point]
278 ("Newline at end of file..."
280 (customize-set-variable 'require-final-newline nil)
281 :style radio :selected (not require-final-newline)]
283 (customize-set-variable 'require-final-newline t)
284 :style radio :selected (eq require-final-newline t)]
286 (customize-set-variable 'require-final-newline 'ask)
287 :style radio :selected (and require-final-newline
288 (not (eq require-final-newline t)))])
289 ["Add Newline When Moving Past End"
290 (customize-set-variable 'next-line-add-newlines
291 (not next-line-add-newlines))
292 :style toggle :selected next-line-add-newlines]
295 ["Teach Extended Commands"
296 (customize-set-variable 'teach-extended-commands-p
297 (not teach-extended-commands-p))
298 :style toggle :selected teach-extended-commands-p]
300 (customize-set-variable 'debug-on-error (not debug-on-error))
301 :style toggle :selected debug-on-error]
303 (customize-set-variable 'debug-on-quit (not debug-on-quit))
304 :style toggle :selected debug-on-quit]
307 ["Command-Line Switches for `lpr'/`lp'..."
308 ;; better to directly open a customization buffer, since the value
309 ;; must be a list of strings, which is somewhat complex to prompt for.
310 (customize-variable 'lpr-switches)
311 (boundp 'lpr-switches)]
312 ("Pretty-Print Paper Size"
314 (customize-set-variable 'ps-paper-type 'letter)
316 :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'letter))
317 :active (boundp 'ps-paper-type)]
319 (customize-set-variable 'ps-paper-type 'letter-small)
321 :selected (and (boundp 'ps-paper-type)
322 (eq ps-paper-type 'letter-small))
323 :active (boundp 'ps-paper-type)]
325 (customize-set-variable 'ps-paper-type 'legal)
327 :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'legal))
328 :active (boundp 'ps-paper-type)]
330 (customize-set-variable 'ps-paper-type 'statement)
332 :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'statement))
333 :active (boundp 'ps-paper-type)]
335 (customize-set-variable 'ps-paper-type 'executive)
337 :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'executive))
338 :active (boundp 'ps-paper-type)]
340 (customize-set-variable 'ps-paper-type 'tabloid)
342 :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'tabloid))
343 :active (boundp 'ps-paper-type)]
345 (customize-set-variable 'ps-paper-type 'ledger)
347 :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'ledger))
348 :active (boundp 'ps-paper-type)]
350 (customize-set-variable 'ps-paper-type 'a3)
352 :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'a3))
353 :active (boundp 'ps-paper-type)]
355 (customize-set-variable 'ps-paper-type 'a4)
357 :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'a4))
358 :active (boundp 'ps-paper-type)]
360 (customize-set-variable 'ps-paper-type 'a4small)
362 :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'a4small))
363 :active (boundp 'ps-paper-type)]
365 (customize-set-variable 'ps-paper-type 'b4)
367 :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'b4))
368 :active (boundp 'ps-paper-type)]
370 (customize-set-variable 'ps-paper-type 'b5)
372 :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'b5))
373 :active (boundp 'ps-paper-type)]
376 (cond (ps-print-color-p
377 (customize-set-variable 'ps-print-color-p nil)
378 ;; I'm wondering whether all this muck is usefull.
379 (and (boundp 'original-face-background)
380 original-face-background
381 (set-face-background 'default original-face-background)))
383 (customize-set-variable 'ps-print-color-p t)
384 (setq original-face-background
385 (face-background-instance 'default))
386 (set-face-background 'default "white")))
388 :selected (and (boundp 'ps-print-color-p) ps-print-color-p)
389 :active (boundp 'ps-print-color-p)])
390 ("\"Other Window\" Location"
391 ["Always in Same Frame"
392 (customize-set-variable
393 'get-frame-for-buffer-default-instance-limit nil)
395 :selected (null get-frame-for-buffer-default-instance-limit)]
396 ["Other Frame (2 Frames Max)"
397 (customize-set-variable 'get-frame-for-buffer-default-instance-limit 2)
399 :selected (eq 2 get-frame-for-buffer-default-instance-limit)]
400 ["Other Frame (3 Frames Max)"
401 (customize-set-variable 'get-frame-for-buffer-default-instance-limit 3)
403 :selected (eq 3 get-frame-for-buffer-default-instance-limit)]
404 ["Other Frame (4 Frames Max)"
405 (customize-set-variable 'get-frame-for-buffer-default-instance-limit 4)
407 :selected (eq 4 get-frame-for-buffer-default-instance-limit)]
408 ["Other Frame (5 Frames Max)"
409 (customize-set-variable 'get-frame-for-buffer-default-instance-limit 5)
411 :selected (eq 5 get-frame-for-buffer-default-instance-limit)]
412 ["Always Create New Frame"
413 (customize-set-variable 'get-frame-for-buffer-default-instance-limit 0)
415 :selected (eq 0 get-frame-for-buffer-default-instance-limit)]
417 ["Temp Buffers Always in Same Frame"
418 (customize-set-variable 'temp-buffer-show-function
419 'show-temp-buffer-in-current-frame)
421 :selected (eq temp-buffer-show-function
422 'show-temp-buffer-in-current-frame)]
423 ["Temp Buffers Like Other Buffers"
424 (customize-set-variable 'temp-buffer-show-function nil)
426 :selected (null temp-buffer-show-function)]
428 ["Make current frame gnuserv target"
429 (customize-set-variable 'gnuserv-frame (if (eq gnuserv-frame t) nil t))
431 :selected (and (boundp 'gnuserv-frame) (eq gnuserv-frame t))
432 :active (boundp 'gnuserv-frame)]
435 ("Syntax Highlighting"
437 (progn ;; becomes buffer local
439 (customize-set-variable 'font-lock-mode font-lock-mode))
441 :selected (and (boundp 'font-lock-mode) font-lock-mode)
442 :active (boundp 'font-lock-mode)]
444 (customize-set-variable 'font-lock-auto-fontify
445 (not font-lock-auto-fontify))
447 :selected (and (boundp 'font-lock-auto-fontify) font-lock-auto-fontify)
448 :active (fboundp 'font-lock-mode)]
453 (font-lock-use-default-fonts)
454 (customize-set-variable 'font-lock-use-fonts t)
455 (customize-set-variable 'font-lock-use-colors nil)
458 :selected (and (boundp 'font-lock-use-fonts) font-lock-use-fonts)
459 :active (fboundp 'font-lock-mode)]
463 (font-lock-use-default-colors)
464 (customize-set-variable 'font-lock-use-colors t)
465 (customize-set-variable 'font-lock-use-fonts nil)
468 :selected (and (boundp 'font-lock-use-colors) font-lock-use-colors)
469 :active (boundp 'font-lock-mode)]
474 (if (or (and (not (integerp font-lock-maximum-decoration))
475 (not (eq t font-lock-maximum-decoration)))
476 (and (integerp font-lock-maximum-decoration)
477 (<= font-lock-maximum-decoration 0)))
479 (customize-set-variable 'font-lock-maximum-decoration nil)
480 (font-lock-recompute-variables)))
482 :active (fboundp 'font-lock-mode)
483 :selected (and (boundp 'font-lock-maximium-decoration)
484 (or (and (not (integerp font-lock-maximum-decoration))
485 (not (eq t font-lock-maximum-decoration)))
486 (and (integerp font-lock-maximum-decoration)
487 (<= font-lock-maximum-decoration 0))))]
491 (if (and (integerp font-lock-maximum-decoration)
492 (= 1 font-lock-maximum-decoration))
494 (customize-set-variable 'font-lock-maximum-decoration 1)
495 (font-lock-recompute-variables)))
497 :active (fboundp 'font-lock-mode)
498 :selected (and (boundp 'font-lock-maximium-decoration)
499 (integerp font-lock-maximum-decoration)
500 (= 1 font-lock-maximum-decoration))]
504 (if (and (integerp font-lock-maximum-decoration)
505 (= 2 font-lock-maximum-decoration))
507 (customize-set-variable 'font-lock-maximum-decoration 2)
508 (font-lock-recompute-variables)))
510 :active (fboundp 'font-lock-mode)
511 :selected (and (boundp 'font-lock-maximum-decoration)
512 (integerp font-lock-maximum-decoration)
513 (= 2 font-lock-maximum-decoration))]
517 (if (or (eq font-lock-maximum-decoration t)
518 (and (integerp font-lock-maximum-decoration)
519 (>= font-lock-maximum-decoration 3)))
521 (customize-set-variable 'font-lock-maximum-decoration t)
522 (font-lock-recompute-variables)))
524 :active (fboundp 'font-lock-mode)
525 :selected (and (boundp 'font-lock-maximum-decoration)
526 (or (eq font-lock-maximum-decoration t)
527 (and (integerp font-lock-maximum-decoration)
528 (>= font-lock-maximum-decoration 3))))]
531 (progn ;; becomes buffer local
533 (customize-set-variable 'lazy-shot-mode lazy-shot-mode)
534 ;; this shouldn't be necessary so there has to
535 ;; be a redisplay bug lurking somewhere (or
536 ;; possibly another event handler bug)
538 :active (and (boundp 'font-lock-mode) (boundp 'lazy-shot-mode)
541 :selected (and (boundp 'lazy-shot-mode) lazy-shot-mode)]
543 (progn ;; becomes buffer local
545 (customize-set-variable 'fast-lock-mode fast-lock-mode)
546 ;; this shouldn't be necessary so there has to
547 ;; be a redisplay bug lurking somewhere (or
548 ;; possibly another event handler bug)
550 :active (and (boundp 'font-lock-mode) (boundp 'fast-lock-mode)
553 :selected (and (boundp 'fast-lock-mode) fast-lock-mode)]
555 ("Paren Highlighting"
557 (customize-set-variable 'paren-mode nil)
559 :selected (and (boundp 'paren-mode) (not paren-mode))
560 :active (boundp 'paren-mode)]
562 (customize-set-variable 'paren-mode 'blink-paren)
564 :selected (and (boundp 'paren-mode) (eq paren-mode 'blink-paren))
565 :active (boundp 'paren-mode)]
567 (customize-set-variable 'paren-mode 'paren)
569 :selected (and (boundp 'paren-mode) (eq paren-mode 'paren))
570 :active (boundp 'paren-mode)]
572 (customize-set-variable 'paren-mode 'sexp)
574 :selected (and (boundp 'paren-mode) (eq paren-mode 'sexp))
575 :active (boundp 'paren-mode)]
577 ;; (customize-set-variable 'paren-mode 'nested)
579 ;; :selected (and (boundp 'paren-mode) (eq paren-mode 'nested))
580 ;; :active (boundp 'paren-mode)]
584 ["Frame-Local Font Menu"
585 (customize-set-variable 'font-menu-this-frame-only-p
586 (not font-menu-this-frame-only-p))
588 :selected (and (boundp 'font-menu-this-frame-only-p)
589 font-menu-this-frame-only-p)]
590 ,@(if (featurep 'scrollbar)
592 (customize-set-variable 'scrollbars-visible-p
593 (not scrollbars-visible-p))
595 :selected scrollbars-visible-p]))
596 ;; I don't think this is of any interest. - dverna apr. 98
597 ;; #### I beg to differ! Many FSFmacs converts hate the 3D
598 ;; modeline, and it was perfectly fine to be able to turn them
599 ;; off through the Options menu. I would have uncommented this
600 ;; source, but the code for saving options would not save the
601 ;; modeline 3D-ness. Grrr. --hniksic
604 ;; (if (zerop (specifier-instance modeline-shadow-thickness))
605 ;; (set-specifier modeline-shadow-thickness 2)
606 ;; (set-specifier modeline-shadow-thickness 0))
607 ;; (redraw-modeline t))
609 ;; :selected (let ((thickness
610 ;; (specifier-instance modeline-shadow-thickness)))
611 ;; (and (integerp thickness)
612 ;; (> thickness 0)))]
614 (progn ;; becomes buffer-local
615 (setq truncate-lines (not truncate-lines))
616 (customize-set-variable 'truncate-lines truncate-lines))
618 :selected truncate-lines]
620 (customize-set-variable 'blink-cursor-mode (not blink-cursor-mode))
622 :selected (and (boundp 'blink-cursor-mode) blink-cursor-mode)
623 :active (boundp 'blink-cursor-mode)]
627 (customize-set-variable 'bar-cursor nil)
628 (force-cursor-redisplay))
630 :selected (null bar-cursor)]
631 ["Bar cursor (1 pixel)"
633 (customize-set-variable 'bar-cursor t)
634 (force-cursor-redisplay))
636 :selected (eq bar-cursor t)]
637 ["Bar cursor (2 pixels)"
639 (customize-set-variable 'bar-cursor 2)
640 (force-cursor-redisplay))
642 :selected (and bar-cursor (not (eq bar-cursor t)))]
646 (customize-set-variable 'line-number-mode (not line-number-mode))
648 :style toggle :selected line-number-mode]
651 (customize-set-variable 'column-number-mode
652 (not column-number-mode))
654 :style toggle :selected column-number-mode]
656 ("Menubar Appearance"
657 ["Buffers Menu Length..."
658 (customize-set-variable
659 'buffers-menu-max-size
660 ;; would it be better to open a customization buffer ?
663 "Enter number of buffers to display (or 0 for unlimited): ")))
664 (if (eq val 0) nil val)))]
665 ["Multi-Operation Buffers Sub-Menus"
666 (customize-set-variable 'complex-buffers-menu-p
667 (not complex-buffers-menu-p))
669 :selected complex-buffers-menu-p]
670 ("Buffers Menu Sorting"
671 ["Most Recently Used"
673 (customize-set-variable 'buffers-menu-sort-function nil)
674 (customize-set-variable 'buffers-menu-grouping-function nil))
676 :selected (null buffers-menu-sort-function)]
679 (customize-set-variable 'buffers-menu-sort-function
680 'sort-buffers-menu-alphabetically)
681 (customize-set-variable 'buffers-menu-grouping-function nil))
683 :selected (eq 'sort-buffers-menu-alphabetically
684 buffers-menu-sort-function)]
685 ["By Major Mode, Then Alphabetically"
687 (customize-set-variable
688 'buffers-menu-sort-function
689 'sort-buffers-menu-by-mode-then-alphabetically)
690 (customize-set-variable
691 'buffers-menu-grouping-function
692 'group-buffers-menu-by-mode-then-alphabetically))
694 :selected (eq 'sort-buffers-menu-by-mode-then-alphabetically
695 buffers-menu-sort-function)])
696 ["Submenus for Buffer Groups"
697 (customize-set-variable 'buffers-menu-submenus-for-groups-p
698 (not buffers-menu-submenus-for-groups-p))
700 :selected buffers-menu-submenus-for-groups-p]
702 ["Ignore Scaled Fonts"
703 (customize-set-variable 'font-menu-ignore-scaled-fonts
704 (not font-menu-ignore-scaled-fonts))
706 :selected (and (boundp 'font-menu-ignore-scaled-fonts)
707 font-menu-ignore-scaled-fonts)]
709 ,@(if (featurep 'toolbar)
710 '(("Toolbar Appearance"
712 (customize-set-variable 'toolbar-visible-p
713 (not toolbar-visible-p))
715 :selected toolbar-visible-p]
717 (customize-set-variable 'toolbar-captioned-p
718 (not toolbar-captioned-p))
720 :selected toolbar-captioned-p]
723 (customize-set-variable 'default-toolbar-position 'top)
725 :selected (eq default-toolbar-position 'top)]
727 (customize-set-variable 'default-toolbar-position 'bottom)
729 :selected (eq default-toolbar-position 'bottom)]
731 (customize-set-variable 'default-toolbar-position 'left)
733 :selected (eq default-toolbar-position 'left)]
735 (customize-set-variable 'default-toolbar-position 'right)
737 :selected (eq default-toolbar-position 'right)]
740 ,@(if (featurep 'gutter)
741 '(("Gutter Appearance"
743 (customize-set-variable 'gutter-visible-p
744 (not gutter-visible-p))
746 :selected gutter-visible-p]
749 (customize-set-variable 'default-gutter-position 'top)
751 :selected (eq default-gutter-position 'top)]
753 (customize-set-variable 'default-gutter-position 'bottom)
755 :selected (eq default-gutter-position 'bottom)]
757 (customize-set-variable 'default-gutter-position 'left)
759 :selected (eq default-gutter-position 'left)]
761 (customize-set-variable 'default-gutter-position 'right)
763 :selected (eq default-gutter-position 'right)]
768 (customize-set-variable 'mouse-avoidance-mode
769 (if mouse-avoidance-mode nil 'banish))
771 :selected (and (boundp 'mouse-avoidance-mode) mouse-avoidance-mode)
772 :active (and (boundp 'mouse-avoidance-mode)
773 (device-on-window-system-p))]
775 (customize-set-variable 'strokes-mode (not strokes-mode))
777 :selected (and (boundp 'strokes-mode) strokes-mode)
778 :active (and (boundp 'strokes-mode)
779 (device-on-window-system-p))]
783 (customize-set-variable 'browse-url-browser-function 'browse-url-w3)
785 :selected (and (boundp 'browse-url-browser-function)
786 (eq browse-url-browser-function 'browse-url-w3))
787 :active (and (boundp 'browse-url-browser-function)
788 (fboundp 'browse-url-w3)
789 (fboundp 'w3-fetch))]
791 (customize-set-variable 'browse-url-browser-function
792 'browse-url-netscape)
794 :selected (and (boundp 'browse-url-browser-function)
795 (eq browse-url-browser-function 'browse-url-netscape))
796 :active (and (boundp 'browse-url-browser-function)
797 (fboundp 'browse-url-netscape))]
799 (customize-set-variable 'browse-url-browser-function
802 :selected (and (boundp 'browse-url-browser-function)
803 (eq browse-url-browser-function 'browse-url-mosaic))
804 :active (and (boundp 'browse-url-browser-function)
805 (fboundp 'browse-url-mosaic))]
807 (customize-set-variable 'browse-url-browser-function 'browse-url-cci)
809 :selected (and (boundp 'browse-url-browser-function)
810 (eq browse-url-browser-function 'browse-url-cci))
811 :active (and (boundp 'browse-url-browser-function)
812 (fboundp 'browse-url-cci))]
814 (customize-set-variable 'browse-url-browser-function
815 'browse-url-iximosaic)
817 :selected (and (boundp 'browse-url-browser-function)
818 (eq browse-url-browser-function 'browse-url-iximosaic))
819 :active (and (boundp 'browse-url-browser-function)
820 (fboundp 'browse-url-iximosaic))]
822 (customize-set-variable 'browse-url-browser-function
823 'browse-url-lynx-xterm)
825 :selected (and (boundp 'browse-url-browser-function)
826 (eq browse-url-browser-function 'browse-url-lynx-xterm))
827 :active (and (boundp 'browse-url-browser-function)
828 (fboundp 'browse-url-lynx-xterm))]
830 (customize-set-variable 'browse-url-browser-function
831 'browse-url-lynx-emacs)
833 :selected (and (boundp 'browse-url-browser-function)
834 (eq browse-url-browser-function 'browse-url-lynx-emacs))
835 :active (and (boundp 'browse-url-browser-function)
836 (fboundp 'browse-url-lynx-emacs))]
838 (customize-set-variable 'browse-url-browser-function
841 :selected (and (boundp 'browse-url-browser-function)
842 (eq browse-url-browser-function 'browse-url-grail))
843 :active (and (boundp 'browse-url-browser-function)
844 (fboundp 'browse-url-grail))]
846 (customize-set-variable 'browse-url-browser-function
849 :selected (and (boundp 'browse-url-browser-function)
850 (eq browse-url-browser-function 'browse-url-kfm))
851 :active (and (boundp 'browse-url-browser-function)
852 (fboundp 'browse-url-kfm))]
855 ["Edit Faces..." (customize-face nil)]
856 ("Font" :filter font-menu-family-constructor)
857 ("Size" :filter font-menu-size-constructor)
858 ; ("Weight" :filter font-menu-weight-constructor)
860 ["Save Options" customize-save-customized]
864 :filter buffers-menu-filter
865 ["Read Only" (toggle-read-only)
866 :style toggle :selected buffer-read-only]
867 ["List All Buffers" list-buffers]
873 :active (fboundp 'grep)]
874 ["Compile..." compile
875 :active (fboundp 'compile)]
877 :active (fboundp 'shell)]
878 ["Shell Command..." shell-command
879 :active (fboundp 'shell-command)]
880 ["Shell Command on Region..." shell-command-on-region
881 :active (and (fboundp 'shell-command-on-region) (region-exists-p))]
882 ["Debug (GDB)..." gdb
883 :active (fboundp 'gdb)]
884 ["Debug (DBX)..." dbx
885 :active (fboundp 'dbx)]
888 ["Find Tag..." find-tag]
889 ["Find Other Window..." find-tag-other-window]
890 ["Next Tag..." (find-tag nil)]
891 ["Next Other Window..." (find-tag-other-window nil)]
892 ["Next File" next-file]
894 ["Tags Search..." tags-search]
895 ["Tags Replace..." tags-query-replace]
896 ["Continue Search/Replace" tags-loop-continue]
898 ["Pop stack" pop-tag-mark]
899 ["Apropos..." tags-apropos]
901 ["Set Tags Table File..." visit-tags-table]
904 nil ; the partition: menus after this are flushright
907 ["About XEmacs..." about-xemacs]
909 ["Installation" describe-installation
910 :active (boundp 'Installation-string)]
912 ,(if (featurep 'mule)
914 (let ((lang language-info-alist)
917 (and (setq tut (assq 'tutorial (car lang)))
918 (not (string= (caar lang) "ASCII"))
922 `[,(caar lang) (help-with-tutorial nil ,(cdr tut))]
924 (setq lang (cdr lang)))
925 (append `("Tutorials"
926 :filter tutorials-menu-filter
927 ["Default" help-with-tutorial t
928 ,(concat "(" current-language-environment ")")])
930 ;; Non mule tutorials.
931 (let ((lang tutorial-supported-languages)
937 (help-with-tutorial ,(format "TUTORIAL.%s"
940 (setq lang (cdr lang)))
941 (append '("Tutorials"
942 ["English" help-with-tutorial])
944 ["News" view-emacs-news]
945 ["Packages" finder-by-keyword]
946 ["Splash" xemacs-splash-buffer])
949 ["FAQ (local)" xemacs-local-faq]
950 ["FAQ via WWW" xemacs-www-faq (boundp 'browse-url-browser-function)]
951 ["Home Page" xemacs-www-page (boundp 'browse-url-browser-function)])
953 ["Sample .emacs" (find-file (locate-data-file "sample.emacs")) (locate-data-file "sample.emacs")]
954 ["Sample .Xdefaults" (find-file (locate-data-file "sample.Xdefaults")) (locate-data-file "sample.Xdefaults")]
955 ["Sample enriched" (find-file (locate-data-file "enriched.doc")) (locate-data-file "enriched.doc")])
958 ["Key Binding..." Info-goto-emacs-key-command-node]
959 ["Command..." Info-goto-emacs-command-node]
960 ["Function..." Info-elisp-ref]
961 ["Topic..." Info-query])
964 ["Unix Manual..." manual-entry])
966 ["Mode" describe-mode]
967 ["Apropos..." hyper-apropos]
968 ["Apropos Docs..." apropos-documentation]
970 ["Key..." describe-key]
971 ["Bindings" describe-bindings]
972 ["Mouse Bindings" describe-pointer]
973 ["Recent Keys" view-lossage]
975 ["Function..." describe-function]
976 ["Variable..." describe-variable]
977 ["Locate Command..." where-is])
979 ["Recent Messages" view-lossage]
981 ["No Warranty" describe-no-warranty]
982 ["XEmacs License" describe-copying]
983 ["The Latest Version" describe-distribution])
984 ["Send Bug Report..." report-emacs-bug
985 :active (fboundp 'report-emacs-bug)]))))
988 (defun maybe-add-init-button ()
990 Adds `Load .emacs' button to menubar when starting up with -q."
991 ;; by Stig@hackvan.com
993 (load-user-init-file-p nil)
994 ((file-exists-p (expand-file-name ".emacs" "~"))
997 (progn (delete-menu-item '("Load .emacs"))
998 (load-user-init-file (user-login-name)))
1003 (add-hook 'before-init-hook 'maybe-add-init-button)
1008 (defvar put-buffer-names-in-file-menu t)
1011 ;;; The Bookmarks menu
1013 (defun bookmark-menu-filter (&rest ignore)
1014 (let ((definedp (and (boundp 'bookmark-alist)
1018 '("Jump to Bookmark"
1019 :filter (lambda (&rest junk)
1020 (mapcar #'(lambda (bmk)
1021 `[,bmk (bookmark-jump ',bmk)])
1022 (bookmark-all-names))))
1023 ["Jump to Bookmark" nil nil])
1024 ["Set bookmark" bookmark-set
1025 :active (fboundp 'bookmark-set)]
1027 ["Insert contents" bookmark-menu-insert
1028 :active (fboundp 'bookmark-menu-insert)]
1029 ["Insert location" bookmark-menu-locate
1030 :active (fboundp 'bookmark-menu-locate)]
1032 ["Rename bookmark" bookmark-menu-rename
1033 :active (fboundp 'bookmark-menu-rename)]
1036 :filter (lambda (&rest junk)
1037 (mapcar #'(lambda (bmk)
1038 `[,bmk (bookmark-delete ',bmk)])
1039 (bookmark-all-names))))
1040 ["Delete Bookmark" nil nil])
1041 ["Edit Bookmark List" bookmark-bmenu-list ,definedp]
1043 ["Save bookmarks" bookmark-save ,definedp]
1044 ["Save bookmarks as..." bookmark-write ,definedp]
1045 ["Load a bookmark file" bookmark-load
1046 :active (fboundp 'bookmark-load)])))
1048 ;;; The Buffers menu
1050 (defgroup buffers-menu nil
1051 "Customization of `Buffers' menu."
1054 (defcustom buffers-menu-max-size 25
1055 "*Maximum number of entries which may appear on the \"Buffers\" menu.
1056 If this is 10, then only the ten most-recently-selected buffers will be
1057 shown. If this is nil, then all buffers will be shown. Setting this to
1058 a large number or nil will slow down menu responsiveness."
1059 :type '(choice (const :tag "Show all" nil)
1061 :group 'buffers-menu)
1063 (defcustom complex-buffers-menu-p nil
1064 "*If non-nil, the buffers menu will contain several commands.
1065 Commands will be presented as submenus of each buffer line. If this
1066 is false, then there will be only one command: select that buffer."
1068 :group 'buffers-menu)
1070 (defcustom buffers-menu-submenus-for-groups-p nil
1071 "*If non-nil, the buffers menu will contain one submenu per group of buffers.
1072 The grouping function is specified in `buffers-menu-grouping-function'.
1073 If this is an integer, do not build submenus if the number of buffers
1074 is not larger than this value."
1075 :type '(choice (const :tag "No Subgroups" nil)
1076 (integer :tag "Max. submenus" 10)
1077 (sexp :format "%t\n" :tag "Allow Subgroups" :value t))
1078 :group 'buffers-menu)
1080 (defcustom buffers-menu-switch-to-buffer-function 'switch-to-buffer
1081 "*The function to call to select a buffer from the buffers menu.
1082 `switch-to-buffer' is a good choice, as is `pop-to-buffer'."
1083 :type '(radio (function-item switch-to-buffer)
1084 (function-item pop-to-buffer)
1085 (function :tag "Other"))
1086 :group 'buffers-menu)
1088 (defcustom buffers-menu-omit-function 'buffers-menu-omit-invisible-buffers
1089 "*If non-nil, a function specifying the buffers to omit from the buffers menu.
1090 This is passed a buffer and should return non-nil if the buffer should be
1091 omitted. The default value `buffers-menu-omit-invisible-buffers' omits
1092 buffers that are normally considered \"invisible\" (those whose name
1093 begins with a space)."
1094 :type '(choice (const :tag "None" nil)
1096 :group 'buffers-menu)
1098 (defcustom buffers-menu-format-buffer-line-function 'format-buffers-menu-line
1099 "*The function to call to return a string to represent a buffer in the
1100 buffers menu. The function is passed a buffer and should return a string.
1101 The default value `format-buffers-menu-line' just returns the name of
1102 the buffer. Also check out `slow-format-buffers-menu-line' which
1103 returns a whole bunch of info about a buffer."
1105 :group 'buffers-menu)
1107 (defcustom buffers-menu-sort-function
1108 'sort-buffers-menu-by-mode-then-alphabetically
1109 "*If non-nil, a function to sort the list of buffers in the buffers menu.
1110 It will be passed two arguments (two buffers to compare) and should return
1111 T if the first is \"less\" than the second. One possible value is
1112 `sort-buffers-menu-alphabetically'; another is
1113 `sort-buffers-menu-by-mode-then-alphabetically'."
1114 :type '(choice (const :tag "None" nil)
1116 :group 'buffers-menu)
1118 (defcustom buffers-menu-grouping-function
1119 'group-buffers-menu-by-mode-then-alphabetically
1120 "*If non-nil, a function to group buffers in the buffers menu together.
1121 It will be passed two arguments, successive members of the sorted buffers
1122 list after being passed through `buffers-menu-sort-function'. It should
1123 return non-nil if the second buffer begins a new group. The return value
1124 should be the name of the old group, which may be used in hierarchical
1125 buffers menus. The last invocation of the function contains nil as the
1126 second argument, so that the name of the last group can be determined.
1128 The sensible values of this function are dependent on the value specified
1129 for `buffers-menu-sort-function'."
1130 :type '(choice (const :tag "None" nil)
1132 :group 'buffers-menu)
1134 (defun buffers-menu-omit-invisible-buffers (buf)
1135 "For use as a value of `buffers-menu-omit-function'.
1136 Omits normally invisible buffers (those whose name begins with a space)."
1137 (not (null (string-match "\\` " (buffer-name buf)))))
1139 (defun sort-buffers-menu-alphabetically (buf1 buf2)
1140 "For use as a value of `buffers-menu-sort-function'.
1141 Sorts the buffers in alphabetical order by name, but puts buffers beginning
1142 with a star at the end of the list."
1143 (let* ((nam1 (buffer-name buf1))
1144 (nam2 (buffer-name buf2))
1145 (star1p (not (null (string-match "\\`*" nam1))))
1146 (star2p (not (null (string-match "\\`*" nam2)))))
1147 (if (not (eq star1p star2p))
1149 (string-lessp nam1 nam2))))
1151 (defun sort-buffers-menu-by-mode-then-alphabetically (buf1 buf2)
1152 "For use as a value of `buffers-menu-sort-function'.
1153 Sorts first by major mode and then alphabetically by name, but puts buffers
1154 beginning with a star at the end of the list."
1155 (let* ((nam1 (buffer-name buf1))
1156 (nam2 (buffer-name buf2))
1157 (star1p (not (null (string-match "\\`*" nam1))))
1158 (star2p (not (null (string-match "\\`*" nam2))))
1159 (mode1 (symbol-value-in-buffer 'major-mode buf1))
1160 (mode2 (symbol-value-in-buffer 'major-mode buf2)))
1161 (cond ((not (eq star1p star2p)) (not star1p))
1162 ((and star1p star2p (string-lessp nam1 nam2)))
1163 ((string-lessp mode1 mode2) t)
1164 ((string-lessp mode2 mode1) nil)
1165 (t (string-lessp nam1 nam2)))))
1167 ;; this version is too slow on some machines.
1168 (defun slow-format-buffers-menu-line (buffer)
1169 "For use as a value of `buffers-menu-format-buffer-line-function'.
1170 This returns a string containing a bunch of info about the buffer."
1171 (format "%s%s %-19s %6s %-15s %s"
1172 (if (buffer-modified-p buffer) "*" " ")
1173 (if (symbol-value-in-buffer 'buffer-read-only buffer) "%" " ")
1174 (buffer-name buffer)
1175 (buffer-size buffer)
1176 (symbol-value-in-buffer 'mode-name buffer)
1177 (or (buffer-file-name buffer) "")))
1179 (defun format-buffers-menu-line (buffer)
1180 "For use as a value of `buffers-menu-format-buffer-line-function'.
1181 This just returns the buffer's name."
1182 (buffer-name buffer))
1184 (defun group-buffers-menu-by-mode-then-alphabetically (buf1 buf2)
1185 "For use as a value of `buffers-menu-grouping-function'.
1186 This groups buffers by major mode. It only really makes sense if
1187 `buffers-menu-sorting-function' is
1188 `sort-buffers-menu-by-mode-then-alphabetically'."
1189 (cond ((string-match "\\`*" (buffer-name buf1))
1190 (and (null buf2) "*Misc*"))
1192 (string-match "\\`*" (buffer-name buf2))
1193 (not (eq (symbol-value-in-buffer 'major-mode buf1)
1194 (symbol-value-in-buffer 'major-mode buf2))))
1195 (symbol-value-in-buffer 'mode-name buf1))
1198 (defun buffer-menu-save-buffer (buffer)
1203 (defun buffer-menu-write-file (buffer)
1206 (write-file (read-file-name
1207 (format "Write %s to file: "
1208 (buffer-name (current-buffer)))))))
1210 (defsubst build-buffers-menu-internal (buffers)
1216 (setq line (funcall buffers-menu-format-buffer-line-function
1218 (if complex-buffers-menu-p
1221 (vector "Switch to Buffer"
1222 (list buffers-menu-switch-to-buffer-function
1223 (setq name (buffer-name buffer)))
1225 (if (eq buffers-menu-switch-to-buffer-function
1227 (vector "Switch to Buffer, Other Frame"
1228 (list 'switch-to-buffer-other-frame
1229 (setq name (buffer-name buffer)))
1232 (if (and (buffer-modified-p buffer)
1233 (buffer-file-name buffer))
1234 (vector "Save Buffer"
1235 (list 'buffer-menu-save-buffer name) t)
1236 ["Save Buffer" nil nil]
1238 (vector "Save As..."
1239 (list 'buffer-menu-write-file name) t)
1240 (vector "Delete Buffer" (list 'kill-buffer name)
1242 ;; ### We don't want buffer names to be translated,
1243 ;; ### so we put the buffer name in the suffix.
1244 ;; ### Also, avoid losing with non-ASCII buffer names.
1245 ;; ### We still lose, however, if complex-buffers-menu-p. --mrb
1247 (list buffers-menu-switch-to-buffer-function
1248 (buffer-name buffer))
1252 (defun buffers-menu-filter (menu)
1253 "This is the menu filter for the top-level buffers \"Buffers\" menu.
1254 It dynamically creates a list of buffers to use as the contents of the menu.
1255 Only the most-recently-used few buffers will be listed on the menu, for
1256 efficiency reasons. You can control how many buffers will be shown by
1257 setting `buffers-menu-max-size'. You can control the text of the menu
1258 items by redefining the function `format-buffers-menu-line'."
1259 (let ((buffers (delete-if buffers-menu-omit-function (buffer-list))))
1260 (and (integerp buffers-menu-max-size)
1261 (> buffers-menu-max-size 1)
1262 (> (length buffers) buffers-menu-max-size)
1263 ;; shorten list of buffers (not with submenus!)
1264 (not (and buffers-menu-grouping-function
1265 buffers-menu-submenus-for-groups-p))
1266 (setcdr (nthcdr buffers-menu-max-size buffers) nil))
1267 (if buffers-menu-sort-function
1268 (setq buffers (sort buffers buffers-menu-sort-function)))
1269 (if (and buffers-menu-grouping-function
1270 buffers-menu-submenus-for-groups-p
1271 (or (not (integerp buffers-menu-submenus-for-groups-p))
1272 (> (length buffers) buffers-menu-submenus-for-groups-p)))
1273 (let (groups groupnames current-group)
1276 (let ((groupname (funcall buffers-menu-grouping-function
1277 (car sublist) (cadr sublist))))
1278 (setq current-group (cons (car sublist) current-group))
1281 (setq groups (cons (nreverse current-group)
1283 (setq groupnames (cons groupname groupnames))
1284 (setq current-group nil)))))
1288 #'(lambda (groupname group)
1289 (cons groupname (build-buffers-menu-internal group)))
1290 (nreverse groupnames)
1291 (nreverse groups))))
1292 (if buffers-menu-grouping-function
1297 (cond ((funcall buffers-menu-grouping-function
1298 (car sublist) (cadr sublist))
1299 (list (car sublist) t))
1300 (t (list (car sublist)))))
1302 ;; remove a trailing separator.
1303 (and (>= (length buffers) 2)
1304 (let ((lastcdr (nthcdr (- (length buffers) 2) buffers)))
1305 (if (eq t (cadr lastcdr))
1306 (setcdr lastcdr nil))))))
1307 (setq buffers (build-buffers-menu-internal buffers)))
1308 (append menu buffers)
1311 (defun language-environment-menu-filter (menu)
1312 "This is the menu filter for the \"Language Environment\" submenu."
1313 (mapcar (lambda (env-sym)
1314 `[ ,(capitalize (symbol-name env-sym))
1315 (set-language-environment ',env-sym)])
1316 language-environment-list))
1319 ;;; The Options menu
1321 ;; We'll keep those variables here for a while, in order to provide a
1322 ;; function for porting the old options file that a user may own to Custom.
1324 (defvar options-save-faces nil
1325 "*Non-nil value means save-options will save information about faces.
1326 A nil value means save-options will not save face information.
1327 Set this non-nil only if you use M-x edit-faces to change face
1328 settings. If you use M-x customize-face or the \"Browse Faces...\"
1329 menu entry, you will see a button in the Customize Face buffer that you
1330 can use to permanently save your face changes.
1332 M-x edit-faces is deprecated. Support for it and this variable will
1333 be discontinued in a future release.")
1335 (defvar save-options-init-file nil
1336 "File into which to save forms to load the options file (nil for .emacs).
1337 Normally this is nil, which means save into your .emacs file (the value
1338 of `user-init-file'.")
1340 (defvar save-options-file ".xemacs-options"
1341 "File to save options into.
1342 This file is loaded from your .emacs file.
1343 If this is a relative filename, it is put into the same directory as your
1350 (if (featurep 'mule)
1351 (defun tutorials-menu-filter (menu-items)
1352 ;; If there's a tutorial for the current language environment, make it
1353 ;; appear first as the default one. Otherwise, use the english one.
1354 (let* ((menu menu-items)
1355 (item (pop menu-items)))
1361 (assoc current-language-environment language-info-alist))
1362 current-language-environment
1368 (set-menubar default-menubar)
1373 (defconst default-popup-menu
1375 ["Undo" advertised-undo
1376 :active (and (not (eq buffer-undo-list t))
1377 (or buffer-undo-list pending-undo-list))
1378 :suffix (if (or (eq last-command 'undo)
1379 (eq last-command 'advertised-undo))
1381 ["Cut" kill-primary-selection
1382 :active (selection-owner-p)]
1383 ["Copy" copy-primary-selection
1384 :active (selection-owner-p)]
1385 ["Paste" yank-clipboard-selection
1386 :active (selection-exists-p 'CLIPBOARD)]
1387 ["Clear" delete-primary-selection
1388 :active (selection-owner-p)]
1390 ["Select Block" mark-paragraph]
1391 ["Split Window" split-window-vertically]
1392 ["Unsplit Window" delete-other-windows]
1395 (defvar global-popup-menu nil
1396 "The global popup menu. This is present in all modes.
1397 See the function `popup-menu' for a description of menu syntax.")
1399 (defvar mode-popup-menu nil
1400 "The mode-specific popup menu. Automatically buffer local.
1401 This is appended to the default items in `global-popup-menu'.
1402 See the function `popup-menu' for a description of menu syntax.")
1403 (make-variable-buffer-local 'mode-popup-menu)
1405 ;; In an effort to avoid massive menu clutter, this mostly worthless menu is
1406 ;; superceded by any local popup menu...
1407 (setq-default mode-popup-menu default-popup-menu)
1409 (defvar activate-popup-menu-hook nil
1410 "Function or functions run before a mode-specific popup menu is made visible.
1411 These functions are called with no arguments, and should interrogate and
1412 modify the value of `global-popup-menu' or `mode-popup-menu' as desired.
1413 Note: this hook is only run if you use `popup-mode-menu' for activating the
1414 global and mode-specific commands; if you have your own binding for button3,
1415 this hook won't be run.")
1417 (defun popup-mode-menu ()
1418 "Pop up a menu of global and mode-specific commands.
1419 The menu is computed by combining `global-popup-menu' and `mode-popup-menu'."
1421 (run-hooks 'activate-popup-menu-hook)
1423 (cond ((and global-popup-menu mode-popup-menu)
1424 ;; Merge global-popup-menu and mode-popup-menu
1425 (check-menu-syntax mode-popup-menu)
1426 (let* ((title (car mode-popup-menu))
1427 (items (cdr mode-popup-menu))
1429 ;; Strip keywords from local menu for attaching them at the top
1431 (keywordp (car items)))
1432 ;; Push both keyword and its argument.
1433 (push (pop items) mode-filters)
1434 (push (pop items) mode-filters))
1435 (setq mode-filters (nreverse mode-filters))
1436 ;; If mode-filters contains a keyword already present in
1437 ;; `global-popup-menu', you will probably lose.
1438 (append (list (car global-popup-menu))
1440 (cdr global-popup-menu)
1442 (if popup-menu-titles (list title))
1443 (if popup-menu-titles '("---" "---"))
1448 (error "No menu defined in this buffer"))))))
1450 (defun popup-buffer-menu (event)
1451 "Pop up a copy of the Buffers menu (from the menubar) where the mouse is clicked."
1453 (let ((window (and (event-over-text-area-p event) (event-window event)))
1456 (error "Pointer must be in a normal window"))
1457 (select-window window)
1459 (setq bmenu (assoc "Buffers" current-menubar)))
1461 (setq bmenu (assoc "Buffers" default-menubar)))
1463 (error "Can't find the Buffers menu"))
1464 (popup-menu bmenu)))
1466 (defun popup-menubar-menu (event)
1467 "Pop up a copy of menu that also appears in the menubar"
1468 ;; by Stig@hackvan.com
1470 (let ((window (and (event-over-text-area-p event) (event-window event)))
1473 (error "Pointer must be in a normal window"))
1474 (select-window window)
1475 (and current-menubar (run-hooks 'activate-menubar-hook))
1476 ;; ##### Instead of having to copy this just to safely get rid of
1477 ;; any nil what we should really do is fix up the internal menubar
1478 ;; code to just ignore nil if generating a popup menu
1479 (setq popup-menubar (delete nil (copy-sequence (or current-menubar
1481 (popup-menu (cons "Menubar Menu" popup-menubar))
1484 (global-set-key 'button3 'popup-mode-menu)
1485 ;; shift button3 and shift button2 are reserved for Hyperbole
1486 (global-set-key '(meta control button3) 'popup-buffer-menu)
1487 ;; The following command is way too dangerous with Custom.
1488 ;; (global-set-key '(meta shift button3) 'popup-menubar-menu)
1490 ;; Here's a test of the cool new menu features (from Stig).
1492 ;;(setq mode-popup-menu
1493 ;; '("Test Popup Menu"
1495 ;; ["this item won't appear because of the menu filter" ding t]
1500 ;; "--:singleDashedLine"
1501 ;; "singleDashedLine"
1502 ;; "--:doubleDashedLine"
1503 ;; "doubleDashedLine"
1506 ;; "--:shadowEtchedIn"
1508 ;; "--:shadowEtchedOut"
1509 ;; "shadowEtchedOut"
1510 ;; "--:shadowDoubleEtchedIn"
1511 ;; "shadowDoubleEtchedIn"
1512 ;; "--:shadowDoubleEtchedOut"
1513 ;; "shadowDoubleEtchedOut"
1514 ;; "--:shadowEtchedInDash"
1515 ;; "shadowEtchedInDash"
1516 ;; "--:shadowEtchedOutDash"
1517 ;; "shadowEtchedOutDash"
1518 ;; "--:shadowDoubleEtchedInDash"
1519 ;; "shadowDoubleEtchedInDash"
1520 ;; "--:shadowDoubleEtchedOutDash"
1521 ;; "shadowDoubleEtchedOutDash"
1524 (defun xemacs-splash-buffer ()
1525 "Redisplay XEmacs splash screen in a buffer."
1527 (let ((buffer (get-buffer-create "*Splash*"))
1530 (setq buffer-read-only t)
1531 (erase-buffer buffer)
1532 (setq tmout (display-splash-frame))
1534 (make-local-hook 'kill-buffer-hook)
1535 (add-hook 'kill-buffer-hook
1537 (disable-timeout ,tmout))
1539 (pop-to-buffer buffer)
1540 (delete-other-windows)))
1543 ;;; backwards compatibility
1544 (provide 'x-menubar)
1545 (provide 'menubar-items)
1547 ;;; x-menubar.el ends here.