Mercurial > hg > xemacs-beta

comparison lisp/sunpro/sunpro-menubar.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children 538048ae2ab8
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;; sunpro-menubar.el --- Initialize the SunPro menubar
2
3 ;; Copyright (C) 1993, 1994 Sun Microsystems, Inc
4
5 ;; Author: Aaron Endelman <endelman@Eng.Sun.COM>
6 ;; Maintainer: Vladimir Ivanovic <vladimir@Eng.Sun.COM>
7 ;; Created: 93/09/13 15:16:24
8
9 ;; Keywords: SunPro menubar initialization
10
11 ;;; Commentary:
12 ;; Creates the default SunPro menubars.
13
14 ;;; To Do:
15
16 ;;; Code:
17
18 (defconst sunpro-menubar
19 (purecopy-menubar ;the simple, new user menubar
20 (list
21 '("File"
22 ["New" sunpro-new-buffer t]
23 ["Open:" find-file t]
24 ["Include File:" insert-file t]
25 "-----"
26 ["Save" save-buffer t nil]
27 ["Save As:" write-file t]
28 ["Revert..." revert-buffer t nil]
29 "-----"
30 ["Print" lpr-buffer t nil]
31 "-----"
32 ["Close" delete-frame t]
33 ["Exit XEmacs" save-buffers-kill-emacs t]
34 )
35
36 '("Edit"
37 ["Undo" advertised-undo t]
38 "-----"
39 ["Cut" x-kill-primary-selection t]
40 ["Copy" x-copy-primary-selection t]
41 ["Paste" x-yank-clipboard-selection t]
42 ["Delete" x-delete-primary-selection t]
43 "-----"
44 ["Select Block" mark-paragraph t]
45 ["Select All" mark-whole-buffer t]
46 )
47
48 '("View"
49 ["New View" make-frame t]
50 "-----"
51 ["Split Window" (split-window) t]
52 ["Unsplit Window" delete-other-windows t]
53 ["Close Buffer" (kill-buffer nil) t nil]
54 "-----! before list all buffers"
55 ["List All Buffers" list-buffers t]
56 )
57
58 '("Find"
59 ["Forward:" sunpro-search-forward t]
60 ["Backward:" sunpro-search-backward t]
61 ["And Replace:" sunpro-query-replace t]
62 )
63
64 ;; Copy the options menu from the default menubar
65 (car (find-menu-item default-menubar '("Options")))
66
67 '("Utilities"
68 ["Cancel Command" (keyboard-quit) t]
69 "-----"
70 ["Execute Macro" call-last-kbd-macro last-kbd-macro]
71 ["Start Macro Recording" start-kbd-macro (not defining-kbd-macro)]
72 ["End Macro Recording" end-kbd-macro defining-kbd-macro]
73 "-----"
74 ["Spell" ispell-buffer t]
75 ["Sort" sort-lines t]
76 "-----"
77 ["Format Paragraph " fill-paragraph t]
78 "-----"
79 ["Goto Line:" goto-line t]
80 )
81
82 ;; the following is supposed to be here! It ensures that the
83 ;; Help item is always the rightmost item.
84
85 nil ; the partition: menus after this are flushright
86
87 '("Help" ["About XEmacs..." about-xemacs t]
88 "-----"
89 ["XEmacs WWW Page" xemacs-www-page t]
90 ["XEmacs FAQ via WWW" xemacs-www-faq t]
91 "-----"
92 ["Info" info t]
93 ["Describe Mode" describe-mode t]
94 ["Hyper Apropos..." hyper-apropos t]
95 ["Command Apropos..." command-apropos t]
96 ["Full Apropos..." apropos t]
97 ["List Keybindings" describe-bindings t]
98 ["Describe Key..." describe-key t]
99 ["Describe Function..." describe-function t]
100 ["Describe Variable..." describe-variable t]
101 "-----"
102 ["Unix Manual..." manual-entry t]
103 ["XEmacs Tutorial" help-with-tutorial t]
104 ["XEmacs News" view-emacs-news t]
105 ))))
106
107 (set-menubar sunpro-menubar)
108
109 (defconst programmer-menu '(["Programmer Menus"
110 (toggle-programmer-menus)
111 :style toggle
112 :selected programmer-menus-p]
113 ["-----! before save options" nil t]))
114 (setq save-options-menu-item
115 (car (find-menu-item default-menubar '("Options" "Save Options"))))
116 (delete-menu-item '("Options" "Save Options"))
117 (add-menu () "Options" (append
118 (cdr (car
119 (find-menu-item default-menubar '("Options"))))
120 programmer-menu
121 (list save-options-menu-item)))
122
123 ;;;
124 ;;; helper commands
125 ;;;
126
127 (defun sunpro-new-buffer ()
128 (interactive)
129 (switch-to-buffer (generate-new-buffer "Untitled")))
130
131 (defun sunpro-new-window ()
132 (interactive)
133 (switch-to-buffer-other-frame (generate-new-buffer "Untitled")))
134
135 (defun sunpro-clone-buffer ()
136 (interactive)
137 (let
138 ((old (current-buffer)))
139 (switch-to-buffer (generate-new-buffer (buffer-name old)))
140 (insert-buffer old)))
141
142 (defun sunpro-search-forward ()
143 (interactive)
144 (if isearch-mode (isearch-repeat-forward)
145 (x-isearch-maybe-with-region)))
146
147 (defun sunpro-search-backward ()
148 (interactive)
149 (if isearch-mode (isearch-repeat-backward)
150 (x-isearch-maybe-with-region t)))
151
152 (put 'sunpro-search-forward 'isearch-command t)
153 (put 'sunpro-search-backward 'isearch-command t)
154
155 (defun sunpro-query-replace ()
156 (interactive)
157 (call-interactively 'query-replace))
158
159 (defun sunpro-menu-quit ()
160 "Abort minibuffer input if any."
161 (while (not (zerop (minibuffer-depth)))
162 (abort-recursive-edit)))
163
164 (defvar programmer-menus-p nil)
165 (defvar sccs-or-vc-menus 'sccs
166 "Choose to use the SCCS or the VC menu.")
167
168 (defun toggle-programmer-menus ()
169 (interactive)
170 (if programmer-menus-p
171 (progn
172 (if (equal sccs-or-vc-menus 'sccs)
173 (delete-menu-item '("SCCS"))
174 (delete-menu-item '("VC")))
175 (delete-menu-item '("SPARCworks"))
176 (delete-menu-item '("Options" "SPARCworks"))
177 (delete-menu-item '("Options" "-----! before save options"))
178 (delete-menu-item '("Help" "SPARCworks"))
179 (setq programmer-menus-p nil))
180 (progn
181 (require 'eos-load "sun-eos-load")
182 (eos::start)
183 (if (equal sccs-or-vc-menus 'sccs)
184 (progn
185 (delete-menu-item '("VC"))
186 (require 'sccs)
187 (add-menu '() "SCCS" (cdr sccs-menu)))
188 (progn
189 (require 'vc)
190 (delete-menu-item '("SCCS"))
191 (add-menu '() "VC" vc-default-menu)))
192 (setq programmer-menus-p t))))
193
194 (defun sunpro-build-buffers-menu-hook ()
195 "For use as a value of activate-menubar-hook.
196 This function changes the contents of the \"View\" menu to add
197 at the end the current set of buffers. Only the most-recently-used few buffers
198 will be listed on the menu, for efficiency reasons. You can control how
199 many buffers will be shown by setting `buffers-menu-max-size'.
200 You can control the text of the menu items by redefining the function
201 `format-buffers-menu-line'."
202 (let ((buffer-menu (car (find-menu-item current-menubar '("View"))))
203 buffers)
204 (if (not buffer-menu)
205 nil
206 (setq buffer-menu (cdr buffer-menu))
207 (setq buffers (buffer-list))
208
209 (if (and (integerp buffers-menu-max-size)
210 (> buffers-menu-max-size 1))
211 (if (> (length buffers) buffers-menu-max-size)
212 (setcdr (nthcdr buffers-menu-max-size buffers) nil)))
213
214 (setq buffers (build-buffers-menu-internal buffers))
215 (setq buffers (append (delq nil buffers)))
216 ;; slightly (only slightly) more efficient to not install the menubar
217 ;; if it hasn't visibly changed.
218 (let ((tail (member "-----! before list all buffers" (cdr buffer-menu)))
219 )
220 (if tail
221 (if (equal buffers (cdr tail))
222 t ; return t meaning "no change"
223 (setcdr tail buffers)
224 nil)
225 ;; only the first time
226 (add-menu nil "View" (append buffer-menu
227 '("-----! before list all buffers")
228 buffers))
229 nil
230 )))))
231
232 (add-hook 'activate-menubar-hook 'sunpro-build-buffers-menu-hook)
233
234 ;;; sunpro-menubar.el ends here