|
428
|
1 ;;; modeline.el --- modeline hackery.
|
|
|
2
|
|
|
3 ;; Copyright (C) 1988, 1992-1994, 1997 Free Software Foundation, Inc.
|
|
771
|
4 ;; Copyright (C) 1995, 1996, 2002 Ben Wing.
|
|
428
|
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
|
|
438
|
22 ;; along with XEmacs; see the file COPYING. If not, write to the
|
|
428
|
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
|
|
|
39 "Modeline customizations."
|
|
|
40 :group 'environment)
|
|
|
41
|
|
442
|
42 (defcustom modeline-3d-p ;; added for the options menu
|
|
|
43 (let ((thickness
|
|
|
44 (specifier-instance modeline-shadow-thickness)))
|
|
|
45 (and (integerp thickness)
|
|
|
46 (> thickness 0)))
|
|
771
|
47 "Whether the default toolbar is globally visible.
|
|
|
48 This option only has an effect when set using `customize-set-variable',
|
|
|
49 or through the Options menu."
|
|
442
|
50 :group 'display
|
|
|
51 :type 'boolean
|
|
|
52 :set #'(lambda (var val)
|
|
|
53 (if val
|
|
|
54 (set-specifier modeline-shadow-thickness 2)
|
|
|
55 (set-specifier modeline-shadow-thickness 0))
|
|
|
56 (redraw-modeline t)
|
|
|
57 (setq modeline-3d-p val))
|
|
|
58 )
|
|
|
59
|
|
428
|
60 (defcustom drag-divider-event-lag 150
|
|
|
61 "*The pause (in msecs) between divider drag events before redisplaying.
|
|
|
62 If this value is too small, dragging will be choppy because redisplay cannot
|
|
|
63 keep up. If it is too large, dragging will be choppy because of the explicit
|
|
|
64 redisplay delay specified."
|
|
|
65 :type 'integer
|
|
|
66 ;; #### Fix group.
|
|
|
67 :group 'modeline)
|
|
|
68
|
|
|
69 (define-obsolete-variable-alias
|
|
|
70 'drag-modeline-event-lag
|
|
|
71 'drag-divider-event-lag)
|
|
|
72
|
|
|
73 (defcustom modeline-click-swaps-buffers nil
|
|
|
74 "*If non-nil, clicking on the modeline changes the current buffer.
|
|
|
75 Click on the left half of the modeline cycles forward through the
|
|
|
76 buffer list and clicking on the right half cycles backward."
|
|
|
77 :type 'boolean
|
|
|
78 :group 'modeline)
|
|
|
79
|
|
438
|
80 (defcustom modeline-scrolling-method nil
|
|
|
81 "*If non-nil, dragging the modeline with the mouse may also scroll its
|
|
|
82 text horizontally (vertical motion controls window resizing and horizontal
|
|
|
83 motion controls modeline scrolling).
|
|
|
84
|
|
|
85 With a value of t, the modeline text is scrolled in the same direction as
|
|
|
86 the mouse motion. With a value of 'scrollbar, the modeline is considered as
|
|
771
|
87 a scrollbar for its own text, which then moves in the opposite direction.
|
|
|
88
|
|
|
89 This option should be set using `customize-set-variable'."
|
|
438
|
90 :type '(choice (const :tag "none" nil)
|
|
|
91 (const :tag "text" t)
|
|
|
92 (const :tag "scrollbar" scrollbar))
|
|
|
93 :set (lambda (sym val)
|
|
|
94 (set-default sym val)
|
|
|
95 (when (featurep 'x)
|
|
|
96 (cond ((eq val t)
|
|
|
97 (set-glyph-image modeline-pointer-glyph "hand2" 'global 'x))
|
|
|
98 ((eq val 'scrollbar)
|
|
|
99 (set-glyph-image modeline-pointer-glyph "fleur" 'global 'x))
|
|
|
100 (t
|
|
|
101 (set-glyph-image modeline-pointer-glyph "sb_v_double_arrow"
|
|
442
|
102 'global 'x))))
|
|
|
103 (when (featurep 'mswindows)
|
|
|
104 (cond ((eq val t)
|
|
|
105 (set-glyph-image modeline-pointer-glyph
|
|
|
106 [mswindows-resource :resource-type cursor
|
|
|
107 :resource-id "SizeAll"]
|
|
|
108 'global 'mswindows))
|
|
|
109 ((eq val 'scrollbar)
|
|
|
110 (set-glyph-image modeline-pointer-glyph
|
|
|
111 [mswindows-resource :resource-type cursor
|
|
|
112 :resource-id "Normal"]
|
|
|
113 'global 'mswindows))
|
|
|
114 (t
|
|
|
115 (set-glyph-image modeline-pointer-glyph
|
|
|
116 [mswindows-resource :resource-type cursor
|
|
|
117 :resource-id "SizeNS"]
|
|
|
118 'global 'mswindows)))))
|
|
438
|
119 :group 'modeline)
|
|
|
120
|
|
428
|
121 (defun mouse-drag-modeline (event)
|
|
|
122 "Resize a window by dragging its modeline.
|
|
|
123 This command should be bound to a button-press event in modeline-map.
|
|
|
124 Holding down a mouse button and moving the mouse up and down will
|
|
438
|
125 make the clicked-on window taller or shorter.
|
|
|
126
|
|
|
127 See also the variable `modeline-scrolling-method'."
|
|
428
|
128 (interactive "e")
|
|
|
129 (or (button-press-event-p event)
|
|
|
130 (error "%s must be invoked by a mouse-press" this-command))
|
|
|
131 (or (event-over-modeline-p event)
|
|
|
132 (error "not over a modeline"))
|
|
|
133 ;; Give the modeline a "pressed" look. --hniksic
|
|
|
134 (let-specifier ((modeline-shadow-thickness
|
|
|
135 (- (specifier-instance modeline-shadow-thickness
|
|
|
136 (event-window event)))
|
|
|
137 (event-window event)))
|
|
|
138 (let ((done nil)
|
|
|
139 (depress-line (event-y event))
|
|
|
140 (start-event-frame (event-frame event))
|
|
|
141 (start-event-window (event-window event))
|
|
|
142 (start-nwindows (count-windows t))
|
|
438
|
143 (hscroll-delta (face-width 'modeline))
|
|
|
144 (start-hscroll (modeline-hscroll (event-window event)))
|
|
|
145 (start-x-pixel (event-x-pixel event))
|
|
428
|
146 (last-timestamp 0)
|
|
|
147 default-line-height
|
|
|
148 modeline-height
|
|
|
149 should-enlarge-minibuffer
|
|
|
150 event min-height minibuffer y top bot edges wconfig growth)
|
|
|
151 (setq minibuffer (minibuffer-window start-event-frame)
|
|
|
152 default-line-height (face-height 'default start-event-window)
|
|
|
153 min-height (+ (* window-min-height default-line-height)
|
|
|
154 ;; Don't let the window shrink by a
|
|
|
155 ;; non-multiple of the default line
|
|
|
156 ;; height. (enlarge-window -1) will do
|
|
|
157 ;; this if the difference between the
|
|
|
158 ;; current window height and the minimum
|
|
|
159 ;; window height is less than the height
|
|
|
160 ;; of the default font. These extra
|
|
|
161 ;; lost pixels of height don't come back
|
|
|
162 ;; if you grow the window again. This
|
|
|
163 ;; can make it impossible to drag back
|
|
|
164 ;; to the exact original size, which is
|
|
|
165 ;; disconcerting.
|
|
|
166 (% (window-pixel-height start-event-window)
|
|
|
167 default-line-height))
|
|
|
168 modeline-height
|
|
|
169 (if (specifier-instance has-modeline-p start-event-window)
|
|
|
170 (+ (face-height 'modeline start-event-window)
|
|
|
171 (* 2 (specifier-instance modeline-shadow-thickness
|
|
|
172 start-event-window)))
|
|
|
173 (* 2 (specifier-instance modeline-shadow-thickness
|
|
|
174 start-event-window))))
|
|
|
175 (if (not (eq (window-frame minibuffer) start-event-frame))
|
|
|
176 (setq minibuffer nil))
|
|
|
177 (if (and (null minibuffer) (one-window-p t))
|
|
|
178 (error "Attempt to resize sole window"))
|
|
|
179 ;; if this is the bottommost ordinary window, then to
|
|
|
180 ;; move its modeline the minibuffer must be enlarged.
|
|
|
181 (setq should-enlarge-minibuffer
|
|
|
182 (and minibuffer (window-lowest-p start-event-window)))
|
|
|
183 ;; loop reading events
|
|
|
184 (while (not done)
|
|
|
185 (setq event (next-event event))
|
|
|
186 ;; requeue event and quit if this is a misc-user, eval or
|
|
|
187 ;; keypress event.
|
|
|
188 ;; quit if this is a button press or release event, or if the event
|
|
|
189 ;; occurred in some other frame.
|
|
|
190 ;; drag if this is a mouse motion event and the time
|
|
|
191 ;; between this event and the last event is greater than
|
|
|
192 ;; drag-divider-event-lag.
|
|
|
193 ;; do nothing if this is any other kind of event.
|
|
|
194 (cond ((or (misc-user-event-p event)
|
|
|
195 (key-press-event-p event))
|
|
|
196 (setq unread-command-events (nconc unread-command-events
|
|
|
197 (list event))
|
|
|
198 done t))
|
|
|
199 ((button-release-event-p event)
|
|
|
200 (setq done t)
|
|
|
201 ;; Consider we have a mouse click neither X pos (modeline
|
|
|
202 ;; scroll) nore Y pos (modeline drag) have changed.
|
|
|
203 (and modeline-click-swaps-buffers
|
|
|
204 (= depress-line (event-y event))
|
|
438
|
205 (or (not modeline-scrolling-method)
|
|
|
206 (= start-hscroll
|
|
|
207 (modeline-hscroll start-event-window)))
|
|
428
|
208 (modeline-swap-buffers event)))
|
|
|
209 ((button-event-p event)
|
|
|
210 (setq done t))
|
|
|
211 ((not (motion-event-p event))
|
|
|
212 (dispatch-event event))
|
|
|
213 ((not (eq start-event-frame (event-frame event)))
|
|
|
214 (setq done t))
|
|
|
215 ((< (abs (- (event-timestamp event) last-timestamp))
|
|
|
216 drag-divider-event-lag)
|
|
|
217 nil)
|
|
|
218 (t
|
|
438
|
219 (when modeline-scrolling-method
|
|
|
220 (let ((delta (/ (- (event-x-pixel event) start-x-pixel)
|
|
|
221 hscroll-delta)))
|
|
|
222 (set-modeline-hscroll start-event-window
|
|
|
223 (if (eq modeline-scrolling-method t)
|
|
|
224 (- start-hscroll delta)
|
|
|
225 (+ start-hscroll delta)))
|
|
|
226 ))
|
|
428
|
227 (setq last-timestamp (event-timestamp event)
|
|
|
228 y (event-y-pixel event)
|
|
|
229 edges (window-pixel-edges start-event-window)
|
|
|
230 top (nth 1 edges)
|
|
|
231 bot (nth 3 edges))
|
|
|
232 ;; scale back a move that would make the
|
|
|
233 ;; window too short.
|
|
|
234 (cond ((< (- y top (- modeline-height)) min-height)
|
|
|
235 (setq y (+ top min-height (- modeline-height)))))
|
|
|
236 ;; compute size change needed
|
|
|
237 (setq growth (- y bot (/ (- modeline-height) 2))
|
|
|
238 wconfig (current-window-configuration))
|
|
|
239 ;; grow/shrink minibuffer?
|
|
|
240 (if should-enlarge-minibuffer
|
|
|
241 (progn
|
|
|
242 ;; yes. scale back shrinkage if it
|
|
|
243 ;; would make the minibuffer less than 1
|
|
|
244 ;; line tall.
|
|
|
245 ;;
|
|
|
246 ;; also flip the sign of the computed growth,
|
|
|
247 ;; since if we want to grow the window with the
|
|
|
248 ;; modeline we need to shrink the minibuffer
|
|
|
249 ;; and vice versa.
|
|
|
250 (if (and (> growth 0)
|
|
|
251 (< (- (window-pixel-height minibuffer)
|
|
|
252 growth)
|
|
|
253 default-line-height))
|
|
|
254 (setq growth
|
|
|
255 (- (window-pixel-height minibuffer)
|
|
|
256 default-line-height)))
|
|
|
257 (setq growth (- growth))))
|
|
|
258 ;; window grow and shrink by lines not pixels, so
|
|
|
259 ;; divide the pixel height by the height of the
|
|
|
260 ;; default face.
|
|
|
261 (setq growth (/ growth default-line-height))
|
|
|
262 ;; grow/shrink the window
|
|
|
263 (enlarge-window growth nil (if should-enlarge-minibuffer
|
|
|
264 minibuffer
|
|
|
265 start-event-window))
|
|
|
266 ;; if this window's growth caused another
|
|
|
267 ;; window to be deleted because it was too
|
|
|
268 ;; short, rescind the change.
|
|
|
269 ;;
|
|
|
270 ;; if size change caused space to be stolen
|
|
|
271 ;; from a window above this one, rescind the
|
|
|
272 ;; change, but only if we didn't grow/shrink
|
|
|
273 ;; the minibuffer. minibuffer size changes
|
|
|
274 ;; can cause all windows to shrink... no way
|
|
|
275 ;; around it.
|
|
|
276 (if (or (/= start-nwindows (count-windows t))
|
|
|
277 (and (not should-enlarge-minibuffer)
|
|
|
278 (/= top (nth 1 (window-pixel-edges
|
|
|
279 start-event-window)))))
|
|
|
280 (set-window-configuration wconfig))))))))
|
|
|
281
|
|
|
282 ;; from Bob Weiner (bob_weiner@pts.mot.com)
|
|
|
283 ;; Whether this function should be called is now decided in
|
|
|
284 ;; mouse-drag-modeline - dverna feb. 98
|
|
|
285 (defun modeline-swap-buffers (event)
|
|
|
286 "Handle mouse clicks on modeline by switching buffers.
|
|
|
287 If click on left half of a frame's modeline, bury current buffer.
|
|
|
288 If click on right half of a frame's modeline, raise bottommost buffer.
|
|
|
289 Arg EVENT is the button release event that occurred on the modeline."
|
|
|
290 (or (event-over-modeline-p event)
|
|
|
291 (error "not over a modeline"))
|
|
|
292 (or (button-release-event-p event)
|
|
|
293 (error "not a button release event"))
|
|
|
294 (if (< (event-x event) (/ (window-width (event-window event)) 2))
|
|
|
295 ;; On left half of modeline, bury current buffer,
|
|
|
296 ;; displaying second buffer on list.
|
|
|
297 (mouse-bury-buffer event)
|
|
|
298 ;; On right half of modeline, raise and display bottommost
|
|
|
299 ;; buffer in buffer list.
|
|
|
300 (mouse-unbury-buffer event)))
|
|
|
301
|
|
|
302 (defconst modeline-menu
|
|
|
303 '("Window Commands"
|
|
|
304 ["Delete Window Above" delete-window t]
|
|
|
305 ["Delete Other Windows" delete-other-windows t]
|
|
|
306 ["Split Window Above" split-window-vertically t]
|
|
|
307 ["Split Window Horizontally" split-window-horizontally t]
|
|
|
308 ["Balance Windows" balance-windows t]
|
|
|
309 ))
|
|
|
310
|
|
|
311 (defun modeline-menu (event)
|
|
|
312 (interactive "e")
|
|
|
313 (popup-menu-and-execute-in-window
|
|
|
314 (cons (format "Window Commands for %S:"
|
|
|
315 (buffer-name (event-buffer event)))
|
|
|
316 (cdr modeline-menu))
|
|
|
317 event))
|
|
|
318
|
|
|
319 (defvar modeline-map (make-sparse-keymap 'modeline-map)
|
|
|
320 "Keymap consulted for mouse-clicks on the modeline of a window.
|
|
|
321 This variable may be buffer-local; its value will be looked up in
|
|
|
322 the buffer of the window whose modeline was clicked upon.")
|
|
|
323
|
|
|
324 (define-key modeline-map 'button1 'mouse-drag-modeline)
|
|
|
325 ;; button2 selects the window without setting point
|
|
|
326 (define-key modeline-map 'button2 (lambda () (interactive "@")))
|
|
|
327 (define-key modeline-map 'button3 'modeline-menu)
|
|
|
328
|
|
|
329 (make-face 'modeline-mousable "Face for mousable portions of the modeline.")
|
|
|
330 (set-face-parent 'modeline-mousable 'modeline nil '(default))
|
|
|
331 (when (featurep 'window-system)
|
|
440
|
332 (set-face-foreground 'modeline-mousable "firebrick" nil '(default color win))
|
|
|
333 (set-face-font 'modeline-mousable [bold] nil '(default mono win))
|
|
|
334 (set-face-font 'modeline-mousable [bold] nil '(default grayscale win)))
|
|
428
|
335
|
|
|
336 (defmacro make-modeline-command-wrapper (command)
|
|
|
337 `#'(lambda (event)
|
|
|
338 (interactive "e")
|
|
|
339 (save-selected-window
|
|
|
340 (select-window (event-window event))
|
|
|
341 (call-interactively ',(eval command)))))
|
|
|
342
|
|
|
343 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
344 ;;; Minor modes ;;;
|
|
|
345 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
346
|
|
|
347 (defvar minor-mode-alist nil
|
|
|
348 "Alist saying how to show minor modes in the modeline.
|
|
|
349 Each element looks like (VARIABLE STRING);
|
|
|
350 STRING is included in the modeline iff VARIABLE's value is non-nil.
|
|
|
351
|
|
|
352 Actually, STRING need not be a string; any possible modeline element
|
|
|
353 is okay. See `modeline-format'.")
|
|
|
354
|
|
|
355 ;; Used by C code (lookup-key and friends) but defined here.
|
|
|
356 (defvar minor-mode-map-alist nil
|
|
|
357 "Alist of keymaps to use for minor modes.
|
|
|
358 Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read
|
|
|
359 key sequences and look up bindings iff VARIABLE's value is non-nil.
|
|
|
360 If two active keymaps bind the same key, the keymap appearing earlier
|
|
|
361 in the list takes precedence.")
|
|
|
362
|
|
|
363 (make-face 'modeline-mousable-minor-mode
|
|
|
364 "Face for mousable minor-mode strings in the modeline.")
|
|
|
365 (set-face-parent 'modeline-mousable-minor-mode 'modeline-mousable nil
|
|
|
366 '(default))
|
|
|
367 (when (featurep 'window-system)
|
|
440
|
368 (set-face-foreground 'modeline-mousable-minor-mode '("green4" "forestgreen")
|
|
|
369 nil '(default color win)))
|
|
428
|
370
|
|
|
371 (defvar modeline-mousable-minor-mode-extent (make-extent nil nil)
|
|
|
372 ;; alliteration at its finest.
|
|
|
373 "Extent managing the mousable minor mode modeline strings.")
|
|
|
374 (set-extent-face modeline-mousable-minor-mode-extent
|
|
|
375 'modeline-mousable-minor-mode)
|
|
|
376
|
|
|
377 ;; This replaces the idiom
|
|
|
378 ;;
|
|
|
379 ;; (or (assq 'isearch-mode minor-mode-alist)
|
|
|
380 ;; (setq minor-mode-alist
|
|
|
381 ;; (purecopy
|
|
|
382 ;; (append minor-mode-alist
|
|
|
383 ;; '((isearch-mode isearch-mode))))))
|
|
|
384
|
|
|
385 (defun add-minor-mode (toggle name &optional keymap after toggle-fun)
|
|
|
386 "Add a minor mode to `minor-mode-alist' and `minor-mode-map-alist'.
|
|
|
387
|
|
|
388 TOGGLE is a symbol whose value as a variable specifies whether the
|
|
|
389 minor mode is active.
|
|
|
390
|
|
|
391 NAME is the name that should appear in the modeline. It should either
|
|
|
392 be a string beginning with a space, or a symbol with a similar string
|
|
|
393 as its value.
|
|
|
394
|
|
|
395 KEYMAP is a keymap to make active when the minor mode is active.
|
|
|
396
|
|
|
397 AFTER is the toggling symbol used for another minor mode. If AFTER is
|
|
|
398 non-nil, then it is used to position the new mode in the minor-mode
|
|
|
399 alists.
|
|
|
400
|
|
|
401 TOGGLE-FUN specifies an interactive function that is called to toggle
|
|
|
402 the mode on and off; this affects what happens when button2 is pressed
|
|
|
403 on the mode, and when button3 is pressed somewhere in the list of
|
|
|
404 modes. If TOGGLE-FUN is nil and TOGGLE names an interactive function,
|
|
|
405 TOGGLE is used as the toggle function.
|
|
|
406
|
|
|
407 Example: (add-minor-mode 'view-minor-mode \" View\" view-mode-map)"
|
|
|
408 (let* ((add-elt #'(lambda (elt sym)
|
|
|
409 (let (place)
|
|
|
410 (cond ((null after) ; add to front
|
|
|
411 (push elt (symbol-value sym)))
|
|
|
412 ((and (not (eq after t))
|
|
|
413 (setq place (memq (assq after
|
|
|
414 (symbol-value sym))
|
|
|
415 (symbol-value sym))))
|
|
|
416 (push elt (cdr place)))
|
|
|
417 (t
|
|
|
418 (set sym (append (symbol-value sym)
|
|
|
419 (list elt))))))
|
|
|
420 (symbol-value sym)))
|
|
|
421 el toggle-keymap)
|
|
|
422 (if toggle-fun
|
|
|
423 (check-argument-type 'commandp toggle-fun)
|
|
|
424 (when (commandp toggle)
|
|
|
425 (setq toggle-fun toggle)))
|
|
|
426 (when (and toggle-fun name)
|
|
|
427 (setq toggle-keymap (make-sparse-keymap
|
|
|
428 (intern (concat "modeline-minor-"
|
|
|
429 (symbol-name toggle)
|
|
|
430 "-map"))))
|
|
|
431 (define-key toggle-keymap 'button2
|
|
|
432 ;; defeat the DUMB-ASS byte-compiler, which tries to
|
|
|
433 ;; expand the macro at compile time and fucks up.
|
|
|
434 (eval '(make-modeline-command-wrapper toggle-fun)))
|
|
|
435 (put toggle 'modeline-toggle-function toggle-fun))
|
|
|
436 (when name
|
|
|
437 (let ((hacked-name
|
|
|
438 (if toggle-keymap
|
|
|
439 (cons (let ((extent (make-extent nil nil)))
|
|
|
440 (set-extent-keymap extent toggle-keymap)
|
|
|
441 (set-extent-property
|
|
|
442 extent 'help-echo
|
|
|
443 (concat "button2 turns off "
|
|
|
444 (if (symbolp toggle-fun)
|
|
|
445 (symbol-name toggle-fun)
|
|
|
446 (symbol-name toggle))))
|
|
|
447 extent)
|
|
|
448 (cons modeline-mousable-minor-mode-extent name))
|
|
|
449 name)))
|
|
|
450 (if (setq el (assq toggle minor-mode-alist))
|
|
|
451 (setcdr el (list hacked-name))
|
|
438
|
452 (funcall add-elt
|
|
428
|
453 (list toggle hacked-name)
|
|
|
454 'minor-mode-alist))))
|
|
|
455 (when keymap
|
|
|
456 (if (setq el (assq toggle minor-mode-map-alist))
|
|
|
457 (setcdr el keymap)
|
|
|
458 (funcall add-elt
|
|
|
459 (cons toggle keymap)
|
|
|
460 'minor-mode-map-alist)))))
|
|
|
461
|
|
695
|
462 (defcustom abbrev-mode-line-string " Abbrev"
|
|
|
463 "*String to display in the modeline when `abbrev-mode' is active.
|
|
|
464 Set this to nil if you don't want a modeline indicator."
|
|
|
465 :type '(choice string
|
|
729
|
466 (const :tag "none" nil))
|
|
|
467 :group 'abbrev-mode)
|
|
695
|
468
|
|
|
469 (defcustom overwrite-mode-line-string " Ovwrt"
|
|
|
470 "*String to display in the modeline when `overwrite-mode' is active.
|
|
|
471 Set this to nil if you don't want a modeline indicator."
|
|
|
472 :type '(choice string
|
|
729
|
473 (const :tag "none" nil))
|
|
|
474 :group 'editing-basics)
|
|
695
|
475
|
|
|
476 (defcustom auto-fill-mode-line-string " Fill"
|
|
|
477 "*String to display in the modeline when `auto-fill-mode' is active.
|
|
|
478 Set this to nil if you don't want a modeline indicator."
|
|
|
479 :type '(choice string
|
|
729
|
480 (const :tag "none" nil))
|
|
|
481 :group 'fill)
|
|
695
|
482
|
|
|
483 (defcustom defining-kbd-macro-mode-line-string " Def"
|
|
|
484 "*String to display in the modeline when `defining-kbd-macro' is active.
|
|
|
485 Set this to nil if you don't want a modeline indicator."
|
|
|
486 :type '(choice string
|
|
729
|
487 (const :tag "none" nil))
|
|
|
488 :group 'keyboard)
|
|
695
|
489
|
|
428
|
490 ;; #### TODO: Add `:menu-tag' keyword to add-minor-mode. Or create a
|
|
|
491 ;; separate function to manage the minor mode menu.
|
|
|
492
|
|
|
493 ;(put 'abbrev-mode :menu-tag "Abbreviation Expansion")
|
|
695
|
494 (add-minor-mode 'abbrev-mode 'abbrev-mode-line-string)
|
|
428
|
495 ;; only when visiting a file...
|
|
695
|
496 (add-minor-mode 'overwrite-mode 'overwrite-mode-line-string)
|
|
428
|
497 ;(put 'auto-fill-function :menu-tag "Auto Fill")
|
|
695
|
498 (add-minor-mode 'auto-fill-function 'auto-fill-mode-line-string
|
|
|
499 nil nil 'auto-fill-mode)
|
|
428
|
500
|
|
|
501 ;(put 'defining-kbd-macro :menu-tag "Keyboard Macro")
|
|
695
|
502 (add-minor-mode 'defining-kbd-macro 'defining-kbd-macro-mode-line-string
|
|
|
503 nil nil
|
|
428
|
504 (lambda ()
|
|
|
505 (interactive)
|
|
|
506 (if defining-kbd-macro
|
|
|
507 (progn
|
|
|
508 ;; #### This means to disregard the last event.
|
|
|
509 ;; It is needed because the last recorded
|
|
|
510 ;; event is usually the mouse event that
|
|
|
511 ;; invoked the menu item (and this function),
|
|
|
512 ;; and having it in the macro causes problems.
|
|
|
513 (zap-last-kbd-macro-event)
|
|
|
514 (end-kbd-macro nil))
|
|
|
515 (start-kbd-macro nil))))
|
|
|
516
|
|
|
517 (defun modeline-minor-mode-menu (event)
|
|
|
518 "The menu that pops up when you press `button3' inside the
|
|
|
519 parentheses on the modeline."
|
|
|
520 (interactive "e")
|
|
|
521 (save-excursion
|
|
|
522 (set-buffer (event-buffer event))
|
|
|
523 (popup-menu-and-execute-in-window
|
|
|
524 (cons
|
|
|
525 "Minor Mode Toggles"
|
|
|
526 (sort
|
|
|
527 (delq nil (mapcar
|
|
|
528 #'(lambda (x)
|
|
|
529 (let* ((toggle-sym (car x))
|
|
|
530 (toggle-fun (or (get toggle-sym
|
|
|
531 'modeline-toggle-function)
|
|
|
532 (and (commandp toggle-sym)
|
|
|
533 toggle-sym)))
|
|
|
534 (menu-tag (symbol-name (if (symbolp toggle-fun)
|
|
|
535 toggle-fun
|
|
|
536 toggle-sym))
|
|
|
537 ;; Here a function should
|
|
|
538 ;; maybe be invoked to
|
|
|
539 ;; beautify the symbol's
|
|
|
540 ;; menu appearance.
|
|
|
541 ))
|
|
|
542 (and toggle-fun
|
|
|
543 (vector menu-tag
|
|
|
544 toggle-fun
|
|
|
545 ;; The following two are wrong
|
|
|
546 ;; because of possible name
|
|
|
547 ;; clashes.
|
|
|
548 ;:active (get toggle-sym :active t)
|
|
|
549 ;:included (get toggle-sym :included t)
|
|
|
550 :style 'toggle
|
|
|
551 :selected (and (boundp toggle-sym)
|
|
|
552 toggle-sym)))))
|
|
|
553 minor-mode-alist))
|
|
|
554 (lambda (e1 e2)
|
|
|
555 (string< (aref e1 0) (aref e2 0)))))
|
|
|
556 event)))
|
|
|
557
|
|
|
558 (defvar modeline-minor-mode-map (make-sparse-keymap 'modeline-minor-mode-map)
|
|
|
559 "Keymap consulted for mouse-clicks on the minor-mode modeline list.")
|
|
|
560 (define-key modeline-minor-mode-map 'button3 'modeline-minor-mode-menu)
|
|
|
561
|
|
|
562 (defvar modeline-minor-mode-extent (make-extent nil nil)
|
|
|
563 "Extent covering the minor mode modeline strings.")
|
|
|
564 (set-extent-face modeline-minor-mode-extent 'modeline-mousable)
|
|
|
565 (set-extent-keymap modeline-minor-mode-extent modeline-minor-mode-map)
|
|
|
566
|
|
|
567
|
|
|
568 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
771
|
569 ;;; Modeline definition ;;;
|
|
428
|
570 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
571
|
|
771
|
572 (defmacro define-modeline-control (name contents doc-string &optional face
|
|
|
573 help-echo)
|
|
|
574 "Define a modeline control named NAME, a symbol.
|
|
|
575 A modeline control is a section of the modeline whose contents can easily
|
|
|
576 be changed independently of the rest of the modeline, which can have its
|
|
|
577 own color, and which can have its own mouse commands, which apply when the
|
|
|
578 mouse is over the control.
|
|
|
579
|
|
|
580 Logically, a modeline control should be an object; but we have terrible
|
|
|
581 object support in XEmacs, and so history has given us a series of related
|
|
|
582 variables, which [hopefully] all follow the same conventions.
|
|
|
583
|
|
|
584 Three variables are created:
|
|
|
585
|
|
|
586 1. The variable holding the control specification is called
|
|
|
587 `modeline-NAME', and is automatically buffer-local.
|
|
|
588
|
|
|
589 2. The variable holding the extent that covers the control area in the
|
|
|
590 modeline is called `modeline-NAME-extent'. Onto this extent, colors and
|
|
|
591 keymaps (and possibly glyphs?) can be added, and will be noticed by the
|
|
|
592 modeline redisplay code. The attachment of the extent and its control
|
|
|
593 is done somewhere in the modeline specification: either in the main spec
|
|
|
594 in `modeline-format', or in some other control, like this:
|
|
|
595
|
|
|
596 (cons modeline-NAME-extent 'modeline-NAME)
|
|
|
597
|
|
|
598 3. The keymap holding the mousable commands for the control is called
|
|
|
599 `modeline-NAME-map'. This is automatically attached to the extent by
|
|
|
600 this macro.
|
|
|
601
|
|
|
602 Initial contents of the control are CONTENTS (see `modeline-format' for
|
|
|
603 information about the structure of this contents). DOC-STRING specifies
|
|
|
604 help text that will be placed in the control variable's documentation,
|
|
|
605 indicating what's supposed to be in the control.
|
|
|
606
|
|
|
607 Optional argument FACE specifies the face of the control's
|
|
|
608 extent. (`modeline-mousable' is a good choice if your control is, in fact,
|
|
|
609 mousable (i.e. it has some mouse commands defined for it). Optional
|
|
|
610 argument HELP-ECHO specifies some help-echo to be displayed when the mouse
|
|
|
611 moves over the control, indicating what mouse strokes are available. "
|
|
|
612 (let ((control-var (intern (format "modeline-%s" name)))
|
|
|
613 (extent-var (intern (format "modeline-%s-extent" name)))
|
|
|
614 (map-var (intern (format "modeline-%s-map" name)))
|
|
|
615 )
|
|
|
616 `(progn
|
|
|
617 (defconst ,control-var ,contents
|
|
|
618 ,(format "%s
|
|
|
619
|
|
|
620 The format of the contents of this variable is documented in
|
|
|
621 `modeline-format'. The way the control is displayed can be changed by
|
|
|
622 setting the face of `%s'. Mouse commands
|
|
|
623 for the control can be set using `%s'." doc-string extent-var map-var))
|
|
|
624 (make-variable-buffer-local ',control-var)
|
|
|
625 (defvar ,extent-var (make-extent nil nil)
|
|
|
626 ,(format "Extent covering the `%s' control." control-var))
|
|
|
627 (defvar ,map-var (make-sparse-keymap 'modeline-narrowed-map)
|
|
|
628 ,(format "Keymap consulted for mouse-clicks on the `%s' control."
|
|
|
629 control-var))
|
|
|
630 (set-extent-face ,extent-var ,face)
|
|
|
631 (set-extent-keymap ,extent-var ,map-var)
|
|
|
632 (set-extent-property ,extent-var 'help-echo ,help-echo))))
|
|
|
633 (put 'define-modeline-control 'lisp-indent-function 2)
|
|
|
634
|
|
|
635 ;; ------------------------ modeline buffer id -------------------
|
|
|
636
|
|
428
|
637 (defun modeline-buffers-menu (event)
|
|
|
638 (interactive "e")
|
|
|
639 (popup-menu-and-execute-in-window
|
|
|
640 '("Buffers Popup Menu"
|
|
|
641 :filter buffers-menu-filter
|
|
|
642 ["List All Buffers" list-buffers t]
|
|
|
643 "--"
|
|
|
644 )
|
|
|
645 event))
|
|
|
646
|
|
771
|
647 (define-modeline-control buffer-id-left
|
|
|
648 'modeline-modified-buffer-highlighted-name ;; "XEmacs:"
|
|
|
649 "Modeline control for left half of buffer ID."
|
|
|
650 'modeline-mousable
|
|
|
651 "button2 cycles to the previous buffer")
|
|
428
|
652
|
|
771
|
653 (define-modeline-control buffer-id-right
|
|
|
654 'modeline-modified-buffer-non-highlighted-name ;; " %17b"
|
|
|
655 "Modeline control for right half of buffer ID."
|
|
|
656 nil
|
|
|
657 "button2 cycles to the next buffer")
|
|
428
|
658
|
|
|
659 (define-key modeline-buffer-id-left-map 'button2 'mouse-unbury-buffer)
|
|
|
660 (define-key modeline-buffer-id-right-map 'button2 'mouse-bury-buffer)
|
|
|
661 (define-key modeline-buffer-id-left-map 'button3 'modeline-buffers-menu)
|
|
|
662 (define-key modeline-buffer-id-right-map 'button3 'modeline-buffers-menu)
|
|
|
663
|
|
|
664 (make-face 'modeline-buffer-id
|
|
|
665 "Face for the buffer ID string in the modeline.")
|
|
|
666 (set-face-parent 'modeline-buffer-id 'modeline nil '(default))
|
|
|
667 (when (featurep 'window-system)
|
|
440
|
668 (set-face-foreground 'modeline-buffer-id "blue4" nil '(default color win))
|
|
|
669 (set-face-font 'modeline-buffer-id [bold-italic] nil '(default mono win))
|
|
771
|
670 (set-face-font 'modeline-buffer-id [bold-italic] nil '(default grayscale
|
|
|
671 win)))
|
|
428
|
672 (when (featurep 'tty)
|
|
|
673 (set-face-font 'modeline-buffer-id [bold-italic] nil '(default tty)))
|
|
|
674
|
|
771
|
675 (define-modeline-control buffer-id
|
|
|
676 (list (cons modeline-buffer-id-left-extent 'modeline-buffer-id-left)
|
|
|
677 (cons modeline-buffer-id-right-extent 'modeline-buffer-id-right))
|
|
428
|
678 "Modeline control for identifying the buffer being displayed.
|
|
442
|
679 Its default value is
|
|
|
680
|
|
771
|
681 (list (cons modeline-buffer-id-left-extent 'modeline-buffer-id-left)
|
|
|
682 (cons modeline-buffer-id-right-extent 'modeline-buffer-id-right))
|
|
442
|
683
|
|
|
684 Major modes that edit things other than ordinary files may change this
|
|
771
|
685 (e.g. Info, Dired,...)."
|
|
|
686 'modeline-buffer-id)
|
|
|
687
|
|
|
688 (defvaralias 'modeline-buffer-identification 'modeline-buffer-id)
|
|
|
689
|
|
|
690 (defvar modeline-modified-buffer-non-highlighted-name nil)
|
|
|
691 (make-variable-buffer-local 'modeline-modified-buffer-non-highlighted-name)
|
|
|
692 (put 'modeline-modified-buffer-non-highlighted-name 'permanent-local t)
|
|
|
693
|
|
|
694 (defvar modeline-modified-buffer-highlighted-name nil)
|
|
|
695 (make-variable-buffer-local 'modeline-modified-buffer-highlighted-name)
|
|
|
696 (put 'modeline-modified-buffer-highlighted-name 'permanent-local t)
|
|
|
697
|
|
|
698 (defvar modeline-recorded-buffer-name nil)
|
|
|
699 (make-variable-buffer-local 'modeline-recorded-buffer-name)
|
|
|
700 (put 'modeline-recorded-buffer-name 'permanent-local t)
|
|
|
701
|
|
|
702 (defvar modeline-recorded-buffer-file-name nil)
|
|
|
703 (make-variable-buffer-local 'modeline-recorded-buffer-file-name)
|
|
|
704 (put 'modeline-recorded-buffer-file-name 'permanent-local t)
|
|
|
705
|
|
|
706 (add-hook 'buffer-list-changed-hook 'modeline-update-buffer-names)
|
|
|
707
|
|
|
708 (defvar modeline-max-buffer-name-size 30)
|
|
|
709
|
|
|
710 (defun modeline-update-buffer-names (frame)
|
|
|
711 (mapc #'(lambda (buf)
|
|
|
712 (when (or (not (eq (buffer-name buf)
|
|
|
713 (symbol-value-in-buffer
|
|
|
714 'modeline-recorded-buffer-name buf)))
|
|
|
715 (not (eq (buffer-file-name buf)
|
|
|
716 (symbol-value-in-buffer
|
|
|
717 'modeline-recorded-buffer-file-name buf))))
|
|
|
718 ;(dp "processing %s" buf)
|
|
|
719 (with-current-buffer buf
|
|
|
720 (setq modeline-recorded-buffer-name (buffer-name))
|
|
|
721 (setq modeline-recorded-buffer-file-name (buffer-file-name))
|
|
|
722 (if (not modeline-recorded-buffer-file-name)
|
|
|
723 (setq modeline-modified-buffer-non-highlighted-name
|
|
|
724 modeline-recorded-buffer-name
|
|
|
725 modeline-modified-buffer-highlighted-name nil)
|
|
|
726 (let ((fn
|
|
|
727 (if (<= (length modeline-recorded-buffer-file-name)
|
|
|
728 modeline-max-buffer-name-size)
|
|
|
729 modeline-recorded-buffer-file-name
|
|
|
730 (concat "..."
|
|
|
731 (substring
|
|
|
732 modeline-recorded-buffer-file-name
|
|
|
733 (- modeline-max-buffer-name-size))))))
|
|
|
734 (setq modeline-modified-buffer-non-highlighted-name
|
|
|
735 ;; if the filename is very long, the entire
|
|
|
736 ;; directory will get truncated to
|
|
|
737 ;; non-existence.
|
|
|
738 (let ((dir (file-name-directory fn)))
|
|
|
739 (if dir
|
|
|
740 (concat " ("
|
|
|
741 (directory-file-name
|
|
|
742 (file-name-directory fn))
|
|
|
743 ")")
|
|
|
744 ""))
|
|
|
745 modeline-modified-buffer-highlighted-name
|
|
|
746 (file-name-nondirectory fn))))
|
|
|
747 (redraw-modeline))))
|
|
|
748 (buffer-list)))
|
|
|
749
|
|
|
750 (defcustom modeline-new-buffer-id-format t
|
|
|
751 "Whether the new format for the modeline buffer ID (with directory) is used.
|
|
|
752 This option only has an effect when set using `customize-set-variable',
|
|
|
753 or through the Options menu."
|
|
|
754 :group 'modeline
|
|
|
755 :type 'boolean
|
|
|
756 :set #'(lambda (var val)
|
|
|
757 (if val
|
|
|
758 (progn
|
|
|
759 (setq-default modeline-buffer-id-left
|
|
|
760 'modeline-modified-buffer-highlighted-name
|
|
|
761 modeline-buffer-id-right
|
|
|
762 'modeline-modified-buffer-non-highlighted-name)
|
|
|
763 (set-extent-face modeline-buffer-id-left-extent
|
|
|
764 'modeline-mousable))
|
|
|
765 (setq-default modeline-buffer-id-left "XEmacs:"
|
|
|
766 modeline-buffer-id-right '(" %17b"))
|
|
|
767 (set-extent-face modeline-buffer-id-left-extent nil))))
|
|
|
768
|
|
|
769 ;; ------------------------ other modeline controls -------------------
|
|
428
|
770
|
|
|
771 ;; These are for the sake of minor mode menu. #### All of this is
|
|
|
772 ;; kind of dirty. `add-minor-mode' started out as a simple substitute
|
|
|
773 ;; for (or (assq ...) ...) FSF stuff, but now is used for all kind of
|
|
|
774 ;; stuff. There should perhaps be a separate function to add toggles
|
|
|
775 ;; to the minor-mode-menu.
|
|
|
776 (add-minor-mode 'line-number-mode "")
|
|
|
777 (add-minor-mode 'column-number-mode "")
|
|
|
778
|
|
771
|
779 (define-modeline-control coding-system '("%C")
|
|
|
780 "Modeline control for showing current coding system.")
|
|
|
781 ;; added March 7, 2002
|
|
|
782 (define-obsolete-variable-alias 'modeline-multibyte-status
|
|
|
783 'modeline-coding-system)
|
|
428
|
784
|
|
771
|
785 (define-modeline-control modified '("--%1*%1+-")
|
|
|
786 "Modeline control for displaying whether current buffer is modified."
|
|
|
787 'modeline-mousable
|
|
|
788 "button2 toggles the buffer's read-only status")
|
|
428
|
789 (define-key modeline-modified-map 'button2
|
|
|
790 (make-modeline-command-wrapper 'modeline-toggle-read-only))
|
|
|
791
|
|
|
792 ;;; Added for XEmacs 20.3. Provide wrapper for vc since it may not always be
|
|
|
793 ;;; present, and its symbols are not visible this early in the dump if it
|
|
|
794 ;;; is.
|
|
|
795
|
|
|
796 (defun modeline-toggle-read-only ()
|
|
|
797 "Change whether this buffer is visiting its file read-only.
|
|
|
798 With arg, set read-only iff arg is positive.
|
|
|
799 This function is designed to be called when the read-only indicator on the
|
|
|
800 modeline is clicked. It will call `vc-toggle-read-only' if available,
|
|
|
801 otherwise it will call the usual `toggle-read-only'."
|
|
|
802 (interactive)
|
|
502
|
803 (if-fboundp 'vc-toggle-read-only
|
|
428
|
804 (vc-toggle-read-only)
|
|
|
805 (toggle-read-only)))
|
|
|
806
|
|
771
|
807 (define-modeline-control line-number (list 'line-number-mode "L%l ")
|
|
|
808 "Modeline control for displaying the line number of point.")
|
|
|
809 (define-modeline-control column-number (list 'column-number-mode "C%c ")
|
|
|
810 "Modeline control for displaying the column number of point.")
|
|
|
811 (define-modeline-control percentage (cons -3 "%p")
|
|
|
812 "Modeline control for displaying percentage of file above point.")
|
|
|
813
|
|
|
814 (define-modeline-control position-status
|
|
|
815 (cons 15 (list
|
|
|
816 (cons modeline-line-number-extent
|
|
|
817 'modeline-line-number)
|
|
|
818 (cons modeline-column-number-extent
|
|
|
819 'modeline-column-number)
|
|
|
820 (cons modeline-percentage-extent
|
|
|
821 'modeline-percentage)))
|
|
|
822 "Modeline control for providing status about the location of point.
|
|
|
823 Generally includes the line number of point, its column number, and the
|
|
|
824 percentage of the file above point."
|
|
|
825 'modeline-buffer-id)
|
|
|
826
|
|
|
827 (defconst modeline-tty-frame-specifier (make-specifier 'boolean))
|
|
|
828 (add-hook 'create-frame-hook 'modeline-update-tty-frame-specifier)
|
|
|
829 (defun modeline-update-tty-frame-specifier (f)
|
|
|
830 (if-fboundp 'frame-tty-p
|
|
|
831 (if (and (frame-tty-p f)
|
|
|
832 (> (frame-property f 'frame-number) 1))
|
|
|
833 (set-specifier modeline-tty-frame-specifier t f))))
|
|
|
834
|
|
|
835 (define-modeline-control tty-frame-id (list modeline-tty-frame-specifier
|
|
|
836 " [%S]"
|
|
|
837 )
|
|
|
838 "Modeline control for showing which TTY frame is selected.")
|
|
|
839
|
|
|
840 (define-modeline-control narrowed '("%n")
|
|
|
841 "Modeline control for displaying whether current buffer is narrowed."
|
|
|
842 'modeline-mousable
|
|
|
843 "button2 widens the buffer")
|
|
|
844 (define-key modeline-narrowed-map 'button2
|
|
|
845 (make-modeline-command-wrapper 'widen))
|
|
|
846
|
|
|
847 (define-modeline-control process nil
|
|
|
848 "Modeline control for displaying info on process status.
|
|
|
849 Normally nil in most modes, since there is no process to display.")
|
|
|
850
|
|
|
851 (setq-default
|
|
|
852 modeline-format
|
|
|
853 (list
|
|
|
854 ""
|
|
|
855 (cons modeline-coding-system-extent 'modeline-coding-system)
|
|
|
856 (cons modeline-modified-extent 'modeline-modified)
|
|
|
857 (cons modeline-position-status-extent 'modeline-position-status)
|
|
|
858 (cons modeline-tty-frame-id-extent 'modeline-tty-frame-id)
|
|
|
859 (cons modeline-buffer-id-extent 'modeline-buffer-id)
|
|
|
860 " "
|
|
|
861 'global-mode-string
|
|
|
862 " %[("
|
|
|
863 (cons modeline-minor-mode-extent
|
|
|
864 (list "" 'mode-name 'minor-mode-alist))
|
|
|
865 (cons modeline-narrowed-extent 'modeline-narrowed)
|
|
|
866 (cons modeline-process-extent 'modeline-process)
|
|
|
867 ")%]%-"))
|
|
|
868
|
|
428
|
869 ;;; modeline.el ends here
|
