|
209
|
1 ;;; modeline.el --- modeline hackery.
|
|
|
2
|
|
|
3 ;; Copyright (C) 1988, 1992-1994, 1997 Free Software Foundation, Inc.
|
|
|
4 ;; Copyright (C) 1995, 1996 Ben Wing.
|
|
|
5
|
|
|
6 ;; Maintainer: XEmacs Development Team
|
|
|
7 ;; Keywords: extensions, dumped
|
|
|
8
|
|
|
9 ;; This file is part of XEmacs.
|
|
|
10
|
|
|
11 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
12 ;; under the terms of the GNU General Public License as published by
|
|
|
13 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
14 ;; any later version.
|
|
|
15
|
|
|
16 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
19 ;; General Public License for more details.
|
|
|
20
|
|
|
21 ;; You should have received a copy of the GNU General Public License
|
|
|
22 ;; along with XEmacs; see the file COPYING. If not, write to the
|
|
|
23 ;; Free Software Foundation, 59 Temple Place - Suite 330,
|
|
|
24 ;; Boston, MA 02111-1307, USA.
|
|
|
25
|
|
|
26 ;;; Synched up with: Not in FSF.
|
|
|
27
|
|
|
28 ;;; Commentary:
|
|
|
29
|
|
|
30 ;; This file is dumped with XEmacs.
|
|
|
31
|
|
|
32 ;;; Code:
|
|
|
33
|
|
|
34 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
35 ;;; General mouse modeline stuff ;;;
|
|
|
36 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
37
|
|
|
38 (defgroup modeline nil
|
|
227
|
39 "Modeline customizations."
|
|
209
|
40 :group 'environment)
|
|
|
41
|
|
|
42 (defcustom drag-modeline-event-lag 150
|
|
|
43 "*The pause (in msecs) between drag modeline events before redisplaying.
|
|
|
44 If this value is too small, dragging will be choppy because redisplay cannot
|
|
|
45 keep up. If it is too large, dragging will be choppy because of the explicit
|
|
|
46 redisplay delay specified."
|
|
|
47 :type 'integer
|
|
|
48 :group 'modeline)
|
|
|
49
|
|
|
50 (defcustom modeline-click-swaps-buffers nil
|
|
|
51 "*If non-nil, clicking on the modeline changes the current buffer.
|
|
|
52 Click on the left half of the modeline cycles forward through the
|
|
|
53 buffer list and clicking on the right half cycles backward."
|
|
|
54 :type 'boolean
|
|
|
55 :group 'modeline)
|
|
|
56
|
|
|
57 (defun mouse-drag-modeline (event)
|
|
|
58 "Resize a window by dragging its modeline.
|
|
|
59 This command should be bound to a button-press event in modeline-map.
|
|
|
60 Holding down a mouse button and moving the mouse up and down will
|
|
|
61 make the clicked-on window taller or shorter."
|
|
|
62 (interactive "e")
|
|
|
63 (or (button-press-event-p event)
|
|
|
64 (error "%s must be invoked by a mouse-press" this-command))
|
|
|
65 (or (event-over-modeline-p event)
|
|
|
66 (error "not over a modeline"))
|
|
225
|
67 ;; Give the modeline a "pressed" look. --hniksic
|
|
|
68 (letf (((specifier-instance modeline-shadow-thickness
|
|
|
69 (event-window event))
|
|
|
70 (- (specifier-instance modeline-shadow-thickness
|
|
|
71 (event-window event)))))
|
|
|
72 (let ((done nil)
|
|
|
73 (depress-line (event-y event))
|
|
|
74 (start-event-frame (event-frame event))
|
|
|
75 (start-event-window (event-window event))
|
|
|
76 (start-nwindows (count-windows t))
|
|
280
|
77 ;; (hscroll-delta (face-width 'modeline))
|
|
265
|
78 ;; (start-hscroll (modeline-hscroll (event-window event)))
|
|
259
|
79 (start-x-pixel (event-x-pixel event))
|
|
225
|
80 (last-timestamp 0)
|
|
|
81 default-line-height
|
|
209
|
82 modeline-height
|
|
225
|
83 should-enlarge-minibuffer
|
|
|
84 event min-height minibuffer y top bot edges wconfig growth)
|
|
|
85 (setq minibuffer (minibuffer-window start-event-frame)
|
|
|
86 default-line-height (face-height 'default start-event-window)
|
|
|
87 min-height (+ (* window-min-height default-line-height)
|
|
|
88 ;; Don't let the window shrink by a
|
|
|
89 ;; non-multiple of the default line
|
|
|
90 ;; height. (enlarge-window -1) will do
|
|
|
91 ;; this if the difference between the
|
|
|
92 ;; current window height and the minimum
|
|
|
93 ;; window height is less than the height
|
|
|
94 ;; of the default font. These extra
|
|
|
95 ;; lost pixels of height don't come back
|
|
|
96 ;; if you grow the window again. This
|
|
|
97 ;; can make it impossible to drag back
|
|
|
98 ;; to the exact original size, which is
|
|
|
99 ;; disconcerting.
|
|
|
100 (% (window-pixel-height start-event-window)
|
|
|
101 default-line-height))
|
|
|
102 modeline-height
|
|
209
|
103 (if (specifier-instance has-modeline-p start-event-window)
|
|
|
104 (+ (face-height 'modeline start-event-window)
|
|
|
105 (* 2 (specifier-instance modeline-shadow-thickness
|
|
|
106 start-event-window)))
|
|
|
107 (* 2 (specifier-instance modeline-shadow-thickness
|
|
|
108 start-event-window))))
|
|
225
|
109 (if (not (eq (window-frame minibuffer) start-event-frame))
|
|
|
110 (setq minibuffer nil))
|
|
|
111 (if (and (null minibuffer) (one-window-p t))
|
|
|
112 (error "Attempt to resize sole window"))
|
|
|
113 ;; if this is the bottommost ordinary window, then to
|
|
|
114 ;; move its modeline the minibuffer must be enlarged.
|
|
|
115 (setq should-enlarge-minibuffer
|
|
|
116 (and minibuffer (window-lowest-p start-event-window)))
|
|
|
117 ;; loop reading events
|
|
|
118 (while (not done)
|
|
|
119 (setq event (next-event event))
|
|
|
120 ;; requeue event and quit if this is a misc-user, eval or
|
|
|
121 ;; keypress event.
|
|
|
122 ;; quit if this is a button press or release event, or if the event
|
|
|
123 ;; occurred in some other frame.
|
|
|
124 ;; drag if this is a mouse motion event and the time
|
|
|
125 ;; between this event and the last event is greater than
|
|
|
126 ;; drag-modeline-event-lag.
|
|
|
127 ;; do nothing if this is any other kind of event.
|
|
|
128 (cond ((or (misc-user-event-p event)
|
|
|
129 (key-press-event-p event))
|
|
|
130 (setq unread-command-events (nconc unread-command-events
|
|
|
131 (list event))
|
|
|
132 done t))
|
|
|
133 ((button-release-event-p event)
|
|
|
134 (setq done t)
|
|
259
|
135 ;; Consider we have a mouse click neither X pos (modeline
|
|
|
136 ;; scroll) nore Y pos (modeline drag) have changed.
|
|
|
137 (and modeline-click-swaps-buffers
|
|
|
138 (= depress-line (event-y event))
|
|
265
|
139 ;; (= start-hscroll (modeline-hscroll start-event-window))
|
|
259
|
140 (modeline-swap-buffers event)))
|
|
225
|
141 ((button-event-p event)
|
|
|
142 (setq done t))
|
|
|
143 ((not (motion-event-p event))
|
|
|
144 (dispatch-event event))
|
|
|
145 ((not (eq start-event-frame (event-frame event)))
|
|
|
146 (setq done t))
|
|
|
147 ((< (abs (- (event-timestamp event) last-timestamp))
|
|
|
148 drag-modeline-event-lag)
|
|
|
149 nil)
|
|
|
150 (t
|
|
265
|
151 ;; (set-modeline-hscroll start-event-window
|
|
|
152 ;; (+ (/ (- (event-x-pixel event)
|
|
|
153 ;; start-x-pixel)
|
|
|
154 ;; hscroll-delta)
|
|
|
155 ;; start-hscroll))
|
|
225
|
156 (setq last-timestamp (event-timestamp event)
|
|
|
157 y (event-y-pixel event)
|
|
|
158 edges (window-pixel-edges start-event-window)
|
|
|
159 top (nth 1 edges)
|
|
|
160 bot (nth 3 edges))
|
|
|
161 ;; scale back a move that would make the
|
|
|
162 ;; window too short.
|
|
|
163 (cond ((< (- y top (- modeline-height)) min-height)
|
|
|
164 (setq y (+ top min-height (- modeline-height)))))
|
|
|
165 ;; compute size change needed
|
|
|
166 (setq growth (- y bot (/ (- modeline-height) 2))
|
|
|
167 wconfig (current-window-configuration))
|
|
|
168 ;; grow/shrink minibuffer?
|
|
|
169 (if should-enlarge-minibuffer
|
|
|
170 (progn
|
|
|
171 ;; yes. scale back shrinkage if it
|
|
|
172 ;; would make the minibuffer less than 1
|
|
|
173 ;; line tall.
|
|
|
174 ;;
|
|
|
175 ;; also flip the sign of the computed growth,
|
|
|
176 ;; since if we want to grow the window with the
|
|
|
177 ;; modeline we need to shrink the minibuffer
|
|
|
178 ;; and vice versa.
|
|
|
179 (if (and (> growth 0)
|
|
|
180 (< (- (window-pixel-height minibuffer)
|
|
|
181 growth)
|
|
|
182 default-line-height))
|
|
|
183 (setq growth
|
|
|
184 (- (window-pixel-height minibuffer)
|
|
|
185 default-line-height)))
|
|
209
|
186 (setq growth (- growth))))
|
|
225
|
187 ;; window grow and shrink by lines not pixels, so
|
|
|
188 ;; divide the pixel height by the height of the
|
|
|
189 ;; default face.
|
|
|
190 (setq growth (/ growth default-line-height))
|
|
|
191 ;; grow/shrink the window
|
|
|
192 (enlarge-window growth nil (if should-enlarge-minibuffer
|
|
|
193 minibuffer
|
|
|
194 start-event-window))
|
|
|
195 ;; if this window's growth caused another
|
|
|
196 ;; window to be deleted because it was too
|
|
|
197 ;; short, rescind the change.
|
|
|
198 ;;
|
|
|
199 ;; if size change caused space to be stolen
|
|
|
200 ;; from a window above this one, rescind the
|
|
|
201 ;; change, but only if we didn't grow/shrink
|
|
|
202 ;; the minibuffer. minibuffer size changes
|
|
|
203 ;; can cause all windows to shrink... no way
|
|
|
204 ;; around it.
|
|
|
205 (if (or (/= start-nwindows (count-windows t))
|
|
|
206 (and (not should-enlarge-minibuffer)
|
|
|
207 (/= top (nth 1 (window-pixel-edges
|
|
|
208 start-event-window)))))
|
|
|
209 (set-window-configuration wconfig))))))))
|
|
209
|
210
|
|
|
211 ;; from Bob Weiner (bob_weiner@pts.mot.com)
|
|
259
|
212 ;; Whether this function should be called is now decided in
|
|
|
213 ;; mouse-drag-modeline - dverna feb. 98
|
|
|
214 (defun modeline-swap-buffers (event)
|
|
|
215 "Handle mouse clicks on modeline by switching buffers.
|
|
209
|
216 If click on left half of a frame's modeline, bury current buffer.
|
|
|
217 If click on right half of a frame's modeline, raise bottommost buffer.
|
|
259
|
218 Arg EVENT is the button release event that occured on the modeline."
|
|
|
219 (or (event-over-modeline-p event)
|
|
|
220 (error "not over a modeline"))
|
|
|
221 (or (button-release-event-p event)
|
|
|
222 (error "not a button release event"))
|
|
|
223 (if (< (event-x event) (/ (window-width (event-window event)) 2))
|
|
|
224 ;; On left half of modeline, bury current buffer,
|
|
|
225 ;; displaying second buffer on list.
|
|
|
226 (mouse-bury-buffer event)
|
|
|
227 ;; On right half of modeline, raise and display bottommost
|
|
|
228 ;; buffer in buffer list.
|
|
|
229 (mouse-unbury-buffer event)))
|
|
209
|
230
|
|
|
231 (defconst modeline-menu
|
|
|
232 '("Window Commands"
|
|
|
233 ["Delete Window Above" delete-window t]
|
|
|
234 ["Delete Other Windows" delete-other-windows t]
|
|
|
235 ["Split Window Above" split-window-vertically t]
|
|
|
236 ["Split Window Horizontally" split-window-horizontally t]
|
|
|
237 ["Balance Windows" balance-windows t]
|
|
|
238 ))
|
|
|
239
|
|
|
240 (defun modeline-menu (event)
|
|
|
241 (interactive "e")
|
|
|
242 (popup-menu-and-execute-in-window
|
|
|
243 (cons (format "Window Commands for %S:"
|
|
|
244 (buffer-name (event-buffer event)))
|
|
|
245 (cdr modeline-menu))
|
|
|
246 event))
|
|
|
247
|
|
|
248 (defvar modeline-map (make-sparse-keymap 'modeline-map)
|
|
|
249 "Keymap consulted for mouse-clicks on the modeline of a window.
|
|
|
250 This variable may be buffer-local; its value will be looked up in
|
|
|
251 the buffer of the window whose modeline was clicked upon.")
|
|
|
252
|
|
|
253 (define-key modeline-map 'button1 'mouse-drag-modeline)
|
|
|
254 ;; button2 selects the window without setting point
|
|
|
255 (define-key modeline-map 'button2 (lambda () (interactive "@")))
|
|
|
256 (define-key modeline-map 'button3 'modeline-menu)
|
|
|
257
|
|
|
258 (make-face 'modeline-mousable "Face for mousable portions of the modeline.")
|
|
263
|
259 (set-face-parent 'modeline-mousable 'modeline nil '(default))
|
|
284
|
260 (when (featurep 'window-system)
|
|
|
261 (set-face-foreground 'modeline-mousable
|
|
|
262 '(((default color x) . "firebrick")
|
|
|
263 ((default color mswindows) . "firebrick"))
|
|
|
264 'global))
|
|
209
|
265 (when (featurep 'x)
|
|
263
|
266 (set-face-font 'modeline-mousable [bold] nil '(default mono x))
|
|
|
267 (set-face-font 'modeline-mousable [bold] nil '(default grayscale x)))
|
|
209
|
268
|
|
|
269 (defmacro make-modeline-command-wrapper (command)
|
|
|
270 `#'(lambda (event)
|
|
|
271 (interactive "e")
|
|
|
272 (save-selected-window
|
|
|
273 (select-window (event-window event))
|
|
|
274 (call-interactively ',(eval command)))))
|
|
|
275
|
|
|
276 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
277 ;;; Minor modes ;;;
|
|
|
278 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
279
|
|
|
280 (defvar minor-mode-alist nil
|
|
|
281 "Alist saying how to show minor modes in the modeline.
|
|
|
282 Each element looks like (VARIABLE STRING);
|
|
|
283 STRING is included in the modeline iff VARIABLE's value is non-nil.
|
|
|
284
|
|
|
285 Actually, STRING need not be a string; any possible modeline element
|
|
|
286 is okay. See `modeline-format'.")
|
|
|
287
|
|
|
288 ;; Used by C code (lookup-key and friends) but defined here.
|
|
|
289 (defvar minor-mode-map-alist nil
|
|
|
290 "Alist of keymaps to use for minor modes.
|
|
|
291 Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read
|
|
|
292 key sequences and look up bindings iff VARIABLE's value is non-nil.
|
|
|
293 If two active keymaps bind the same key, the keymap appearing earlier
|
|
|
294 in the list takes precedence.")
|
|
|
295
|
|
|
296 (make-face 'modeline-mousable-minor-mode
|
|
|
297 "Face for mousable minor-mode strings in the modeline.")
|
|
263
|
298 (set-face-parent 'modeline-mousable-minor-mode 'modeline-mousable nil
|
|
|
299 '(default))
|
|
284
|
300 (when (featurep 'window-system)
|
|
209
|
301 (set-face-foreground 'modeline-mousable-minor-mode
|
|
263
|
302 '(((default color x) . "green4")
|
|
284
|
303 ((default color x) . "forestgreen")
|
|
|
304 ((default color mswindows) . "green4")
|
|
|
305 ((default color mswindows) . "forestgreen"))
|
|
|
306 'global))
|
|
209
|
307
|
|
|
308 (defvar modeline-mousable-minor-mode-extent (make-extent nil nil)
|
|
|
309 ;; alliteration at its finest.
|
|
|
310 "Extent managing the mousable minor mode modeline strings.")
|
|
|
311 (set-extent-face modeline-mousable-minor-mode-extent
|
|
|
312 'modeline-mousable-minor-mode)
|
|
|
313
|
|
|
314 ;; This replaces the idiom
|
|
|
315 ;;
|
|
|
316 ;; (or (assq 'isearch-mode minor-mode-alist)
|
|
|
317 ;; (setq minor-mode-alist
|
|
|
318 ;; (purecopy
|
|
|
319 ;; (append minor-mode-alist
|
|
|
320 ;; '((isearch-mode isearch-mode))))))
|
|
|
321
|
|
|
322 (defun add-minor-mode (toggle name &optional keymap after toggle-fun)
|
|
|
323 "Add a minor mode to `minor-mode-alist' and `minor-mode-map-alist'.
|
|
241
|
324
|
|
209
|
325 TOGGLE is a symbol whose value as a variable specifies whether the
|
|
241
|
326 minor mode is active.
|
|
|
327
|
|
|
328 NAME is the name that should appear in the modeline. It should either
|
|
|
329 be a string beginning with a space, or a symbol with a similar string
|
|
|
330 as its value.
|
|
|
331
|
|
|
332 KEYMAP is a keymap to make active when the minor mode is active.
|
|
|
333
|
|
|
334 AFTER is the toggling symbol used for another minor mode. If AFTER is
|
|
|
335 non-nil, then it is used to position the new mode in the minor-mode
|
|
|
336 alists.
|
|
|
337
|
|
|
338 TOGGLE-FUN specifies an interactive function that is called to toggle
|
|
|
339 the mode on and off; this affects what happens when button2 is pressed
|
|
|
340 on the mode, and when button3 is pressed somewhere in the list of
|
|
|
341 modes. If TOGGLE-FUN is nil and TOGGLE names an interactive function,
|
|
|
342 TOGGLE is used as the toggle function.
|
|
|
343
|
|
280
|
344 Example: (add-minor-mode 'view-minor-mode \" View\" view-mode-map)"
|
|
|
345 (let* ((add-elt #'(lambda (elt sym)
|
|
|
346 (let (place)
|
|
|
347 (cond ((null after) ; add to front
|
|
|
348 (push elt (symbol-value sym)))
|
|
|
349 ((and (not (eq after t))
|
|
|
350 (setq place (memq (assq after
|
|
|
351 (symbol-value sym))
|
|
|
352 (symbol-value sym))))
|
|
|
353 (push elt (cdr place)))
|
|
|
354 (t
|
|
|
355 (set sym (append (symbol-value sym)
|
|
|
356 (list elt))))))
|
|
|
357 (symbol-value sym)))
|
|
|
358 el toggle-keymap)
|
|
209
|
359 (if toggle-fun
|
|
280
|
360 (check-argument-type 'commandp toggle-fun)
|
|
|
361 (when (commandp toggle)
|
|
|
362 (setq toggle-fun toggle)))
|
|
|
363 (when (and toggle-fun name)
|
|
|
364 (setq toggle-keymap (make-sparse-keymap
|
|
|
365 (intern (concat "modeline-minor-"
|
|
|
366 (symbol-name toggle)
|
|
|
367 "-map"))))
|
|
|
368 (define-key toggle-keymap 'button2
|
|
|
369 ;; defeat the DUMB-ASS byte-compiler, which tries to
|
|
|
370 ;; expand the macro at compile time and fucks up.
|
|
|
371 (eval '(make-modeline-command-wrapper toggle-fun)))
|
|
|
372 (put toggle 'modeline-toggle-function toggle-fun))
|
|
|
373 (when name
|
|
|
374 (let ((hacked-name
|
|
|
375 (if toggle-keymap
|
|
|
376 (cons (let ((extent (make-extent nil nil)))
|
|
|
377 (set-extent-keymap extent toggle-keymap)
|
|
|
378 (set-extent-property
|
|
|
379 extent 'help-echo
|
|
|
380 (concat "button2 turns off "
|
|
|
381 (if (symbolp toggle-fun)
|
|
|
382 (symbol-name toggle-fun)
|
|
|
383 (symbol-name toggle))))
|
|
|
384 extent)
|
|
|
385 (cons modeline-mousable-minor-mode-extent name))
|
|
|
386 name)))
|
|
|
387 (if (setq el (assq toggle minor-mode-alist))
|
|
|
388 (setcdr el (list hacked-name))
|
|
|
389 (funcall add-elt
|
|
|
390 (list toggle hacked-name)
|
|
|
391 'minor-mode-alist))))
|
|
|
392 (when keymap
|
|
|
393 (if (setq el (assq toggle minor-mode-map-alist))
|
|
|
394 (setcdr el keymap)
|
|
|
395 (funcall add-elt
|
|
|
396 (cons toggle keymap)
|
|
|
397 'minor-mode-map-alist)))))
|
|
209
|
398
|
|
241
|
399 (put 'abbrev-mode :menu-tag "Abbreviation Expansion")
|
|
209
|
400 (add-minor-mode 'abbrev-mode " Abbrev")
|
|
241
|
401 ;; only when visiting a file...
|
|
209
|
402 (add-minor-mode 'overwrite-mode 'overwrite-mode)
|
|
241
|
403 (put 'auto-fill-function :menu-tag "Auto Fill")
|
|
209
|
404 (add-minor-mode 'auto-fill-function " Fill" nil nil 'auto-fill-mode)
|
|
241
|
405
|
|
280
|
406 (put 'defining-kbd-macro :menu-tag "Keyboard Macro")
|
|
|
407 (add-minor-mode 'defining-kbd-macro " Def" nil nil
|
|
|
408 (lambda ()
|
|
|
409 (interactive)
|
|
|
410 (if defining-kbd-macro
|
|
284
|
411 (progn
|
|
|
412 ;; #### This means to disregard the last event.
|
|
|
413 ;; It is needed because the last recorded
|
|
|
414 ;; event is usually the mouse event that
|
|
|
415 ;; invoked the menu item (and this function),
|
|
|
416 ;; and having it in the macro causes problems.
|
|
|
417 (zap-last-kbd-macro-event)
|
|
|
418 (end-kbd-macro nil))
|
|
280
|
419 (start-kbd-macro nil))))
|
|
209
|
420
|
|
|
421 (defun modeline-minor-mode-menu (event)
|
|
241
|
422 "The menu that pops up when you press `button3' inside the
|
|
|
423 parentheses on the modeline."
|
|
209
|
424 (interactive "e")
|
|
|
425 (save-excursion
|
|
|
426 (set-buffer (event-buffer event))
|
|
|
427 (popup-menu-and-execute-in-window
|
|
280
|
428 (cons
|
|
|
429 "Minor Mode Toggles"
|
|
|
430 (sort
|
|
|
431 (delq nil (mapcar
|
|
|
432 #'(lambda (x)
|
|
|
433 (let* ((toggle-sym (car x))
|
|
|
434 (toggle-fun (or (get toggle-sym
|
|
|
435 'modeline-toggle-function)
|
|
|
436 (and (commandp toggle-sym)
|
|
|
437 toggle-sym)))
|
|
|
438 (menu-tag (or (get toggle-sym :menu-tag nil)
|
|
|
439 (symbol-name (if (symbolp toggle-fun)
|
|
|
440 toggle-fun
|
|
|
441 toggle-sym))
|
|
|
442 ;; Here a function should
|
|
|
443 ;; maybe be invoked to
|
|
|
444 ;; beautify the symbol's
|
|
|
445 ;; menu appearance.
|
|
|
446 )))
|
|
|
447 (and toggle-fun
|
|
|
448 (vector menu-tag
|
|
|
449 toggle-fun
|
|
|
450 ;; The following two are wrong
|
|
|
451 ;; because of possible name
|
|
|
452 ;; clashes.
|
|
|
453 ;:active (get toggle-sym :active t)
|
|
|
454 ;:included (get toggle-sym :included t)
|
|
|
455 :style 'toggle
|
|
|
456 :selected (and (boundp toggle-sym)
|
|
|
457 toggle-sym)))))
|
|
|
458 minor-mode-alist))
|
|
|
459 (lambda (e1 e2)
|
|
|
460 (string< (aref e1 0) (aref e2 0)))))
|
|
209
|
461 event)))
|
|
|
462
|
|
|
463 (defvar modeline-minor-mode-map (make-sparse-keymap 'modeline-minor-mode-map)
|
|
|
464 "Keymap consulted for mouse-clicks on the minor-mode modeline list.")
|
|
|
465 (define-key modeline-minor-mode-map 'button3 'modeline-minor-mode-menu)
|
|
|
466
|
|
|
467 (defvar modeline-minor-mode-extent (make-extent nil nil)
|
|
|
468 "Extent covering the minor mode modeline strings.")
|
|
|
469 (set-extent-face modeline-minor-mode-extent 'modeline-mousable)
|
|
|
470 (set-extent-keymap modeline-minor-mode-extent modeline-minor-mode-map)
|
|
|
471
|
|
|
472
|
|
|
473 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
474 ;;; Other ;;;
|
|
|
475 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
476
|
|
|
477 (defun modeline-buffers-menu (event)
|
|
|
478 (interactive "e")
|
|
|
479 (popup-menu-and-execute-in-window
|
|
|
480 '("Buffers Popup Menu"
|
|
|
481 :filter buffers-menu-filter
|
|
|
482 ["List All Buffers" list-buffers t]
|
|
|
483 "--"
|
|
|
484 )
|
|
|
485 event))
|
|
|
486
|
|
|
487 (defvar modeline-buffer-id-left-map
|
|
|
488 (make-sparse-keymap 'modeline-buffer-id-left-map)
|
|
|
489 "Keymap consulted for mouse-clicks on the left half of the buffer-id string.")
|
|
|
490
|
|
|
491 (defvar modeline-buffer-id-right-map
|
|
|
492 (make-sparse-keymap 'modeline-buffer-id-right-map)
|
|
|
493 "Keymap consulted for mouse-clicks on the right half of the buffer-id string.")
|
|
|
494
|
|
|
495 (define-key modeline-buffer-id-left-map 'button2 'mouse-unbury-buffer)
|
|
|
496 (define-key modeline-buffer-id-right-map 'button2 'mouse-bury-buffer)
|
|
|
497 (define-key modeline-buffer-id-left-map 'button3 'modeline-buffers-menu)
|
|
|
498 (define-key modeline-buffer-id-right-map 'button3 'modeline-buffers-menu)
|
|
|
499
|
|
|
500 (make-face 'modeline-buffer-id
|
|
|
501 "Face for the buffer ID string in the modeline.")
|
|
263
|
502 (set-face-parent 'modeline-buffer-id 'modeline nil '(default))
|
|
284
|
503 (when (featurep 'window-system)
|
|
|
504 (set-face-foreground 'modeline-buffer-id
|
|
|
505 '(((default color x) . "blue4")
|
|
|
506 ((default color mswindows) . "blue4"))
|
|
|
507 'global))
|
|
209
|
508 (when (featurep 'x)
|
|
263
|
509 (set-face-font 'modeline-buffer-id [bold-italic] nil '(default mono x))
|
|
|
510 (set-face-font 'modeline-buffer-id [bold-italic] nil '(default grayscale x)))
|
|
209
|
511 (when (featurep 'tty)
|
|
263
|
512 (set-face-font 'modeline-buffer-id [bold-italic] nil '(default tty)))
|
|
209
|
513
|
|
|
514 (defvar modeline-buffer-id-extent (make-extent nil nil)
|
|
|
515 "Extent covering the whole of the buffer-id string.")
|
|
|
516 (set-extent-face modeline-buffer-id-extent 'modeline-buffer-id)
|
|
|
517
|
|
|
518 (defvar modeline-buffer-id-left-extent (make-extent nil nil)
|
|
|
519 "Extent covering the left half of the buffer-id string.")
|
|
|
520 (set-extent-keymap modeline-buffer-id-left-extent
|
|
|
521 modeline-buffer-id-left-map)
|
|
|
522 (set-extent-property modeline-buffer-id-left-extent 'help-echo
|
|
|
523 "button2 cycles to the previous buffer")
|
|
|
524
|
|
|
525 (defvar modeline-buffer-id-right-extent (make-extent nil nil)
|
|
|
526 "Extent covering the right half of the buffer-id string.")
|
|
|
527 (set-extent-keymap modeline-buffer-id-right-extent
|
|
|
528 modeline-buffer-id-right-map)
|
|
|
529 (set-extent-property modeline-buffer-id-right-extent 'help-echo
|
|
|
530 "button2 cycles to the next buffer")
|
|
|
531
|
|
|
532 (defconst modeline-buffer-identification
|
|
|
533 (list (cons modeline-buffer-id-left-extent (purecopy "XEmacs%N:"))
|
|
|
534 ; this used to be "XEmacs:"
|
|
|
535 (cons modeline-buffer-id-right-extent (purecopy " %17b")))
|
|
|
536 "Modeline control for identifying the buffer being displayed.
|
|
|
537 Its default value is \"XEmacs: %17b\" (NOT!). Major modes that edit things
|
|
|
538 other than ordinary files may change this (e.g. Info, Dired,...)")
|
|
|
539 (make-variable-buffer-local 'modeline-buffer-identification)
|
|
|
540
|
|
280
|
541 (defvar modeline-line-number-map
|
|
|
542 (make-sparse-keymap 'modeline-line-number-map)
|
|
|
543 "Keymap consulted for mouse-clicks on the line number in the modeline.")
|
|
|
544
|
|
|
545 (define-key modeline-line-number-map 'button2 'goto-line)
|
|
|
546
|
|
|
547 (defvar modeline-line-number-extent (make-extent nil nil)
|
|
|
548 "Extent covering the modeline-line-number string.")
|
|
|
549 (set-extent-face modeline-line-number-extent 'modeline-mousable)
|
|
|
550 (set-extent-keymap modeline-line-number-extent modeline-line-number-map)
|
|
|
551 (set-extent-property modeline-line-number-extent 'help-echo
|
|
|
552 "button2 to goto a specific line")
|
|
|
553
|
|
|
554 (put 'line-number-mode :menu-tag "Line Number")
|
|
|
555 (add-minor-mode 'line-number-mode "")
|
|
|
556 (put 'column-number-mode :menu-tag "Column Number")
|
|
|
557 (add-minor-mode 'column-number-mode "")
|
|
|
558
|
|
209
|
559 (defconst modeline-process nil
|
|
|
560 "Modeline control for displaying info on process status.
|
|
|
561 Normally nil in most modes, since there is no process to display.")
|
|
|
562 (make-variable-buffer-local 'modeline-process)
|
|
|
563
|
|
|
564 (defvar modeline-modified-map (make-sparse-keymap 'modeline-modified-map)
|
|
|
565 "Keymap consulted for mouse-clicks on the modeline-modified string.")
|
|
|
566 (define-key modeline-modified-map 'button2
|
|
|
567 (make-modeline-command-wrapper 'modeline-toggle-read-only))
|
|
|
568
|
|
|
569 (defvar modeline-modified-extent (make-extent nil nil)
|
|
|
570 "Extent covering the modeline-modified string.")
|
|
|
571 (set-extent-face modeline-modified-extent 'modeline-mousable)
|
|
|
572 (set-extent-keymap modeline-modified-extent modeline-modified-map)
|
|
|
573 (set-extent-property modeline-modified-extent 'help-echo
|
|
|
574 "button2 toggles the buffer's read-only status")
|
|
|
575
|
|
|
576 (defconst modeline-modified (purecopy '("--%1*%1+-"))
|
|
|
577 "Modeline control for displaying whether current buffer is modified.")
|
|
|
578 (make-variable-buffer-local 'modeline-modified)
|
|
|
579
|
|
|
580 (defvar modeline-narrowed-map (make-sparse-keymap 'modeline-narrowed-map)
|
|
|
581 "Keymap consulted for mouse-clicks on the modeline-narrowed string.")
|
|
|
582 (define-key modeline-narrowed-map 'button2
|
|
|
583 (make-modeline-command-wrapper 'widen))
|
|
|
584
|
|
|
585 (defvar modeline-narrowed-extent (make-extent nil nil)
|
|
|
586 "Extent covering the modeline-narrowed string.")
|
|
|
587 (set-extent-face modeline-narrowed-extent 'modeline-mousable)
|
|
|
588 (set-extent-keymap modeline-narrowed-extent modeline-narrowed-map)
|
|
|
589 (set-extent-property modeline-narrowed-extent 'help-echo
|
|
|
590 "button2 widens the buffer")
|
|
|
591
|
|
|
592 (setq-default
|
|
|
593 modeline-format
|
|
|
594 (list
|
|
|
595 (purecopy "")
|
|
|
596 (cons modeline-modified-extent 'modeline-modified)
|
|
|
597 (cons modeline-buffer-id-extent 'modeline-buffer-identification)
|
|
|
598 (purecopy " ")
|
|
|
599 'global-mode-string
|
|
|
600 (purecopy " %[(")
|
|
|
601 (cons modeline-minor-mode-extent (list "" 'mode-name 'minor-mode-alist))
|
|
|
602 (cons modeline-narrowed-extent "%n")
|
|
|
603 'modeline-process
|
|
|
604 (purecopy ")%]----")
|
|
280
|
605 (cons modeline-line-number-extent (list 'line-number-mode (purecopy "L%l--")))
|
|
209
|
606 (purecopy '(column-number-mode "C%c--"))
|
|
|
607 (purecopy '(-3 . "%p"))
|
|
|
608 (purecopy "-%-")))
|
|
|
609
|
|
|
610 ;;; Added for XEmacs 20.3. Provide wrapper for vc since it may not always be
|
|
|
611 ;;; present, and its symbols are not visible this early in the dump if it
|
|
|
612 ;;; is.
|
|
|
613
|
|
|
614 (defun modeline-toggle-read-only ()
|
|
|
615 "Change whether this buffer is visiting its file read-only.
|
|
|
616 With arg, set read-only iff arg is positive.
|
|
|
617 This function is designed to be called when the read-only indicator on the
|
|
|
618 modeline is clicked. It will call `vc-toggle-read-only' if available,
|
|
|
619 otherwise it will call the usual `toggle-read-only'."
|
|
|
620 (interactive)
|
|
|
621 (if (fboundp 'vc-toggle-read-only)
|
|
|
622 (vc-toggle-read-only)
|
|
|
623 (toggle-read-only)))
|
|
|
624
|
|
|
625 ;;; modeline.el ends here
|
