Mercurial > hg > xemacs-beta

comparison lisp/prim/modeline.el @ 149:538048ae2ab8 r20-3b1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b1
author cvs
date Mon, 13 Aug 2007 09:36:16 +0200
parents cca96a509cfe
children 8eaf7971accc
comparison
equal deleted inserted replaced
148:f659db2a1f73 149:538048ae2ab8
44 buffer list and clicking on the right half cycles backward." 44 buffer list and clicking on the right half cycles backward."
45 :type 'boolean 45 :type 'boolean
46 :group 'modeline) 46 :group 'modeline)
47 47
48 (defun mouse-drag-modeline (event) 48 (defun mouse-drag-modeline (event)
49 "Resize the window by dragging the modeline. 49 "Resize a window by dragging its modeline.
50 This should be bound to a mouse button in `modeline-map'." 50 This command should be bound to a button-press event in modeline-map.
51 Holding down a mouse button and moving the mouse up and down will
52 make the clicked-on window taller or shorter."
51 (interactive "e") 53 (interactive "e")
52 (or (button-press-event-p event) 54 (or (button-press-event-p event)
53 (error "%s must be invoked by a mouse-press" this-command)) 55 (error "%s must be invoked by a mouse-press" this-command))
54 (or (event-over-modeline-p event) 56 (or (event-over-modeline-p event)
55 (error "not over a modeline")) 57 (error "not over a modeline"))
56 (let ((depress-line (event-y event)) 58 (let ((done nil)
57 (mouse-down t) 59 (depress-line (event-y event))
58 (window (event-window event)) 60 (start-event-frame (event-frame event))
59 (old-window (selected-window)) 61 (start-event-window (event-window event))
60 (def-line-height (face-height 'default)) 62 (start-nwindows (count-windows t))
61 (prior-drag-modeline-event-time 0) 63 (last-timestamp 0)
62 delta) 64 default-line-height
63 (while mouse-down 65 modeline-height
66 should-enlarge-minibuffer
67 event min-height minibuffer y top bot edges wconfig growth)
68 (setq minibuffer (minibuffer-window start-event-frame)
69 default-line-height (face-height 'default start-event-window)
70 min-height (* window-min-height default-line-height)
71 modeline-height
72 (if (specifier-instance has-modeline-p start-event-window)
73 (+ (face-height 'modeline start-event-window)
74 (* 2 (specifier-instance modeline-shadow-thickness
75 start-event-window)))
76 (* 2 (specifier-instance modeline-shadow-thickness
77 start-event-window))))
78 (if (not (eq (window-frame minibuffer) start-event-frame))
79 (setq minibuffer nil))
80 (if (and (null minibuffer) (one-window-p t))
81 (error "Attempt to resize sole window"))
82 ;; if this is the bottommost ordinary window, then to
83 ;; move its modeline the minibuffer must be enlarged.
84 (setq should-enlarge-minibuffer
85 (and minibuffer (window-lowest-p start-event-window)))
86 ;; loop reading events
87 (while (not done)
64 (setq event (next-event event)) 88 (setq event (next-event event))
65 (cond ((motion-event-p event) 89 ;; requeue event and quit if this is a misc-user, eval or
66 (if (window-lowest-p window) 90 ;; keypress event.
67 (error "can't drag bottommost modeline")) 91 ;; quit if this is a button press or release event, or if the event
68 (cond ((> (- (event-timestamp event) 92 ;; occurred in some other frame.
69 prior-drag-modeline-event-time) 93 ;; drag if this is a mouse motion event and the time
70 drag-modeline-event-lag) 94 ;; between this event and the last event is greater than
71 95 ;; drag-modeline-event-lag.
72 (setq prior-drag-modeline-event-time (event-timestamp event)) 96 ;; do nothing if this is any other kind of event.
73 97 (cond ((or (misc-user-event-p event)
74 (if (event-over-modeline-p event) 98 (key-press-event-p event)
75 (setq delta 0) 99 (eval-event-p event))
76 (setq delta (- (event-y-pixel event) 100 (setq unread-command-events (nconc unread-command-events
77 (nth 3 (window-pixel-edges window)))) 101 (list event))
78 (if (> delta 0) 102 done t))
79 (setq delta (+ delta def-line-height)))
80 (setq delta (/ delta def-line-height)))
81
82 ;; cough sputter hack kludge. It shouldn't be possible
83 ;; to get in here when we are over the minibuffer. But
84 ;; it is happening and that cause next-vertical-window to
85 ;; return nil which does not lead to window-height returning
86 ;; anything remotely resembling a sensible value. So catch
87 ;; the situation and die a happy death.
88 ;;
89 ;; Oh, and the BLAT FOOP error messages suck as well but
90 ;; I don't know what should be there. This should be
91 ;; looked at again when the new redisplay is done.
92 (if (not (next-vertical-window window))
93 (error "Try again: dragging in minibuffer does nothing"))
94 (cond ((and (> delta 0)
95 (<= (- (window-height (next-vertical-window window))
96 delta)
97 window-min-height))
98 (setq delta (- (window-height
99 (next-vertical-window window))
100 window-min-height))
101 (if (< delta 0) (error "BLAT")))
102 ((and (< delta 0)
103 (< (+ (window-height window) delta)
104 window-min-height))
105 (setq delta (- window-min-height
106 (window-height window)))
107 (if (> delta 0) (error "FOOP"))))
108 (if (= delta 0)
109 nil
110 (select-window window)
111 (enlarge-window delta)
112 ;; The call to enlarge-window may have caused the old
113 ;; window to disappear. Don't try and select it in
114 ;; that case.
115 (if (window-live-p old-window)
116 (select-window old-window))
117 (sit-for 0)
118 ))))
119 ((button-release-event-p event) 103 ((button-release-event-p event)
120 (setq mouse-down nil) 104 (setq done t)
121 (if modeline-click-swaps-buffers 105 (if modeline-click-swaps-buffers
122 (mouse-release-modeline event depress-line))) 106 (mouse-release-modeline event depress-line)))
123 ((or (button-press-event-p event) 107 ((button-event-p event)
124 (key-press-event-p event)) 108 (setq done t))
125 (error "")) 109 ((timeout-event-p event)
110 nil)
111 ((not (motion-event-p event))
112 (dispatch-event event))
113 ((not (eq start-event-frame (event-frame event)))
114 (setq done t))
115 ((< (abs (- (event-timestamp event) last-timestamp))
116 drag-modeline-event-lag)
117 nil)
126 (t 118 (t
127 (dispatch-event event))) 119 (setq last-timestamp (event-timestamp event)
128 ))) 120 y (event-y-pixel event)
121 edges (window-pixel-edges start-event-window)
122 top (nth 1 edges)
123 bot (nth 3 edges))
124 ;; scale back a move that would make the
125 ;; window too short.
126 (cond ((< (- y top (- modeline-height)) min-height)
127 (setq y (+ top min-height (- modeline-height)))))
128 ;; compute size change needed
129 (setq growth (- y bot (/ (- modeline-height) 2))
130 wconfig (current-window-configuration))
131 ;; grow/shrink minibuffer?
132 (if should-enlarge-minibuffer
133 (progn
134 ;; yes. scale back shrinkage if it
135 ;; would make the minibuffer less than 1
136 ;; line tall.
137 ;;
138 ;; also flip the sign of the computed growth,
139 ;; since if we want to grow the window with the
140 ;; modeline we need to shrink the minibuffer
141 ;; and vice versa.
142 (if (and (> growth 0)
143 (< (- (window-pixel-height minibuffer)
144 growth)
145 default-line-height))
146 (setq growth
147 (- (window-pixel-height minibuffer)
148 default-line-height)))
149 (setq growth (- growth))))
150 ;; window grow and shrink by lines not pixels, so
151 ;; divide the pixel height by the height of the
152 ;; default face.
153 (setq growth (/ growth default-line-height))
154 ;; grow/shrink the window
155 (enlarge-window growth nil (if should-enlarge-minibuffer
156 minibuffer
157 start-event-window))
158 ;; if this window's growth caused another
159 ;; window to be deleted because it was too
160 ;; short, rescind the change.
161 ;;
162 ;; if size change caused space to be stolen
163 ;; from a window above this one, rescind the
164 ;; change, but only if we didn't grow/shrink
165 ;; the minibuffer. minibuffer size changes
166 ;; can cause all windows to shrink... no way
167 ;; around it.
168 (if (or (/= start-nwindows (count-windows t))
169 (and (not should-enlarge-minibuffer)
170 (/= top (nth 1 (window-pixel-edges
171 start-event-window)))))
172 (set-window-configuration wconfig)))))))
129 173
130 ;; from Bob Weiner (bob_weiner@pts.mot.com) 174 ;; from Bob Weiner (bob_weiner@pts.mot.com)
131 (defun mouse-release-modeline (event line-num) 175 (defun mouse-release-modeline (event line-num)
132 "Handle modeline click EVENT on LINE-NUM by switching buffers. 176 "Handle modeline click EVENT on LINE-NUM by switching buffers.
133 If click on left half of a frame's modeline, bury current buffer. 177 If click on left half of a frame's modeline, bury current buffer.
387 modeline-buffer-id-right-map) 431 modeline-buffer-id-right-map)
388 (set-extent-property modeline-buffer-id-right-extent 'help-echo 432 (set-extent-property modeline-buffer-id-right-extent 'help-echo
389 "button2 cycles to the next buffer") 433 "button2 cycles to the next buffer")
390 434
391 (defconst modeline-buffer-identification 435 (defconst modeline-buffer-identification
392 (list (cons modeline-buffer-id-left-extent (purecopy "XEmacs:")) 436 (list (cons modeline-buffer-id-left-extent (purecopy "XEmacs%N:"))
437 ; this used to be "XEmacs:"
393 (cons modeline-buffer-id-right-extent (purecopy " %17b"))) 438 (cons modeline-buffer-id-right-extent (purecopy " %17b")))
394 "Modeline control for identifying the buffer being displayed. 439 "Modeline control for identifying the buffer being displayed.
395 Its default value is \"XEmacs: %17b\" (NOT!). Major modes that edit things 440 Its default value is \"XEmacs: %17b\" (NOT!). Major modes that edit things
396 other than ordinary files may change this (e.g. Info, Dired,...)") 441 other than ordinary files may change this (e.g. Info, Dired,...)")
397 (make-variable-buffer-local 'modeline-buffer-identification) 442 (make-variable-buffer-local 'modeline-buffer-identification)