0
|
1 ;;; modeline.el --- modeline hackery.
|
|
2
|
|
3 ;; Copyright (C) 1988, 1992, 1993, 1994 Free Software Foundation, Inc.
|
|
4 ;; Copyright (C) 1995, 1996 Ben Wing.
|
|
5
|
|
6 ;; This file is part of XEmacs.
|
|
7
|
|
8 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
9 ;; under the terms of the GNU General Public License as published by
|
|
10 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
11 ;; any later version.
|
|
12
|
|
13 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
14 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
16 ;; General Public License for more details.
|
|
17
|
|
18 ;; You should have received a copy of the GNU General Public License
|
16
|
19 ;; along with XEmacs; see the file COPYING. If not, write to the
|
70
|
20 ;; Free Software Foundation, 59 Temple Place - Suite 330,
|
16
|
21 ;; Boston, MA 02111-1307, USA.
|
0
|
22
|
|
23 ;;; Synched up with: Not in FSF.
|
|
24
|
|
25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
26 ;;; General mouse modeline stuff ;;;
|
|
27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
28
|
|
29 (defvar drag-modeline-event-lag 150
|
|
30 "*The amount of time to wait (in msecs) between drag modeline events
|
|
31 before updating the display. If this value is too small, dragging will
|
|
32 be choppy because redisplay cannot keep up. If it is too large, dragging
|
|
33 will be choppy because of the explicit redisplay delay specified.")
|
|
34
|
|
35 (defvar modeline-click-swaps-buffers nil
|
|
36 "*If non-nil, clicking on the modeline changes the current buffer.
|
|
37 Click on the left half of the modeline cycles forward through the
|
|
38 buffer list and clicking on the right half cycles backward.")
|
|
39
|
|
40 (defun mouse-drag-modeline (event)
|
|
41 "Resize the window by dragging the modeline.
|
|
42 This should be bound to a mouse button in `modeline-map'."
|
|
43 (interactive "e")
|
|
44 (or (button-press-event-p event)
|
|
45 (error "%s must be invoked by a mouse-press" this-command))
|
|
46 (or (event-over-modeline-p event)
|
|
47 (error "not over a modeline"))
|
|
48 (let ((depress-line (event-y event))
|
|
49 (mouse-down t)
|
|
50 (window (event-window event))
|
|
51 (old-window (selected-window))
|
|
52 (def-line-height (face-height 'default))
|
|
53 (prior-drag-modeline-event-time 0)
|
|
54 delta)
|
|
55 (while mouse-down
|
|
56 (setq event (next-event event))
|
|
57 (cond ((motion-event-p event)
|
|
58 (if (window-lowest-p window)
|
|
59 (error "can't drag bottommost modeline"))
|
|
60 (cond ((> (- (event-timestamp event)
|
|
61 prior-drag-modeline-event-time)
|
|
62 drag-modeline-event-lag)
|
|
63
|
|
64 (setq prior-drag-modeline-event-time (event-timestamp event))
|
|
65
|
|
66 (if (event-over-modeline-p event)
|
|
67 (setq delta 0)
|
|
68 (setq delta (- (event-y-pixel event)
|
|
69 (nth 3 (window-pixel-edges window))))
|
|
70 (if (> delta 0)
|
|
71 (setq delta (+ delta def-line-height)))
|
|
72 (setq delta (/ delta def-line-height)))
|
|
73
|
|
74 ;; cough sputter hack kludge. It shouldn't be possible
|
|
75 ;; to get in here when we are over the minibuffer. But
|
|
76 ;; it is happening and that cause next-vertical-window to
|
|
77 ;; return nil which does not lead to window-height returning
|
|
78 ;; anything remotely resembling a sensible value. So catch
|
|
79 ;; the situation and die a happy death.
|
|
80 ;;
|
|
81 ;; Oh, and the BLAT FOOP error messages suck as well but
|
|
82 ;; I don't know what should be there. This should be
|
|
83 ;; looked at again when the new redisplay is done.
|
|
84 (if (not (next-vertical-window window))
|
|
85 (error "Try again: dragging in minibuffer does nothing"))
|
|
86 (cond ((and (> delta 0)
|
|
87 (<= (- (window-height (next-vertical-window window))
|
|
88 delta)
|
|
89 window-min-height))
|
|
90 (setq delta (- (window-height
|
|
91 (next-vertical-window window))
|
|
92 window-min-height))
|
|
93 (if (< delta 0) (error "BLAT")))
|
|
94 ((and (< delta 0)
|
|
95 (< (+ (window-height window) delta)
|
|
96 window-min-height))
|
|
97 (setq delta (- window-min-height
|
|
98 (window-height window)))
|
|
99 (if (> delta 0) (error "FOOP"))))
|
|
100 (if (= delta 0)
|
|
101 nil
|
|
102 (select-window window)
|
|
103 (enlarge-window delta)
|
|
104 ;; The call to enlarge-window may have caused the old
|
|
105 ;; window to disappear. Don't try and select it in
|
|
106 ;; that case.
|
|
107 (if (window-live-p old-window)
|
|
108 (select-window old-window))
|
|
109 (sit-for 0)
|
|
110 ))))
|
|
111 ((button-release-event-p event)
|
|
112 (setq mouse-down nil)
|
|
113 (if modeline-click-swaps-buffers
|
|
114 (mouse-release-modeline event depress-line)))
|
|
115 ((or (button-press-event-p event)
|
|
116 (key-press-event-p event))
|
|
117 (error ""))
|
|
118 (t
|
|
119 (dispatch-event event)))
|
|
120 )))
|
|
121
|
|
122 ;; from Bob Weiner (bob_weiner@pts.mot.com)
|
|
123 (defun mouse-release-modeline (event line-num)
|
|
124 "Handle modeline click EVENT on LINE-NUM by switching buffers.
|
|
125 If click on left half of a frame's modeline, bury current buffer.
|
|
126 If click on right half of a frame's modeline, raise bottommost buffer.
|
|
127 Args are: EVENT, the mouse release event, and LINE-NUM, the line number
|
|
128 within the frame at which the mouse was first depressed."
|
|
129 (if (= line-num (event-y event))
|
|
130 ;; Button press and release are at same line, treat this as
|
|
131 ;; a click and switch buffers.
|
|
132 (if (< (event-x event) (/ (window-width (event-window event)) 2))
|
|
133 ;; On left half of modeline, bury current buffer,
|
|
134 ;; displaying second buffer on list.
|
|
135 (mouse-bury-buffer event)
|
|
136 ;; On right half of modeline, raise and display bottommost
|
|
137 ;; buffer in buffer list.
|
|
138 (mouse-unbury-buffer event))))
|
|
139
|
|
140 (defconst modeline-menu
|
|
141 '("Window Commands"
|
|
142 ["Delete Window Above" delete-window t]
|
|
143 ["Delete Other Windows" delete-other-windows t]
|
|
144 ["Split Window Above" split-window-vertically t]
|
|
145 ["Split Window Horizontally" split-window-horizontally t]
|
|
146 ["Balance Windows" balance-windows t]
|
|
147 ))
|
|
148
|
|
149 (defun modeline-menu (event)
|
|
150 (interactive "e")
|
|
151 (popup-menu-and-execute-in-window
|
|
152 (cons (format "Window Commands for %S:"
|
|
153 (buffer-name (event-buffer event)))
|
|
154 (cdr modeline-menu))
|
|
155 event))
|
|
156
|
|
157 (defvar modeline-map (make-sparse-keymap 'modeline-map)
|
|
158 "Keymap consulted for mouse-clicks on the modeline of a window.
|
|
159 This variable may be buffer-local; its value will be looked up in
|
|
160 the buffer of the window whose modeline was clicked upon.")
|
|
161
|
|
162 (define-key modeline-map 'button1 'mouse-drag-modeline)
|
|
163 ;; button2 selects the window without setting point
|
|
164 (define-key modeline-map 'button2 (lambda () (interactive "@")))
|
|
165 (define-key modeline-map 'button3 'modeline-menu)
|
|
166
|
|
167 (make-face 'modeline-mousable "Face for mousable portions of the modeline.")
|
|
168
|
|
169 (defmacro make-modeline-command-wrapper (command)
|
|
170 `#'(lambda (event)
|
|
171 (interactive "e")
|
|
172 (save-selected-window
|
|
173 (select-window (event-window event))
|
|
174 (call-interactively ',(eval command)))))
|
|
175
|
|
176 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
177 ;;; Minor modes ;;;
|
|
178 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
179
|
|
180 (defvar minor-mode-alist nil
|
|
181 "Alist saying how to show minor modes in the modeline.
|
|
182 Each element looks like (VARIABLE STRING);
|
|
183 STRING is included in the modeline iff VARIABLE's value is non-nil.
|
|
184
|
|
185 Actually, STRING need not be a string; any possible modeline element
|
|
186 is okay. See `modeline-format'.")
|
|
187
|
|
188 ;; Used by C code (lookup-key and friends) but defined here.
|
|
189 (defvar minor-mode-map-alist nil
|
|
190 "Alist of keymaps to use for minor modes.
|
|
191 Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read
|
|
192 key sequences and look up bindings iff VARIABLE's value is non-nil.
|
|
193 If two active keymaps bind the same key, the keymap appearing earlier
|
|
194 in the list takes precedence.")
|
|
195
|
|
196 (make-face 'modeline-mousable-minor-mode
|
|
197 "Face for mousable minor-mode strings in the modeline.")
|
|
198
|
|
199 (defvar modeline-mousable-minor-mode-extent (make-extent nil nil)
|
|
200 ;; alliteration at its finest.
|
|
201 "Extent managing the mousable minor mode modeline strings.")
|
|
202 (set-extent-face modeline-mousable-minor-mode-extent
|
|
203 'modeline-mousable-minor-mode)
|
|
204
|
|
205 ;; This replaces the idiom
|
|
206 ;;
|
|
207 ;; (or (assq 'isearch-mode minor-mode-alist)
|
|
208 ;; (setq minor-mode-alist
|
|
209 ;; (purecopy
|
|
210 ;; (append minor-mode-alist
|
|
211 ;; '((isearch-mode isearch-mode))))))
|
|
212
|
|
213 (defun add-minor-mode (toggle name &optional keymap after toggle-fun)
|
|
214 "Add a minor mode to `minor-mode-alist' and `minor-mode-map-alist'.
|
|
215 TOGGLE is a symbol whose value as a variable specifies whether the
|
|
216 minor mode is active. NAME is the name that should appear in the
|
|
217 modeline (it should be a string beginning with a space). KEYMAP is a
|
|
218 keymap to make active when the minor mode is active. AFTER is the
|
|
219 toggling symbol used for another minor mode. If AFTER is non-nil,
|
|
220 then it is used to position the new mode in the minor-mode alists.
|
|
221 TOGGLE-FUN specifies an interactive function that is called to toggle
|
|
222 the mode on and off; this affects what happens when button2 is pressed
|
|
223 on the mode, and when button3 is pressed somewhere in the list of
|
|
224 modes. If TOGGLE-FUN is nil and TOGGLE names an interactive function,
|
|
225 TOGGLE is used as the toggle function.
|
|
226
|
|
227 Example: (add-minor-mode 'view-minor-mode \" View\" view-mode-map)"
|
|
228 (let (el place
|
|
229 (add-elt #'(lambda (elt sym)
|
|
230 (cond ((null after) ; add to front
|
|
231 (set sym (cons elt (symbol-value sym))))
|
|
232 ((and (not (eq after t))
|
|
233 (setq place (memq (assq after
|
|
234 (symbol-value sym))
|
|
235 (symbol-value sym))))
|
|
236 (setq elt (cons elt (cdr place)))
|
|
237 (setcdr place elt))
|
|
238 (t
|
|
239 (set sym (append (symbol-value sym) (list elt))))
|
|
240 )
|
|
241 (symbol-value sym)))
|
|
242 toggle-keymap)
|
|
243 (if toggle-fun
|
|
244 (if (not (commandp toggle-fun))
|
|
245 (error "not an interactive function: %S" toggle-fun))
|
|
246 (if (commandp toggle)
|
|
247 (setq toggle-fun toggle)))
|
|
248 (if (and toggle-fun name)
|
|
249 (progn
|
|
250 (setq toggle-keymap (make-sparse-keymap
|
|
251 (intern (concat "modeline-minor-"
|
|
252 (symbol-name toggle)
|
|
253 "-map"))))
|
|
254 (define-key toggle-keymap 'button2
|
|
255 ;; defeat the DUMB-ASS byte-compiler, which tries to
|
|
256 ;; expand the macro at compile time and fucks up.
|
|
257 (eval '(make-modeline-command-wrapper toggle-fun)))
|
|
258 (put toggle 'modeline-toggle-function toggle-fun)))
|
|
259 (and name
|
|
260 (let ((hacked-name
|
|
261 (if toggle-keymap
|
|
262 (cons (let ((extent (make-extent nil nil)))
|
|
263 (set-extent-keymap extent toggle-keymap)
|
|
264 (set-extent-property
|
|
265 extent 'help-echo
|
|
266 (concat "button2 turns off "
|
|
267 (if (symbolp toggle-fun)
|
|
268 (symbol-name toggle-fun)
|
|
269 (symbol-name toggle))))
|
|
270 extent)
|
|
271 (cons
|
|
272 modeline-mousable-minor-mode-extent
|
|
273 name))
|
|
274 name)))
|
|
275 (if (setq el (assq toggle minor-mode-alist))
|
|
276 (setcdr el (list hacked-name))
|
|
277 (funcall add-elt
|
|
278 (list toggle hacked-name)
|
|
279 'minor-mode-alist))))
|
|
280 (and keymap
|
|
281 (if (setq el (assq toggle minor-mode-map-alist))
|
|
282 (setcdr el keymap)
|
|
283 (funcall add-elt
|
|
284 (cons toggle keymap)
|
|
285 'minor-mode-map-alist)))
|
|
286 ))
|
|
287
|
|
288 (add-minor-mode 'abbrev-mode " Abbrev")
|
|
289 (add-minor-mode 'overwrite-mode 'overwrite-mode)
|
|
290 (add-minor-mode 'auto-fill-function " Fill" nil nil 'auto-fill-mode)
|
|
291 ;; not really a minor mode...
|
|
292 (add-minor-mode 'defining-kbd-macro " Def")
|
|
293
|
|
294 (defun modeline-minor-mode-menu (event)
|
|
295 (interactive "e")
|
70
|
296 (popup-menu-and-execute-in-window
|
|
297 (cons (format "Minor Mode Commands for %S:"
|
|
298 (buffer-name (event-buffer event)))
|
|
299 (apply 'nconc
|
|
300 (mapcar
|
|
301 #'(lambda (x)
|
|
302 (let* ((toggle-sym (car x))
|
|
303 (toggle-fun
|
|
304 (or (get toggle-sym
|
|
305 'modeline-toggle-function)
|
|
306 (and (fboundp toggle-sym)
|
|
307 (commandp toggle-sym)
|
|
308 toggle-sym))))
|
|
309 (if (not toggle-fun) nil
|
|
310 (list (vector
|
|
311 (concat (if (and (boundp toggle-sym)
|
|
312 (symbol-value toggle-sym))
|
|
313 "turn off " "turn on ")
|
|
314 (if (symbolp toggle-fun)
|
|
315 (symbol-name toggle-fun)
|
|
316 (symbol-name toggle-sym)))
|
|
317
|
|
318 toggle-fun
|
|
319 t)))))
|
|
320 minor-mode-alist)))
|
|
321 event))
|
0
|
322
|
|
323 (defvar modeline-minor-mode-map (make-sparse-keymap 'modeline-minor-mode-map)
|
|
324 "Keymap consulted for mouse-clicks on the minor-mode modeline list.")
|
|
325 (define-key modeline-minor-mode-map 'button3 'modeline-minor-mode-menu)
|
|
326
|
|
327 (defvar modeline-minor-mode-extent (make-extent nil nil)
|
|
328 "Extent covering the minor mode modeline strings.")
|
|
329 (set-extent-face modeline-minor-mode-extent 'modeline-mousable)
|
|
330 (set-extent-keymap modeline-minor-mode-extent modeline-minor-mode-map)
|
|
331
|
|
332
|
|
333 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
334 ;;; Other ;;;
|
|
335 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
336
|
|
337 (defun modeline-buffers-menu (event)
|
|
338 (interactive "e")
|
|
339 (popup-menu-and-execute-in-window
|
|
340 '("Buffers Popup Menu"
|
|
341 :filter buffers-menu-filter
|
|
342 ["List All Buffers" list-buffers t]
|
|
343 "--"
|
|
344 )
|
|
345 event))
|
|
346
|
|
347 (defvar modeline-buffer-id-left-map
|
|
348 (make-sparse-keymap 'modeline-buffer-id-left-map)
|
|
349 "Keymap consulted for mouse-clicks on the left half of the buffer-id string.")
|
|
350
|
|
351 (defvar modeline-buffer-id-right-map
|
|
352 (make-sparse-keymap 'modeline-buffer-id-right-map)
|
|
353 "Keymap consulted for mouse-clicks on the right half of the buffer-id string.")
|
|
354
|
|
355 (define-key modeline-buffer-id-left-map 'button2 'mouse-unbury-buffer)
|
|
356 (define-key modeline-buffer-id-right-map 'button2 'mouse-bury-buffer)
|
|
357 (define-key modeline-buffer-id-left-map 'button3 'modeline-buffers-menu)
|
|
358 (define-key modeline-buffer-id-right-map 'button3 'modeline-buffers-menu)
|
|
359
|
|
360 (make-face 'modeline-buffer-id
|
|
361 "Face for the buffer ID string in the modeline.")
|
|
362
|
|
363 (defvar modeline-buffer-id-extent (make-extent nil nil)
|
|
364 "Extent covering the whole of the buffer-id string.")
|
|
365 (set-extent-face modeline-buffer-id-extent 'modeline-buffer-id)
|
|
366
|
|
367 (defvar modeline-buffer-id-left-extent (make-extent nil nil)
|
|
368 "Extent covering the left half of the buffer-id string.")
|
|
369 (set-extent-keymap modeline-buffer-id-left-extent
|
|
370 modeline-buffer-id-left-map)
|
|
371 (set-extent-property modeline-buffer-id-left-extent 'help-echo
|
|
372 "button2 cycles to the previous buffer")
|
|
373
|
|
374 (defvar modeline-buffer-id-right-extent (make-extent nil nil)
|
|
375 "Extent covering the right half of the buffer-id string.")
|
|
376 (set-extent-keymap modeline-buffer-id-right-extent
|
|
377 modeline-buffer-id-right-map)
|
|
378 (set-extent-property modeline-buffer-id-right-extent 'help-echo
|
|
379 "button2 cycles to the next buffer")
|
|
380
|
|
381 (defconst modeline-buffer-identification
|
|
382 (list (cons modeline-buffer-id-left-extent (purecopy "XEmacs:"))
|
|
383 (cons modeline-buffer-id-right-extent (purecopy " %17b")))
|
|
384 "Modeline control for identifying the buffer being displayed.
|
|
385 Its default value is \"XEmacs: %17b\" (NOT!). Major modes that edit things
|
|
386 other than ordinary files may change this (e.g. Info, Dired,...)")
|
|
387 (make-variable-buffer-local 'modeline-buffer-identification)
|
|
388
|
|
389 (defconst modeline-process nil
|
|
390 "Modeline control for displaying info on process status.
|
|
391 Normally nil in most modes, since there is no process to display.")
|
|
392 (make-variable-buffer-local 'modeline-process)
|
|
393
|
|
394 (defvar modeline-modified-map (make-sparse-keymap 'modeline-modified-map)
|
|
395 "Keymap consulted for mouse-clicks on the modeline-modified string.")
|
|
396 (define-key modeline-modified-map 'button2
|
98
|
397 (make-modeline-command-wrapper 'vc-toggle-read-only))
|
0
|
398
|
|
399 (defvar modeline-modified-extent (make-extent nil nil)
|
|
400 "Extent covering the modeline-modified string.")
|
|
401 (set-extent-face modeline-modified-extent 'modeline-mousable)
|
|
402 (set-extent-keymap modeline-modified-extent modeline-modified-map)
|
|
403 (set-extent-property modeline-modified-extent 'help-echo
|
|
404 "button2 toggles the buffer's read-only status")
|
|
405
|
|
406 (defconst modeline-modified (purecopy '("--%1*%1+-"))
|
|
407 "Modeline control for displaying whether current buffer is modified.")
|
|
408 (make-variable-buffer-local 'modeline-modified)
|
|
409
|
|
410 (defvar modeline-narrowed-map (make-sparse-keymap 'modeline-narrowed-map)
|
|
411 "Keymap consulted for mouse-clicks on the modeline-narrowed string.")
|
|
412 (define-key modeline-narrowed-map 'button2
|
|
413 (make-modeline-command-wrapper 'widen))
|
|
414
|
|
415 (defvar modeline-narrowed-extent (make-extent nil nil)
|
|
416 "Extent covering the modeline-narrowed string.")
|
|
417 (set-extent-face modeline-narrowed-extent 'modeline-mousable)
|
|
418 (set-extent-keymap modeline-narrowed-extent modeline-narrowed-map)
|
|
419 (set-extent-property modeline-narrowed-extent 'help-echo
|
|
420 "button2 widens the buffer")
|
|
421
|
70
|
422 (setq-default
|
|
423 modeline-format
|
|
424 (list
|
|
425 (purecopy "")
|
|
426 (cons modeline-modified-extent 'modeline-modified)
|
|
427 (cons modeline-buffer-id-extent 'modeline-buffer-identification)
|
|
428 (purecopy " ")
|
|
429 'global-mode-string
|
|
430 (purecopy " %[(")
|
|
431 (cons modeline-minor-mode-extent (list "" 'mode-name 'minor-mode-alist))
|
|
432 (cons modeline-narrowed-extent "%n")
|
|
433 'modeline-process
|
|
434 (purecopy ")%]----")
|
|
435 (purecopy '(line-number-mode "L%l--"))
|
|
436 (purecopy '(column-number-mode "C%c--"))
|
|
437 (purecopy '(-3 . "%p"))
|
|
438 (purecopy "-%-")))
|