|
0
|
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"))
|
|
149
|
174 (delete-menu-item '("Version Control")))
|
|
0
|
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
|
|
149
|
185 (delete-menu-item '("Version Control"))
|
|
0
|
186 (require 'sccs)
|
|
|
187 (add-menu '() "SCCS" (cdr sccs-menu)))
|
|
|
188 (progn
|
|
|
189 (require 'vc)
|
|
|
190 (delete-menu-item '("SCCS"))
|
|
149
|
191 (add-menu '() "Version Control" vc-default-menu)))
|
|
0
|
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
|
