Mercurial > hg > xemacs-beta

comparison lisp/x-menubar.el @ 272:c5d627a313b1 r21-0b34

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b34
author cvs
date Mon, 13 Aug 2007 10:28:48 +0200
parents 8efd647ea9ca
children 90d73dddcdc4
comparison
equal deleted inserted replaced
271:c7b7086b0a39 272:c5d627a313b1
20 ;; WITHOUT ANY WARRANTY; without even the implied warranty of 20 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
22 ;; General Public License for more details. 22 ;; General Public License for more details.
23 23
24 ;; You should have received a copy of the GNU General Public License 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 25 ;; along with Xmacs; see the file COPYING. If not, write to the
26 ;; Free Software Foundation, 59 Temple Place - Suite 330, 26 ;; Free Software Foundation, 59 Temple Place - Suite 330,
27 ;; Boston, MA 02111-1307, USA. 27 ;; Boston, MA 02111-1307, USA.
28 28
29 ;;; Commentary: 29 ;;; Commentary:
30 30
84 :active t 84 :active t
85 :suffix (if put-buffer-names-in-file-menu (buffer-name) "")] 85 :suffix (if put-buffer-names-in-file-menu (buffer-name) "")]
86 "-----" 86 "-----"
87 ["Exit XEmacs" save-buffers-kill-emacs] 87 ["Exit XEmacs" save-buffers-kill-emacs]
88 ) 88 )
89 89
90 ("Edit" 90 ("Edit"
91 ["Undo" advertised-undo 91 ["Undo" advertised-undo
92 :active (and (not (eq buffer-undo-list t)) 92 :active (and (not (eq buffer-undo-list t))
93 (or buffer-undo-list pending-undo-list)) 93 (or buffer-undo-list pending-undo-list))
94 :suffix (if (or (eq last-command 'undo) 94 :suffix (if (or (eq last-command 'undo)
138 ["Execute Last Macro" call-last-kbd-macro 138 ["Execute Last Macro" call-last-kbd-macro
139 :active last-kbd-macro] 139 :active last-kbd-macro]
140 "----" 140 "----"
141 ["Show Message Log" show-message-log] 141 ["Show Message Log" show-message-log]
142 ) 142 )
143 143
144 ,@(if (featurep 'mule) 144 ,@(if (featurep 'mule)
145 '(("Mule" 145 '(("Mule"
146 ("Describe language support") 146 ("Describe language support")
147 ("Set language environment") 147 ("Set language environment")
148 "--" 148 "--"
166 "--" 166 "--"
167 ["Show character table" view-charset-by-menu] 167 ["Show character table" view-charset-by-menu]
168 ;; not implemented yet 168 ;; not implemented yet
169 ["Show diagnosis for MULE" mule-diag :active nil] 169 ["Show diagnosis for MULE" mule-diag :active nil]
170 ["Show many languages" view-hello-file]))) 170 ["Show many languages" view-hello-file])))
171 171
172 ("Apps" 172 ("Apps"
173 ["Read Mail (VM)..." vm 173 ["Read Mail (VM)..." vm
174 :active (fboundp 'vm)] 174 :active (fboundp 'vm)]
175 ["Read Mail (MH)..." (mh-rmail t) 175 ["Read Mail (MH)..." (mh-rmail t)
176 :active (fboundp 'mh-rmail)] 176 :active (fboundp 'mh-rmail)]
198 ;; we're all pagans at heart ... 198 ;; we're all pagans at heart ...
199 ["Phases of the Moon" phases-of-moon 199 ["Phases of the Moon" phases-of-moon
200 :active (fboundp 'phases-of-moon)] 200 :active (fboundp 'phases-of-moon)]
201 ["Sunrise/Sunset" sunrise-sunset 201 ["Sunrise/Sunset" sunrise-sunset
202 :active (fboundp 'sunrise-sunset)]) 202 :active (fboundp 'sunrise-sunset)])
203 203
204 ("Games" 204 ("Games"
205 ["Mine Game" xmine 205 ["Mine Game" xmine
206 :active (fboundp 'xmine)] 206 :active (fboundp 'xmine)]
207 ["Tetris" tetris 207 ["Tetris" tetris
208 :active (fboundp 'tetris)] 208 :active (fboundp 'tetris)]
416 :selected (and (boundp 'gnuserv-frame) 416 :selected (and (boundp 'gnuserv-frame)
417 (equal gnuserv-frame (selected-frame)))] 417 (equal gnuserv-frame (selected-frame)))]
418 ) 418 )
419 419
420 "-----" 420 "-----"
421 ("Syntax Highlighting" 421 ("Syntax Highlighting"
422 ["In This Buffer" (font-lock-mode) 422 ["In This Buffer" (font-lock-mode)
423 :style toggle :selected (and (boundp 'font-lock-mode) font-lock-mode) 423 :style toggle :selected (and (boundp 'font-lock-mode) font-lock-mode)
424 :active (fboundp 'font-lock-mode)] 424 :active (fboundp 'font-lock-mode)]
425 ["Automatic" (if (not (featurep 'font-lock)) 425 ["Automatic" (if (not (featurep 'font-lock))
426 (progn 426 (progn
442 font-lock-mode 442 font-lock-mode
443 font-lock-use-fonts) 443 font-lock-use-fonts)
444 :active (fboundp 'font-lock-mode)] 444 :active (fboundp 'font-lock-mode)]
445 ["Colors" (progn (require 'font-lock) 445 ["Colors" (progn (require 'font-lock)
446 (font-lock-use-default-colors) 446 (font-lock-use-default-colors)
447 (setq font-lock-use-colors t 447 (setq font-lock-use-colors t
448 font-lock-use-fonts nil) 448 font-lock-use-fonts nil)
449 (font-lock-mode 1)) 449 (font-lock-mode 1))
450 :style radio 450 :style radio
451 :selected (and (boundp 'font-lock-mode) 451 :selected (and (boundp 'font-lock-mode)
452 font-lock-mode 452 font-lock-mode
741 ("Size" :filter font-menu-size-constructor) 741 ("Size" :filter font-menu-size-constructor)
742 ("Weight" :filter font-menu-weight-constructor) 742 ("Weight" :filter font-menu-weight-constructor)
743 "-----" 743 "-----"
744 ["Save Options" save-options-menu-settings] 744 ["Save Options" save-options-menu-settings]
745 ) 745 )
746 746
747 ("Buffers" 747 ("Buffers"
748 :filter buffers-menu-filter 748 :filter buffers-menu-filter
749 ["List All Buffers" list-buffers] 749 ["List All Buffers" list-buffers]
750 "--" 750 "--"
751 ) 751 )
752 752
753 ("Tools" 753 ("Tools"
754 ["Grep..." grep 754 ["Grep..." grep
755 :active (fboundp 'grep)] 755 :active (fboundp 'grep)]
756 ["Compile..." compile 756 ["Compile..." compile
757 :active (fboundp 'compile)] 757 :active (fboundp 'compile)]
796 (let ((lang language-info-alist) 796 (let ((lang language-info-alist)
797 submenu tut) 797 submenu tut)
798 (while lang 798 (while lang
799 (and (setq tut (assq 'tutorial (car lang))) 799 (and (setq tut (assq 'tutorial (car lang)))
800 (not (string= (caar lang) "ASCII")) 800 (not (string= (caar lang) "ASCII"))
801 (setq 801 (setq
802 submenu 802 submenu
803 (cons 803 (cons
804 `[,(caar lang) (help-with-tutorial nil ,(cdr tut))] 804 `[,(caar lang) (help-with-tutorial nil ,(cdr tut))]
805 submenu))) 805 submenu)))
806 (setq lang (cdr lang))) 806 (setq lang (cdr lang)))
807 (append `("Tutorials" 807 (append `("Tutorials"
808 :filter tutorials-menu-filter 808 :filter tutorials-menu-filter
809 ["Default" help-with-tutorial t 809 ["Default" help-with-tutorial t
810 ,(concat "(" current-language-environment ")")]) 810 ,(concat "(" current-language-environment ")")])
811 submenu)) 811 submenu))
812 ;; Non mule tutorials. 812 ;; Non mule tutorials.
813 (let ((lang tutorial-supported-languages) 813 (let ((lang tutorial-supported-languages)
814 submenu) 814 submenu)
815 (while lang 815 (while lang
816 (setq submenu 816 (setq submenu
817 (cons 817 (cons
818 `[,(caar lang) 818 `[,(caar lang)
819 (help-with-tutorial ,(format "TUTORIAL.%s" 819 (help-with-tutorial ,(format "TUTORIAL.%s"
820 (cadr (car lang))))] 820 (cadr (car lang))))]
821 submenu)) 821 submenu))
822 (setq lang (cdr lang))) 822 (setq lang (cdr lang)))
823 (append '("Tutorials" 823 (append '("Tutorials"
873 "Don't call this. 873 "Don't call this.
874 Adds `Load .emacs' button to menubar when starting up with -q." 874 Adds `Load .emacs' button to menubar when starting up with -q."
875 ;; by Stig@hackvan.com 875 ;; by Stig@hackvan.com
876 (cond 876 (cond
877 (init-file-user nil) 877 (init-file-user nil)
878 ((file-exists-p (cond 878 ((file-exists-p (cond
879 ((eq system-type 'ms-dos) 879 ((eq system-type 'ms-dos)
880 (concat "~" (user-login-name) "/_emacs")) 880 (concat "~" (user-login-name) "/_emacs"))
881 ((eq system-type 'vax-vms) 881 ((eq system-type 'vax-vms)
882 "sys$login:.emacs") 882 "sys$login:.emacs")
883 (t 883 (t
884 (concat "~" (user-login-name) "/.emacs")))) 884 (concat "~" (user-login-name) "/.emacs"))))
885 (add-menu-button nil 885 (add-menu-button nil
886 ["Load .emacs" 886 ["Load .emacs"
887 (progn (delete-menu-item '("Load .emacs")) 887 (progn (delete-menu-item '("Load .emacs"))
888 (load-user-init-file (user-login-name))) 888 (load-user-init-file (user-login-name)))
1339 ;; Open URLs With 1339 ;; Open URLs With
1340 browse-url-browser-function 1340 browse-url-browser-function
1341 1341
1342 ;; Now save all faces. 1342 ;; Now save all faces.
1343 1343
1344 ;; Setting this in lisp conflicts with X resources. Bad move. --Stig 1344 ;; Setting this in lisp conflicts with X resources. Bad move. --Stig
1345 ;; (list 'set-face-font ''default (face-font-name 'default)) 1345 ;; (list 'set-face-font ''default (face-font-name 'default))
1346 ;; (list 'set-face-font ''modeline (face-font-name 'modeline)) 1346 ;; (list 'set-face-font ''modeline (face-font-name 'modeline))
1347 (if options-save-faces 1347 (if options-save-faces
1348 (cons 'progn 1348 (cons 'progn
1349 (mapcar #'(lambda (face) 1349 (mapcar #'(lambda (face)
1377 "The variables to save; or forms to evaluate to get forms to write out. 1377 "The variables to save; or forms to evaluate to get forms to write out.
1378 This is used by `save-options-menu-settings' and should mirror the 1378 This is used by `save-options-menu-settings' and should mirror the
1379 options listed in the Options menu.") 1379 options listed in the Options menu.")
1380 1380
1381 (defun save-options-non-customized-face-list () 1381 (defun save-options-non-customized-face-list ()
1382 "This function will return a list of all faces that have not been 1382 "Return a list of all faces that have not been 'customized'."
1383 'customized'."
1384 (delq nil (mapcar '(lambda (face) 1383 (delq nil (mapcar '(lambda (face)
1385 (unless (get face 'saved-face) 1384 (unless (get face 'saved-face)
1386 face)) 1385 face))
1387 (face-list)))) 1386 (face-list))))
1388 1387
1413 This file is loaded from your .emacs file. 1412 This file is loaded from your .emacs file.
1414 If this is a relative filename, it is put into the same directory as your 1413 If this is a relative filename, it is put into the same directory as your
1415 .emacs file.") 1414 .emacs file.")
1416 1415
1417 (defun save-options-menu-settings () 1416 (defun save-options-menu-settings ()
1418 "Saves the current settings of the `Options' menu to your `.emacs' file." 1417 "Save the current settings of the `Options' menu to your `.emacs' file."
1419 (interactive) 1418 (interactive)
1420 ;; we compute the actual filenames now because x-menubar is loaded 1419 ;; we compute the actual filenames now because x-menubar is loaded
1421 ;; at dump time, when the identity of the user running XEmacs is not known. 1420 ;; at dump time, when the identity of the user running XEmacs is not known.
1422 (let* ((actual-save-options-init-file 1421 (let* ((actual-save-options-init-file
1423 (or save-options-init-file 1422 (or save-options-init-file
1539 (defun tutorials-menu-filter (menu-items) 1538 (defun tutorials-menu-filter (menu-items)
1540 ;; If there's a tutorial for the current language environment, make it 1539 ;; If there's a tutorial for the current language environment, make it
1541 ;; appear first as the default one. Otherwise, use the english one. 1540 ;; appear first as the default one. Otherwise, use the english one.
1542 (let* ((menu menu-items) 1541 (let* ((menu menu-items)
1543 (item (pop menu-items))) 1542 (item (pop menu-items)))
1544 (aset 1543 (aset
1545 item 3 1544 item 3
1546 (concat "(" 1545 (concat "("
1547 (if (assoc 1546 (if (assoc
1548 'tutorial 1547 'tutorial
1549 (assoc current-language-environment language-info-alist)) 1548 (assoc current-language-environment language-info-alist))
1550 current-language-environment 1549 current-language-environment
1551 "English") 1550 "English")
1552 ")")) 1551 ")"))
1553 menu))) 1552 menu)))
1554 1553
1555 1554
1634 (t 1633 (t
1635 (or mode-popup-menu 1634 (or mode-popup-menu
1636 global-popup-menu 1635 global-popup-menu
1637 (error "No menu here.")))))) 1636 (error "No menu here."))))))
1638 1637
1639 (defun popup-buffer-menu (event) 1638 (defun popup-buffer-menu (event)
1640 "Pop up a copy of the Buffers menu (from the menubar) where the mouse is clicked." 1639 "Pop up a copy of the Buffers menu (from the menubar) where the mouse is clicked."
1641 (interactive "e") 1640 (interactive "e")
1642 (let ((window (and (event-over-text-area-p event) (event-window event))) 1641 (let ((window (and (event-over-text-area-p event) (event-window event)))
1643 (bmenu nil)) 1642 (bmenu nil))
1644 (or window 1643 (or window
1650 (setq bmenu (assoc "Buffers" default-menubar))) 1649 (setq bmenu (assoc "Buffers" default-menubar)))
1651 (if (null bmenu) 1650 (if (null bmenu)
1652 (error "Can't find the Buffers menu")) 1651 (error "Can't find the Buffers menu"))
1653 (popup-menu bmenu))) 1652 (popup-menu bmenu)))
1654 1653
1655 (defun popup-menubar-menu (event) 1654 (defun popup-menubar-menu (event)
1656 "Pop up a copy of menu that also appears in the menubar" 1655 "Pop up a copy of menu that also appears in the menubar"
1657 ;; by Stig@hackvan.com 1656 ;; by Stig@hackvan.com
1658 (interactive "e") 1657 (interactive "e")
1659 (let ((window (and (event-over-text-area-p event) (event-window event))) 1658 (let ((window (and (event-over-text-area-p event) (event-window event)))
1660 popup-menubar) 1659 popup-menubar)