Mercurial > hg > xemacs-beta

comparison lisp/modeline.el @ 225:12579d965149 r20-4b11

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-4b11
author cvs
date Mon, 13 Aug 2007 10:11:40 +0200
parents 41ff10fd062f
children 0e522484dd2a
comparison
equal deleted inserted replaced
224:4663b37daab6 225:12579d965149
62 (interactive "e") 62 (interactive "e")
63 (or (button-press-event-p event) 63 (or (button-press-event-p event)
64 (error "%s must be invoked by a mouse-press" this-command)) 64 (error "%s must be invoked by a mouse-press" this-command))
65 (or (event-over-modeline-p event) 65 (or (event-over-modeline-p event)
66 (error "not over a modeline")) 66 (error "not over a modeline"))
67 (let ((done nil) 67 ;; Give the modeline a "pressed" look. --hniksic
68 (depress-line (event-y event)) 68 (letf (((specifier-instance modeline-shadow-thickness
69 (start-event-frame (event-frame event)) 69 (event-window event))
70 (start-event-window (event-window event)) 70 (- (specifier-instance modeline-shadow-thickness
71 (start-nwindows (count-windows t)) 71 (event-window event)))))
72 (last-timestamp 0) 72 (let ((done nil)
73 default-line-height 73 (depress-line (event-y event))
74 modeline-height 74 (start-event-frame (event-frame event))
75 should-enlarge-minibuffer 75 (start-event-window (event-window event))
76 event min-height minibuffer y top bot edges wconfig growth) 76 (start-nwindows (count-windows t))
77 (setq minibuffer (minibuffer-window start-event-frame) 77 (last-timestamp 0)
78 default-line-height (face-height 'default start-event-window) 78 default-line-height
79 min-height (+ (* window-min-height default-line-height)
80 ;; Don't let the window shrink by a
81 ;; non-multiple of the default line
82 ;; height. (enlarge-window -1) will do
83 ;; this if the difference between the
84 ;; current window height and the minimum
85 ;; window height is less than the height
86 ;; of the default font. These extra
87 ;; lost pixels of height don't come back
88 ;; if you grow the window again. This
89 ;; can make it impossible to drag back
90 ;; to the exact original size, which is
91 ;; disconcerting.
92 (% (window-pixel-height start-event-window)
93 default-line-height))
94 modeline-height 79 modeline-height
80 should-enlarge-minibuffer
81 event min-height minibuffer y top bot edges wconfig growth)
82 (setq minibuffer (minibuffer-window start-event-frame)
83 default-line-height (face-height 'default start-event-window)
84 min-height (+ (* window-min-height default-line-height)
85 ;; Don't let the window shrink by a
86 ;; non-multiple of the default line
87 ;; height. (enlarge-window -1) will do
88 ;; this if the difference between the
89 ;; current window height and the minimum
90 ;; window height is less than the height
91 ;; of the default font. These extra
92 ;; lost pixels of height don't come back
93 ;; if you grow the window again. This
94 ;; can make it impossible to drag back
95 ;; to the exact original size, which is
96 ;; disconcerting.
97 (% (window-pixel-height start-event-window)
98 default-line-height))
99 modeline-height
95 (if (specifier-instance has-modeline-p start-event-window) 100 (if (specifier-instance has-modeline-p start-event-window)
96 (+ (face-height 'modeline start-event-window) 101 (+ (face-height 'modeline start-event-window)
97 (* 2 (specifier-instance modeline-shadow-thickness 102 (* 2 (specifier-instance modeline-shadow-thickness
98 start-event-window))) 103 start-event-window)))
99 (* 2 (specifier-instance modeline-shadow-thickness 104 (* 2 (specifier-instance modeline-shadow-thickness
100 start-event-window)))) 105 start-event-window))))
101 (if (not (eq (window-frame minibuffer) start-event-frame)) 106 (if (not (eq (window-frame minibuffer) start-event-frame))
102 (setq minibuffer nil)) 107 (setq minibuffer nil))
103 (if (and (null minibuffer) (one-window-p t)) 108 (if (and (null minibuffer) (one-window-p t))
104 (error "Attempt to resize sole window")) 109 (error "Attempt to resize sole window"))
105 ;; if this is the bottommost ordinary window, then to 110 ;; if this is the bottommost ordinary window, then to
106 ;; move its modeline the minibuffer must be enlarged. 111 ;; move its modeline the minibuffer must be enlarged.
107 (setq should-enlarge-minibuffer 112 (setq should-enlarge-minibuffer
108 (and minibuffer (window-lowest-p start-event-window))) 113 (and minibuffer (window-lowest-p start-event-window)))
109 ;; loop reading events 114 ;; loop reading events
110 (while (not done) 115 (while (not done)
111 (setq event (next-event event)) 116 (setq event (next-event event))
112 ;; requeue event and quit if this is a misc-user, eval or 117 ;; requeue event and quit if this is a misc-user, eval or
113 ;; keypress event. 118 ;; keypress event.
114 ;; quit if this is a button press or release event, or if the event 119 ;; quit if this is a button press or release event, or if the event
115 ;; occurred in some other frame. 120 ;; occurred in some other frame.
116 ;; drag if this is a mouse motion event and the time 121 ;; drag if this is a mouse motion event and the time
117 ;; between this event and the last event is greater than 122 ;; between this event and the last event is greater than
118 ;; drag-modeline-event-lag. 123 ;; drag-modeline-event-lag.
119 ;; do nothing if this is any other kind of event. 124 ;; do nothing if this is any other kind of event.
120 (cond ((or (misc-user-event-p event) 125 (cond ((or (misc-user-event-p event)
121 (key-press-event-p event)) 126 (key-press-event-p event))
122 (setq unread-command-events (nconc unread-command-events 127 (setq unread-command-events (nconc unread-command-events
123 (list event)) 128 (list event))
124 done t)) 129 done t))
125 ((button-release-event-p event) 130 ((button-release-event-p event)
126 (setq done t) 131 (setq done t)
127 (if modeline-click-swaps-buffers 132 (if modeline-click-swaps-buffers
128 (mouse-release-modeline event depress-line))) 133 (mouse-release-modeline event depress-line)))
129 ((button-event-p event) 134 ((button-event-p event)
130 (setq done t)) 135 (setq done t))
131 ((not (motion-event-p event)) 136 ((not (motion-event-p event))
132 (dispatch-event event)) 137 (dispatch-event event))
133 ((not (eq start-event-frame (event-frame event))) 138 ((not (eq start-event-frame (event-frame event)))
134 (setq done t)) 139 (setq done t))
135 ((< (abs (- (event-timestamp event) last-timestamp)) 140 ((< (abs (- (event-timestamp event) last-timestamp))
136 drag-modeline-event-lag) 141 drag-modeline-event-lag)
137 nil) 142 nil)
138 (t 143 (t
139 (setq last-timestamp (event-timestamp event) 144 (setq last-timestamp (event-timestamp event)
140 y (event-y-pixel event) 145 y (event-y-pixel event)
141 edges (window-pixel-edges start-event-window) 146 edges (window-pixel-edges start-event-window)
142 top (nth 1 edges) 147 top (nth 1 edges)
143 bot (nth 3 edges)) 148 bot (nth 3 edges))
144 ;; scale back a move that would make the 149 ;; scale back a move that would make the
145 ;; window too short. 150 ;; window too short.
146 (cond ((< (- y top (- modeline-height)) min-height) 151 (cond ((< (- y top (- modeline-height)) min-height)
147 (setq y (+ top min-height (- modeline-height))))) 152 (setq y (+ top min-height (- modeline-height)))))
148 ;; compute size change needed 153 ;; compute size change needed
149 (setq growth (- y bot (/ (- modeline-height) 2)) 154 (setq growth (- y bot (/ (- modeline-height) 2))
150 wconfig (current-window-configuration)) 155 wconfig (current-window-configuration))
151 ;; grow/shrink minibuffer? 156 ;; grow/shrink minibuffer?
152 (if should-enlarge-minibuffer 157 (if should-enlarge-minibuffer
153 (progn 158 (progn
154 ;; yes. scale back shrinkage if it 159 ;; yes. scale back shrinkage if it
155 ;; would make the minibuffer less than 1 160 ;; would make the minibuffer less than 1
156 ;; line tall. 161 ;; line tall.
157 ;; 162 ;;
158 ;; also flip the sign of the computed growth, 163 ;; also flip the sign of the computed growth,
159 ;; since if we want to grow the window with the 164 ;; since if we want to grow the window with the
160 ;; modeline we need to shrink the minibuffer 165 ;; modeline we need to shrink the minibuffer
161 ;; and vice versa. 166 ;; and vice versa.
162 (if (and (> growth 0) 167 (if (and (> growth 0)
163 (< (- (window-pixel-height minibuffer) 168 (< (- (window-pixel-height minibuffer)
164 growth) 169 growth)
165 default-line-height)) 170 default-line-height))
166 (setq growth 171 (setq growth
167 (- (window-pixel-height minibuffer) 172 (- (window-pixel-height minibuffer)
168 default-line-height))) 173 default-line-height)))
169 (setq growth (- growth)))) 174 (setq growth (- growth))))
170 ;; window grow and shrink by lines not pixels, so 175 ;; window grow and shrink by lines not pixels, so
171 ;; divide the pixel height by the height of the 176 ;; divide the pixel height by the height of the
172 ;; default face. 177 ;; default face.
173 (setq growth (/ growth default-line-height)) 178 (setq growth (/ growth default-line-height))
174 ;; grow/shrink the window 179 ;; grow/shrink the window
175 (enlarge-window growth nil (if should-enlarge-minibuffer 180 (enlarge-window growth nil (if should-enlarge-minibuffer
176 minibuffer 181 minibuffer
177 start-event-window)) 182 start-event-window))
178 ;; if this window's growth caused another 183 ;; if this window's growth caused another
179 ;; window to be deleted because it was too 184 ;; window to be deleted because it was too
180 ;; short, rescind the change. 185 ;; short, rescind the change.
181 ;; 186 ;;
182 ;; if size change caused space to be stolen 187 ;; if size change caused space to be stolen
183 ;; from a window above this one, rescind the 188 ;; from a window above this one, rescind the
184 ;; change, but only if we didn't grow/shrink 189 ;; change, but only if we didn't grow/shrink
185 ;; the minibuffer. minibuffer size changes 190 ;; the minibuffer. minibuffer size changes
186 ;; can cause all windows to shrink... no way 191 ;; can cause all windows to shrink... no way
187 ;; around it. 192 ;; around it.
188 (if (or (/= start-nwindows (count-windows t)) 193 (if (or (/= start-nwindows (count-windows t))
189 (and (not should-enlarge-minibuffer) 194 (and (not should-enlarge-minibuffer)
190 (/= top (nth 1 (window-pixel-edges 195 (/= top (nth 1 (window-pixel-edges
191 start-event-window))))) 196 start-event-window)))))
192 (set-window-configuration wconfig))))))) 197 (set-window-configuration wconfig))))))))
193 198
194 ;; from Bob Weiner (bob_weiner@pts.mot.com) 199 ;; from Bob Weiner (bob_weiner@pts.mot.com)
195 (defun mouse-release-modeline (event line-num) 200 (defun mouse-release-modeline (event line-num)
196 "Handle modeline click EVENT on LINE-NUM by switching buffers. 201 "Handle modeline click EVENT on LINE-NUM by switching buffers.
197 If click on left half of a frame's modeline, bury current buffer. 202 If click on left half of a frame's modeline, bury current buffer.