Mercurial > hg > xemacs-beta

comparison lisp/x11/x-menubar.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 56c54cf7c5b6
children 54cc21c15cbb
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of 16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License for more details. 18 ;; General Public License for more details.
19 19
20 ;; You should have received a copy of the GNU General Public License 20 ;; You should have received a copy of the GNU General Public License
21 ;; along with Xmacs; see the file COPYING. If not, write to the Free 21 ;; along with Xmacs; see the file COPYING. If not, write to the
22 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 22 ;; Free Software Foundation, 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
23 24
24 ;;; Commentary: 25 ;;; Commentary:
25 26
26 ;;; Code: 27 ;;; Code:
28
29 ;;; Warning-free compile
30 (eval-when-compile
31 (defvar language-environment-list))
27 32
28 (defconst default-menubar 33 (defconst default-menubar
29 (purecopy-menubar 34 (purecopy-menubar
30 ;; note backquote. 35 ;; note backquote.
31 `( 36 `(
74 ["Search (Regexp)..." isearch-forward-regexp t] 79 ["Search (Regexp)..." isearch-forward-regexp t]
75 ["Search Backward (Regexp)..." isearch-backward-regexp t] 80 ["Search Backward (Regexp)..." isearch-backward-regexp t]
76 ["Replace (Regexp)..." query-replace-regexp t] 81 ["Replace (Regexp)..." query-replace-regexp t]
77 "----" 82 "----"
78 ("Bookmarks" 83 ("Bookmarks"
79 ["Jump to bookmark" bookmark-menu-jump t] 84 ["Jump to bookmark" bookmark-menu-jump t]
80 ["Set bookmark" bookmark-set t] 85 ["Set bookmark" bookmark-set t]
81 "---" 86 "---"
82 ["Insert contents" bookmark-menu-insert t] 87 ["Insert contents" bookmark-menu-insert t]
83 ["Insert location" bookmark-menu-locate t] 88 ["Insert location" bookmark-menu-locate t]
84 "---" 89 "---"
85 ["Rename bookmark" bookmark-menu-rename t] 90 ["Rename bookmark" bookmark-menu-rename t]
86 ["Delete bookmark" bookmark-menu-delete t] 91 ["Delete bookmark" bookmark-menu-delete t]
87 ["Edit Bookmark List" bookmark-bmenu-list t] 92 ["Edit Bookmark List" bookmark-bmenu-list t]
88 "---" 93 "---"
89 ["Save bookmarks" bookmark-save t] 94 ["Save bookmarks" bookmark-save t]
90 ["Save bookmarks as..." bookmark-write t] 95 ["Save bookmarks as..." bookmark-write t]
91 ["Load a bookmark file" bookmark-load t]) 96 ["Load a bookmark file" bookmark-load t])
92 "----" 97 "----"
93 ["Goto Line..." goto-line t] 98 ["Goto Line..." goto-line t]
94 ["What Line" what-line t] 99 ["What Line" what-line t]
95 "----" 100 "----"
96 ["Start Macro Recording" start-kbd-macro (not defining-kbd-macro)] 101 ["Start Macro Recording" start-kbd-macro (not defining-kbd-macro)]
125 ["Random Flames" flame t] 130 ["Random Flames" flame t]
126 ["Dunnet (Adventure)" dunnet t] 131 ["Dunnet (Adventure)" dunnet t]
127 ["Towers of Hanoi" hanoi t] 132 ["Towers of Hanoi" hanoi t]
128 ["Game of Life" life t] 133 ["Game of Life" life t]
129 ["Multiplication Puzzle" mpuz t] 134 ["Multiplication Puzzle" mpuz t]
130 ["Mine Game" mine t]
131 ) 135 )
132 ) 136 )
133 137
134 ("Options" 138 ("Options"
135 ,custom-help-menu
136 ["Read Only" (toggle-read-only) 139 ["Read Only" (toggle-read-only)
137 :style toggle :selected buffer-read-only] 140 :style toggle :selected buffer-read-only]
138 ("Editing Options" 141 ("Editing Options"
139 ["Overstrike" (progn 142 ["Overstrike" (progn
140 (overwrite-mode current-prefix-arg) 143 (overwrite-mode current-prefix-arg)
156 ["Active Regions" (setq zmacs-regions (not zmacs-regions)) 159 ["Active Regions" (setq zmacs-regions (not zmacs-regions))
157 :style toggle :selected zmacs-regions] 160 :style toggle :selected zmacs-regions]
158 ["Mouse Paste At Text Cursor" (setq mouse-yank-at-point 161 ["Mouse Paste At Text Cursor" (setq mouse-yank-at-point
159 (not mouse-yank-at-point)) 162 (not mouse-yank-at-point))
160 :style toggle :selected mouse-yank-at-point] 163 :style toggle :selected mouse-yank-at-point]
161 ["Require Newline At End" (setq require-final-newline
162 (or (eq require-final-newline 'ask)
163 (not require-final-newline)))
164 :style toggle :selected (eq require-final-newline 't)]
165 ["Add Newline When Moving Past End" (setq next-line-add-newlines
166 (not next-line-add-newlines))
167 :style toggle :selected next-line-add-newlines]
168 ) 164 )
169 ("General Options" 165 ("General Options"
170 ["Teach Extended Commands" (setq teach-extended-commands-p 166 ["Teach Extended Commands" (setq teach-extended-commands-p
171 (not teach-extended-commands-p)) 167 (not teach-extended-commands-p))
172 :style toggle :selected teach-extended-commands-p] 168 :style toggle :selected teach-extended-commands-p]
179 ["Command-Line Switches for `lpr'/`lp'..." 175 ["Command-Line Switches for `lpr'/`lp'..."
180 (setq lpr-switches 176 (setq lpr-switches
181 (read-expression "Switches for `lpr'/`lp': " 177 (read-expression "Switches for `lpr'/`lp': "
182 (format "%S" lpr-switches))) 178 (format "%S" lpr-switches)))
183 t] 179 t]
180 ["Pretty-Print With Color"
181 (setq ps-print-color-p (not ps-print-color-p))
182 :style toggle :selected ps-print-color-p]
184 ("Pretty-Print Paper Size" 183 ("Pretty-Print Paper Size"
185 ["Letter" 184 ["Letter"
186 (setq ps-paper-type 'letter) 185 (setq ps-paper-type 'ps-letter)
187 :style radio 186 :style radio
188 :selected (eq ps-paper-type 'letter)] 187 :selected (eq ps-paper-type 'ps-letter)]
189 ["Letter-small" 188 ["Legal"
190 (setq ps-paper-type 'letter-small) 189 (setq ps-paper-type 'ps-legal)
191 :style radio 190 :style radio
192 :selected (eq ps-paper-type 'letter-small)] 191 :selected (eq ps-paper-type 'ps-legal)]
193 ["Legal" 192 ["A4"
194 (setq ps-paper-type 'legal) 193 (setq ps-paper-type 'ps-a4)
195 :style radio 194 :style radio
196 :selected (eq ps-paper-type 'legal)] 195 :selected (eq ps-paper-type 'ps-a4)]
197 ["Statement"
198 (setq ps-paper-type 'statement)
199 :style radio
200 :selected (eq ps-paper-type 'statement)]
201 ["Executive"
202 (setq ps-paper-type 'executive)
203 :style radio
204 :selected (eq ps-paper-type 'executive)]
205 ["Tabloid"
206 (setq ps-paper-type 'tabloid)
207 :style radio
208 :selected (eq ps-paper-type 'tabloid)]
209 ["Ledger"
210 (setq ps-paper-type 'ledger)
211 :style radio
212 :selected (eq ps-paper-type 'ledger)]
213 ["A3"
214 (setq ps-paper-type 'a3)
215 :style radio
216 :selected (eq ps-paper-type 'a3)]
217 ["A4"
218 (setq ps-paper-type 'a4)
219 :style radio
220 :selected (eq ps-paper-type 'a4)]
221 ["A4small"
222 (setq ps-paper-type 'a4small)
223 :style radio
224 :selected (eq ps-paper-type 'a4small)]
225 ["B4"
226 (setq ps-paper-type 'b4)
227 :style radio
228 :selected (eq ps-paper-type 'b4)]
229 ["B5"
230 (setq ps-paper-type 'b5)
231 :style radio
232 :selected (eq ps-paper-type 'b5)]
233 ) 196 )
234 ["Enable Color Printing"
235 (progn
236 (set-face-background 'default "white")
237 (setq ps-print-color-p t))
238 t]
239 ) 197 )
240 ("\"Other Window\" Location" 198 ("\"Other Window\" Location"
241 ["Always in Same Frame" 199 ["Always in Same Frame"
242 (setq get-frame-for-buffer-default-instance-limit nil) 200 (setq get-frame-for-buffer-default-instance-limit nil)
243 :style radio 201 :style radio
270 'show-temp-buffer-in-current-frame)] 228 'show-temp-buffer-in-current-frame)]
271 ["Temp Buffers Like Other Buffers" 229 ["Temp Buffers Like Other Buffers"
272 (setq temp-buffer-show-function nil) 230 (setq temp-buffer-show-function nil)
273 :style radio 231 :style radio
274 :selected (null temp-buffer-show-function)] 232 :selected (null temp-buffer-show-function)]
275 "-----"
276 ["Make current frame gnuserv target"
277 (setq gnuserv-frame
278 (if (equal gnuserv-frame (selected-frame))
279 nil
280 (selected-frame)))
281 :style radio
282 :selected (equal gnuserv-frame (selected-frame))]
283 ) 233 )
284 234
285 "-----" 235 "-----"
286 ("Syntax Highlighting" 236 ("Syntax Highlighting"
287 ["In This Buffer" (font-lock-mode) 237 ["In This Buffer" (font-lock-mode)
364 (progn 314 (progn
365 (lazy-lock-mode 0) 315 (lazy-lock-mode 0)
366 ;; this shouldn't be necessary so there has to 316 ;; this shouldn't be necessary so there has to
367 ;; be a redisplay bug lurking somewhere (or 317 ;; be a redisplay bug lurking somewhere (or
368 ;; possibly another event handler bug) 318 ;; possibly another event handler bug)
369 (redraw-modeline) 319 (redraw-modeline))
370 (remove-hook 'font-lock-mode-hook
371 'turn-on-lazy-lock))
372 (if font-lock-mode 320 (if font-lock-mode
373 (progn 321 (progn
374 (lazy-lock-mode 1) 322 (lazy-lock-mode 1)
375 (redraw-modeline) 323 (redraw-modeline)))))
376 (add-hook 'font-lock-mode-hook
377 'turn-on-lazy-lock)))))
378 :active font-lock-mode 324 :active font-lock-mode
379 :style toggle 325 :style toggle
380 :selected (and (boundp 'lazy-lock-mode) lazy-lock-mode)] 326 :selected (and (boundp 'lazy-lock-mode) lazy-lock-mode)]
381 ["Caching" (progn (require 'fast-lock) 327 ["Caching" (progn (require 'fast-lock)
382 (if fast-lock-mode 328 (if fast-lock-mode
390 (progn 336 (progn
391 (fast-lock-mode 1) 337 (fast-lock-mode 1)
392 (redraw-modeline))))) 338 (redraw-modeline)))))
393 :active font-lock-mode 339 :active font-lock-mode
394 :style toggle 340 :style toggle
395 :selected (and (boundp 'fast-lock-mode) fast-lock-mode)] 341 :selected fast-lock-mode]
396 ) 342 )
397 ("Paren Highlighting" 343 ("Paren Highlighting"
398 ["None" (paren-set-mode -1) 344 ["None" (paren-set-mode -1)
399 :style radio :selected (not paren-mode)] 345 :style radio :selected (not paren-mode)]
400 ["Blinking Paren" (paren-set-mode 'blink-paren) 346 ["Blinking Paren" (paren-set-mode 'blink-paren)
437 (force-cursor-redisplay)) 383 (force-cursor-redisplay))
438 :style toggle :selected bar-cursor] 384 :style toggle :selected bar-cursor]
439 ["Blinking Cursor" (blink-cursor-mode) 385 ["Blinking Cursor" (blink-cursor-mode)
440 :style toggle 386 :style toggle
441 :selected (and (boundp 'blink-cursor-mode) blink-cursor-mode)] 387 :selected (and (boundp 'blink-cursor-mode) blink-cursor-mode)]
442 ["Frame-Local Font Menu" (setq font-menu-this-frame-only-p
443 (not font-menu-this-frame-only-p))
444 :style toggle :selected font-menu-this-frame-only-p]
445 ; ["Line Numbers" (line-number-mode nil) 388 ; ["Line Numbers" (line-number-mode nil)
446 ; :style toggle :selected line-number-mode] 389 ; :style toggle :selected line-number-mode]
447 ) 390 )
448 ("Menubar Appearance" 391 ("Menubar Appearance"
449 ["Buffers Menu Length..." 392 ["Buffers Menu Length..."
486 (not buffers-menu-submenus-for-groups-p)) 429 (not buffers-menu-submenus-for-groups-p))
487 :style toggle 430 :style toggle
488 :selected buffers-menu-submenus-for-groups-p 431 :selected buffers-menu-submenus-for-groups-p
489 :active (not (null buffers-menu-grouping-function))] 432 :active (not (null buffers-menu-grouping-function))]
490 "---" 433 "---"
434 ["Frame-Local Font Menu" (setq font-menu-this-frame-only-p
435 (not font-menu-this-frame-only-p))
436 :style toggle :selected font-menu-this-frame-only-p]
491 ["Ignore Scaled Fonts" (setq font-menu-ignore-scaled-fonts 437 ["Ignore Scaled Fonts" (setq font-menu-ignore-scaled-fonts
492 (not font-menu-ignore-scaled-fonts)) 438 (not font-menu-ignore-scaled-fonts))
493 :style toggle :selected font-menu-ignore-scaled-fonts] 439 :style toggle :selected font-menu-ignore-scaled-fonts]
494 ) 440 )
495 ,@(if (featurep 'toolbar) 441 ,@(if (featurep 'toolbar)
514 :style radio :selected (eq (default-toolbar-position) 'left)] 460 :style radio :selected (eq (default-toolbar-position) 'left)]
515 ["Right" (set-default-toolbar-position 'right) 461 ["Right" (set-default-toolbar-position 'right)
516 :style radio :selected (eq (default-toolbar-position) 'right)] 462 :style radio :selected (eq (default-toolbar-position) 'right)]
517 ) 463 )
518 ))) 464 )))
519 ("Mouse"
520 ["Avoid-Text"
521 (if (equal (device-type) 'x)
522 (if mouse-avoidance-mode
523 (mouse-avoidance-mode 'none)
524 (mouse-avoidance-mode 'banish))
525 (beep)
526 (message "This option requires a window system."))
527 :style toggle :selected (and mouse-avoidance-mode window-system)])
528 ("Open URLs With" 465 ("Open URLs With"
529 ["Emacs-W3" (setq browse-url-browser-function 'browse-url-w3) 466 ["Emacs-W3" (setq browse-url-browser-function 'browse-url-w3)
530 :style radio 467 :style radio
531 :selected (eq browse-url-browser-function 'browse-url-w3)] 468 :selected (eq browse-url-browser-function 'browse-url-w3)]
532 ["Netscape" (setq browse-url-browser-function 'browse-url-netscape) 469 ["Netscape" (setq browse-url-browser-function 'browse-url-netscape)
550 ["Grail" (setq browse-url-browser-function 'browse-url-grail) 487 ["Grail" (setq browse-url-browser-function 'browse-url-grail)
551 :style radio 488 :style radio
552 :selected (eq browse-url-browser-function 'browse-url-grail)] 489 :selected (eq browse-url-browser-function 'browse-url-grail)]
553 ) 490 )
554 "-----" 491 "-----"
555 ["Browse Faces..." edit-faces t] 492 ["Edit Faces..." edit-faces t]
556 ("Font" :filter font-menu-family-constructor) 493 ("Font" :filter font-menu-family-constructor)
557 ("Size" :filter font-menu-size-constructor) 494 ("Size" :filter font-menu-size-constructor)
558 ("Weight" :filter font-menu-weight-constructor) 495 ("Weight" :filter font-menu-weight-constructor)
496 ,@(if (featurep 'mule)
497 '("-----"
498 ("Language Environment"
499 :filter language-environment-menu-filter)))
559 "-----" 500 "-----"
560 ["Save Options" save-options-menu-settings t] 501 ["Save Options" save-options-menu-settings t]
561 ) 502 )
562 503
563 ("Buffers" 504 ("Buffers"
569 ("Tools" 510 ("Tools"
570 ["Grep..." grep t] 511 ["Grep..." grep t]
571 ["Compile..." compile t] 512 ["Compile..." compile t]
572 ["Shell" shell t] 513 ["Shell" shell t]
573 ["Shell Command..." shell-command t] 514 ["Shell Command..." shell-command t]
574 ["Shell Command on Region..." 515 ["Shell Command on Region..." shell-command-on-region (region-exists-p)]
575 shell-command-on-region (region-exists-p)]
576 ["Debug (GDB)..." gdb t] 516 ["Debug (GDB)..." gdb t]
577 ["Debug (DBX)..." dbx t] 517 ["Debug (DBX)..." dbx t]
578 "-----" 518 "-----"
579 ["OO-Browser..." oobr t] 519 ["OO-Browser..." oobr t]
580 ("Tags" 520 ("Tags"
581 ["Find..." find-tag t] 521 ["Find Tag..." find-tag t]
582 ["Find Other Window..." find-tag-other-window t] 522 ["Find Other Window..." find-tag-other-window t]
523 ["Next Tag..." (find-tag nil) t]
524 ["Next Other Window..." (find-tag-other-window nil) t]
525 ["Next File" next-file t]
526 "-----"
583 ["Tags Search..." tags-search t] 527 ["Tags Search..." tags-search t]
584 ["Tags Replace..." tags-query-replace t] 528 ["Tags Replace..." tags-query-replace t]
529 ["Continue Search/Replace" tags-loop-continue t]
585 "-----" 530 "-----"
586 ["Continue Search/Replace" tags-loop-continue t]
587 ["Pop stack" pop-tag-mark t] 531 ["Pop stack" pop-tag-mark t]
588 ["Apropos..." tags-apropos t])) 532 ["Apropos..." tags-apropos t]
533 "-----"
534 ["Set Tags Table File..." visit-tags-table t]
535 ))
589 536
590 nil ; the partition: menus after this are flushright 537 nil ; the partition: menus after this are flushright
591 538
592 ("Help" 539 ("Help"
593 ["About XEmacs..." about-xemacs t] 540 ["About XEmacs..." about-xemacs t]
594 ("Basics" 541 "-----"
595 ["Tutorial" help-with-tutorial t] 542 ["XEmacs WWW Page" xemacs-www-page t]
596 ["News" view-emacs-news t] 543 ["Newest XEmacs FAQ via WWW" xemacs-www-faq t]
597 ["Packages" finder-by-keyword t] 544 ["XEmacs FAQ (local)" xemacs-local-faq t]
598 ["Splash" xemacs-splash-buffer t]) 545 ["XEmacs Tutorial" help-with-tutorial t]
599 "-----" 546 ["XEmacs News" view-emacs-news t]
600 ("XEmacs FAQ" 547 ["Sample"
601 ["FAQ (local)" xemacs-local-faq t] 548 (find-file (expand-file-name "sample.emacs" data-directory))
602 ["FAQ via WWW" xemacs-www-faq t] 549 t ".emacs"]
603 ["Home Page" xemacs-www-page t]) 550 ["Sample"
604 ("Samples" 551 (find-file (expand-file-name "sample.Xdefaults" data-directory))
605 ["Sample .emacs" (find-file 552 t ".Xdefaults"]
606 (expand-file-name "sample.emacs" 553 "-----"
607 data-directory)) 554 ["Info (Detailed Docs)" info t]
608 t]
609 ["Sample .Xdefaults" (find-file
610 (expand-file-name "sample.Xdefaults"
611 data-directory))
612 t]
613 ["Sample enriched" (find-file
614 (expand-file-name "enriched.doc"
615 data-directory))
616 t])
617 "-----"
618 ("Lookup in Info" 555 ("Lookup in Info"
619 ["Key Binding..." Info-goto-emacs-key-command-node t] 556 ["Key/Mouse Binding..." Info-goto-emacs-key-command-node t]
620 ["Command..." Info-goto-emacs-command-node t] 557 ["Command..." Info-goto-emacs-command-node t]
621 ["Function..." Info-elisp-ref t] 558 ["Elisp Function..." Info-elisp-ref t]
622 ["Topic..." Info-query t]) 559 ["Topic..." Info-query t])
623 ("Manuals" 560 ["Package Browser" finder-by-keyword t]
624 ["Info" info t] 561 ["Describe Mode" describe-mode t]
625 ["Unix Manual..." manual-entry t]) 562 ["Apropos..." hyper-apropos t]
626 ("Commands & Keys" 563 ["Apropos Documentation..." apropos-documentation t]
627 ["Mode" describe-mode t] 564 "-----"
628 ["Apropos..." hyper-apropos t] 565 ["Recent Keystrokes/Messages" view-lossage t]
629 ["Apropos Docs..." apropos-documentation t] 566 ["Describe Key/Mouse..." describe-key t]
630 "-----" 567 ["List Key Bindings" describe-bindings t]
631 ["Key..." describe-key t] 568 ["List Mouse Bindings" describe-pointer t]
632 ["Bindings" describe-bindings t] 569 "-----"
633 ["Mouse Bindings" describe-pointer t] 570 ["Describe Function..." describe-function t]
634 ["Recent Keys" view-lossage t] 571 ["Describe Variable..." describe-variable t]
635 "-----" 572 ["Where Is Command..." where-is t]
636 ["Function..." describe-function t] 573 "-----"
637 ["Variable..." describe-variable t] 574 ["Unix Manual..." manual-entry t]
638 ["Locate Command..." where-is t])
639 "-----"
640 ["Recent Messages" view-lossage t]
641 ("Misc" 575 ("Misc"
642 ["No Warranty" describe-no-warranty t] 576 ["Describe No Warranty" describe-no-warranty t]
643 ["XEmacs License" describe-copying t] 577 ["Describe XEmacs License" describe-copying t]
644 ["The Latest Version" describe-distribution t]) 578 ["Getting the Latest Version" describe-distribution t])
645 ) 579 )
646 ))) 580 )))
647 581
648 582
649 (defun maybe-add-init-button () 583 (defun maybe-add-init-button ()
792 of each buffer line. If this is false, then there will be only one command: 726 of each buffer line. If this is false, then there will be only one command:
793 select that buffer.") 727 select that buffer.")
794 728
795 (defvar buffers-menu-submenus-for-groups-p nil 729 (defvar buffers-menu-submenus-for-groups-p nil
796 "*If true, the buffers menu will contain one submenu per group of buffers, 730 "*If true, the buffers menu will contain one submenu per group of buffers,
797 if a grouping function is specified in `buffers-menu-grouping-function'. 731 if a grouping function is specified in `buffers-menu-grouping-function'.")
798 If this is an integer, do not build submenus if the number of buffers
799 is not larger than this value.")
800 732
801 (defvar buffers-menu-switch-to-buffer-function 'switch-to-buffer 733 (defvar buffers-menu-switch-to-buffer-function 'switch-to-buffer
802 "*The function to call to select a buffer from the buffers menu. 734 "*The function to call to select a buffer from the buffers menu.
803 `switch-to-buffer' is a good choice, as is `pop-to-buffer'.") 735 `switch-to-buffer' is a good choice, as is `pop-to-buffer'.")
804 736
914 (buffer-name (current-buffer))))))) 846 (buffer-name (current-buffer)))))))
915 847
916 (defsubst build-buffers-menu-internal (buffers) 848 (defsubst build-buffers-menu-internal (buffers)
917 (let (name line) 849 (let (name line)
918 (mapcar 850 (mapcar
919 #'(lambda (buffer) 851 (lambda (buffer)
920 (if (eq buffer t) 852 (if (eq buffer t)
921 "---" 853 "---"
922 (setq line (funcall buffers-menu-format-buffer-line-function 854 (setq line (funcall buffers-menu-format-buffer-line-function
923 buffer)) 855 buffer))
924 (if complex-buffers-menu-p 856 (if complex-buffers-menu-p
925 (delq nil 857 (delq nil
926 (list line 858 (list line
927 (vector "Switch to Buffer" 859 (vector "Switch to Buffer"
928 (list buffers-menu-switch-to-buffer-function 860 (list buffers-menu-switch-to-buffer-function
929 (setq name (buffer-name buffer))) 861 (setq name (buffer-name buffer)))
930 t) 862 t)
931 (if (eq buffers-menu-switch-to-buffer-function 863 (if (eq buffers-menu-switch-to-buffer-function
932 'switch-to-buffer) 864 'switch-to-buffer)
933 (vector "Switch to Buffer, Other Frame" 865 (vector "Switch to Buffer, Other Frame"
934 (list 'switch-to-buffer-other-frame 866 (list 'switch-to-buffer-other-frame
935 (setq name (buffer-name buffer))) 867 (setq name (buffer-name buffer)))
936 t) 868 t)
937 nil) 869 nil)
938 (if (and (buffer-modified-p buffer) 870 (if (and (buffer-modified-p buffer)
939 (buffer-file-name buffer)) 871 (buffer-file-name buffer))
940 (vector "Save Buffer" 872 (vector "Save Buffer"
941 (list 'buffer-menu-save-buffer name) t) 873 (list 'buffer-menu-save-buffer name) t)
942 ["Save Buffer" nil nil] 874 ["Save Buffer" nil nil]
943 ) 875 )
944 (vector "Save As..." 876 (vector "Save As..."
945 (list 'buffer-menu-write-file name) t) 877 (list 'buffer-menu-write-file name) t)
946 (vector "Delete Buffer" (list 'kill-buffer name) 878 (vector "Delete Buffer" (list 'kill-buffer name)
947 t))) 879 t)))
948 (vector line 880 ;; ### We don't want buffer names to be translated,
949 (list buffers-menu-switch-to-buffer-function 881 ;; ### so we put the buffer name in the suffix.
950 (buffer-name buffer)) 882 ;; ### Also, avoid losing with non-ASCII buffer names.
951 t)))) 883 ;; ### We still lose, however, if complex-buffers-menu-p. --mrb
884 (vector ""
885 (list buffers-menu-switch-to-buffer-function
886 (buffer-name buffer))
887 t line))))
952 buffers))) 888 buffers)))
953 889
954 (defun buffers-menu-filter (menu) 890 (defun buffers-menu-filter (menu)
955 "This is the menu filter for the top-level buffers \"Buffers\" menu. 891 "This is the menu filter for the top-level buffers \"Buffers\" menu.
956 It dynamically creates a list of buffers to use as the contents of the menu. 892 It dynamically creates a list of buffers to use as the contents of the menu.
960 items by redefining the function `format-buffers-menu-line'." 896 items by redefining the function `format-buffers-menu-line'."
961 (let ((buffers (delete-if buffers-menu-omit-function (buffer-list)))) 897 (let ((buffers (delete-if buffers-menu-omit-function (buffer-list))))
962 (and (integerp buffers-menu-max-size) 898 (and (integerp buffers-menu-max-size)
963 (> buffers-menu-max-size 1) 899 (> buffers-menu-max-size 1)
964 (> (length buffers) buffers-menu-max-size) 900 (> (length buffers) buffers-menu-max-size)
965 ;; shorten list of buffers (not with submenus!) 901 ;; shorten list of buffers
966 (not (and buffers-menu-grouping-function
967 buffers-menu-submenus-for-groups-p))
968 (setcdr (nthcdr buffers-menu-max-size buffers) nil)) 902 (setcdr (nthcdr buffers-menu-max-size buffers) nil))
969 (if buffers-menu-sort-function 903 (if buffers-menu-sort-function
970 (setq buffers (sort buffers buffers-menu-sort-function))) 904 (setq buffers (sort buffers buffers-menu-sort-function)))
971 (if (and buffers-menu-grouping-function 905 (if (and buffers-menu-grouping-function
972 buffers-menu-submenus-for-groups-p 906 buffers-menu-submenus-for-groups-p)
973 (or (not (integerp buffers-menu-submenus-for-groups-p))
974 (> (length buffers) buffers-menu-submenus-for-groups-p)))
975 (let (groups groupnames current-group) 907 (let (groups groupnames current-group)
976 (mapl 908 (mapl
977 #'(lambda (sublist) 909 #'(lambda (sublist)
978 (let ((groupname (funcall buffers-menu-grouping-function 910 (let ((groupname (funcall buffers-menu-grouping-function
979 (car sublist) (cadr sublist)))) 911 (car sublist) (cadr sublist))))
1008 (setcdr lastcdr nil)))))) 940 (setcdr lastcdr nil))))))
1009 (setq buffers (build-buffers-menu-internal buffers))) 941 (setq buffers (build-buffers-menu-internal buffers)))
1010 (append menu buffers) 942 (append menu buffers)
1011 )) 943 ))
1012 944
945 (defun language-environment-menu-filter (menu)
946 "This is the menu filter for the \"Language Environment\" submenu."
947 (mapcar (lambda (env-sym)
948 `[ ,(capitalize (symbol-name env-sym))
949 (set-language-environment ',env-sym) t])
950 language-environment-list))
1013 951
1014 952
1015 ;;; The Options menu 953 ;;; The Options menu
1016
1017 (defvar options-save-faces nil
1018 "if t, save-options will save all the face information.
1019 Set to nil to avoid this. This is recommended on XEmacs 19.15
1020 and above as we have a much more powerful (read: working) way
1021 of changing and saving faces via cu-edit-faces.el & custom.el.")
1022 954
1023 (defconst options-menu-saved-forms 955 (defconst options-menu-saved-forms
1024 ;; This is really quite a kludge, but it gets the job done. 956 ;; This is really quite a kludge, but it gets the job done.
1025 ;; 957 ;;
1026 ;; remember that we have to conditionalize on default features 958 ;; remember that we have to conditionalize on default features
1042 '(progn 974 '(progn
1043 (require 'pending-del) 975 (require 'pending-del)
1044 (pending-delete-on nil))) 976 (pending-delete-on nil)))
1045 zmacs-regions 977 zmacs-regions
1046 mouse-yank-at-point 978 mouse-yank-at-point
1047 require-final-newline
1048 next-line-add-newlines
1049 979
1050 ;; General Options menu. 980 ;; General Options menu.
1051 teach-extended-commands-p 981 teach-extended-commands-p
1052 ;; (#### not actually on Options menu) 982 ;; (#### not actually on Options menu)
1053 teach-extended-commands-timeout 983 teach-extended-commands-timeout
1060 ps-paper-type 990 ps-paper-type
1061 991
1062 ;; Other Window Location 992 ;; Other Window Location
1063 get-frame-for-buffer-default-instance-limit 993 get-frame-for-buffer-default-instance-limit
1064 temp-buffer-show-function 994 temp-buffer-show-function
1065 (if gnuserv-frame
1066 '(setq gnuserv-frame (selected-frame)))
1067 995
1068 ;; Syntax Highlighting 996 ;; Syntax Highlighting
1069 font-lock-auto-fontify 997 font-lock-auto-fontify
1070 font-lock-use-fonts 998 font-lock-use-fonts
1071 font-lock-use-colors 999 font-lock-use-colors
1133 (add-spec-list-to-specifier 1061 (add-spec-list-to-specifier
1134 toolbar-buttons-captioned-p 1062 toolbar-buttons-captioned-p
1135 ',(specifier-spec-list toolbar-buttons-captioned-p 1063 ',(specifier-spec-list toolbar-buttons-captioned-p
1136 'global))))) 1064 'global)))))
1137 1065
1138 ;; mouse
1139 mouse-avoidance-mode
1140
1141 ;; Open URLs With 1066 ;; Open URLs With
1142 browse-url-browser-function 1067 browse-url-browser-function
1143 1068
1144 ;; Now save all faces. 1069 ;; Now save all faces.
1145 1070
1146 ;; Setting this in lisp conflicts with X resources. Bad move. --Stig 1071 ;; Setting this in lisp conflicts with X resources. Bad move. --Stig
1147 ;; (list 'set-face-font ''default (face-font-name 'default)) 1072 ;; (list 'set-face-font ''default (face-font-name 'default))
1148 ;; (list 'set-face-font ''modeline (face-font-name 'modeline)) 1073 ;; (list 'set-face-font ''modeline (face-font-name 'modeline))
1149 (if options-save-faces 1074
1150 (cons 'progn 1075 (cons 'progn
1151 (mapcar #'(lambda (face) 1076 (mapcar #'(lambda (face)
1152 `(make-face ',face)) 1077 `(make-face ',face))
1153 (save-options-non-customized-face-list)))) 1078 (face-list)))
1154 1079
1155 (if options-save-faces 1080 (cons 'progn
1156 (cons 'progn 1081 (apply 'nconc
1157 (apply 'nconc 1082 (mapcar
1158 (mapcar 1083 #'(lambda (face)
1159 #'(lambda (face) 1084 (delq nil
1160 (delq nil 1085 (mapcar
1161 (mapcar 1086 #'(lambda (property)
1162 #'(lambda (property) 1087 (if (specifier-spec-list
1163 (if (specifier-spec-list 1088 (face-property face property))
1164 (face-property face property)) 1089 `(add-spec-list-to-specifier
1165 `(add-spec-list-to-specifier 1090 (face-property ',face ',property)
1166 (face-property ',face ',property) 1091 ',(save-options-specifier-spec-list
1167 ',(save-options-specifier-spec-list 1092 face property))))
1168 face property)))) 1093 built-in-face-specifiers)))
1169 (delq 'display-table 1094 (face-list))))
1170 (copy-sequence 1095
1171 built-in-face-specifiers))))) 1096 ;; Mule-specific:
1172 (save-options-non-customized-face-list))))) 1097 (if (featurep 'mule)
1173 1098 `(if (featurep 'mule)
1099 (set-language-environment ',(current-language-environment))))
1174 )) 1100 ))
1175 "The variables to save; or forms to evaluate to get forms to write out. 1101 "The variables to save; or forms to evaluate to get forms to write out.
1176 This is used by `save-options-menu-settings' and should mirror the 1102 This is used by `save-options-menu-settings' and should mirror the
1177 options listed in the Options menu.") 1103 options listed in the Options menu.")
1178
1179 (defun save-options-non-customized-face-list ()
1180 "This function will return a list of all faces that have not been
1181 'customized'."
1182 (delq nil (mapcar '(lambda (face)
1183 (unless (get face 'saved-face)
1184 face))
1185 (face-list))))
1186 1104
1187 (defun save-options-specifier-spec-list (face property) 1105 (defun save-options-specifier-spec-list (face property)
1188 (if (not (or (eq property 'font) (eq property 'color))) 1106 (if (not (or (eq property 'font) (eq property 'color)))
1189 (specifier-spec-list (face-property face property) 'global) 1107 (specifier-spec-list (face-property face property) 'global)
1190 (let* ((retlist (specifier-spec-list (face-property face property) 1108 (let* ((retlist (specifier-spec-list (face-property face property)
1378 (interactive "@_") 1296 (interactive "@_")
1379 (run-hooks 'activate-popup-menu-hook) 1297 (run-hooks 'activate-popup-menu-hook)
1380 (popup-menu 1298 (popup-menu
1381 (cond ((and global-popup-menu mode-popup-menu) 1299 (cond ((and global-popup-menu mode-popup-menu)
1382 (check-menu-syntax mode-popup-menu) 1300 (check-menu-syntax mode-popup-menu)
1383 (let* ((title (car mode-popup-menu)) 1301 (let ((title (car mode-popup-menu))
1384 (items (cdr mode-popup-menu)) 1302 (items (cdr mode-popup-menu)))
1385 filters) 1303 (append global-popup-menu
1386 ;; Strip keywords from local menu for attaching them at the top
1387 (while (and items
1388 (symbolp (car items)))
1389 (setq items (append filters (list (car items))))
1390 (setq items (cdr items)))
1391 ;; If filters contains a keyword already present in
1392 ;; `global-popup-menu' you will probably lose.
1393 (append (list (car global-popup-menu))
1394 filters
1395 (cdr global-popup-menu)
1396 '("---" "---") 1304 '("---" "---")
1397 (if popup-menu-titles (list title)) 1305 (if popup-menu-titles (list title))
1398 (if popup-menu-titles '("---" "---")) 1306 (if popup-menu-titles '("---" "---"))
1399 items))) 1307 items)))
1400 (t 1308 (t
1473 ; "shadowDoubleEtchedInDash" 1381 ; "shadowDoubleEtchedInDash"
1474 ; "--:shadowDoubleEtchedOutDash" 1382 ; "--:shadowDoubleEtchedOutDash"
1475 ; "shadowDoubleEtchedOutDash" 1383 ; "shadowDoubleEtchedOutDash"
1476 ; )) 1384 ; ))
1477 1385
1478 (defun xemacs-splash-buffer ()
1479 "Redisplay XEmacs splash screen in a buffer."
1480 (interactive)
1481 (let ((buffer (get-buffer-create "*Splash*")))
1482 (set-buffer buffer)
1483 (erase-buffer buffer)
1484 (startup-splash-frame)
1485 (pop-to-buffer buffer)
1486 (delete-other-windows)))
1487 1386
1488 (provide 'x-menubar) 1387 (provide 'x-menubar)
1489 1388
1490 ;;; x-menubar.el ends here. 1389 ;;; x-menubar.el ends here.