annotate lisp/prim/modeline.el @ 173:8eaf7971accc r20-3b13

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