Mercurial > hg > xemacs-beta

comparison lisp/modeline.el @ 438:84b14dcb0985 r21-2-27

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-27
author cvs
date Mon, 13 Aug 2007 11:32:25 +0200
parents 3ecd8885ac67
children 8de8e3f6228a
comparison
equal deleted inserted replaced
437:e2a4e8b94b82 438:84b14dcb0985
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of 17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19 ;; General Public License for more details. 19 ;; General Public License for more details.
20 20
21 ;; You should have received a copy of the GNU General Public License 21 ;; You should have received a copy of the GNU General Public License
22 ;; along with XEmacs; see the file COPYING. If not, write to the 22 ;; along with XEmacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, 59 Temple Place - Suite 330, 23 ;; Free Software Foundation, 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA. 24 ;; Boston, MA 02111-1307, USA.
25 25
26 ;;; Synched up with: Not in FSF. 26 ;;; Synched up with: Not in FSF.
27 27
57 Click on the left half of the modeline cycles forward through the 57 Click on the left half of the modeline cycles forward through the
58 buffer list and clicking on the right half cycles backward." 58 buffer list and clicking on the right half cycles backward."
59 :type 'boolean 59 :type 'boolean
60 :group 'modeline) 60 :group 'modeline)
61 61
62 (defcustom modeline-scrolling-method nil
63 "*If non-nil, dragging the modeline with the mouse may also scroll its
64 text horizontally (vertical motion controls window resizing and horizontal
65 motion controls modeline scrolling).
66
67 With a value of t, the modeline text is scrolled in the same direction as
68 the mouse motion. With a value of 'scrollbar, the modeline is considered as
69 a scrollbar for its own text, which then moves in the opposite direction."
70 :type '(choice (const :tag "none" nil)
71 (const :tag "text" t)
72 (const :tag "scrollbar" scrollbar))
73 :set (lambda (sym val)
74 (set-default sym val)
75 (when (featurep 'x)
76 (cond ((eq val t)
77 (set-glyph-image modeline-pointer-glyph "hand2" 'global 'x))
78 ((eq val 'scrollbar)
79 (set-glyph-image modeline-pointer-glyph "fleur" 'global 'x))
80 (t
81 (set-glyph-image modeline-pointer-glyph "sb_v_double_arrow"
82 'global 'x)))))
83 :group 'modeline)
84
62 (defun mouse-drag-modeline (event) 85 (defun mouse-drag-modeline (event)
63 "Resize a window by dragging its modeline. 86 "Resize a window by dragging its modeline.
64 This command should be bound to a button-press event in modeline-map. 87 This command should be bound to a button-press event in modeline-map.
65 Holding down a mouse button and moving the mouse up and down will 88 Holding down a mouse button and moving the mouse up and down will
66 make the clicked-on window taller or shorter." 89 make the clicked-on window taller or shorter.
90
91 See also the variable `modeline-scrolling-method'."
67 (interactive "e") 92 (interactive "e")
68 (or (button-press-event-p event) 93 (or (button-press-event-p event)
69 (error "%s must be invoked by a mouse-press" this-command)) 94 (error "%s must be invoked by a mouse-press" this-command))
70 (or (event-over-modeline-p event) 95 (or (event-over-modeline-p event)
71 (error "not over a modeline")) 96 (error "not over a modeline"))
77 (let ((done nil) 102 (let ((done nil)
78 (depress-line (event-y event)) 103 (depress-line (event-y event))
79 (start-event-frame (event-frame event)) 104 (start-event-frame (event-frame event))
80 (start-event-window (event-window event)) 105 (start-event-window (event-window event))
81 (start-nwindows (count-windows t)) 106 (start-nwindows (count-windows t))
82 ;; (hscroll-delta (face-width 'modeline)) 107 (hscroll-delta (face-width 'modeline))
83 ;; (start-hscroll (modeline-hscroll (event-window event))) 108 (start-hscroll (modeline-hscroll (event-window event)))
84 ; (start-x-pixel (event-x-pixel event)) 109 (start-x-pixel (event-x-pixel event))
85 (last-timestamp 0) 110 (last-timestamp 0)
86 default-line-height 111 default-line-height
87 modeline-height 112 modeline-height
88 should-enlarge-minibuffer 113 should-enlarge-minibuffer
89 event min-height minibuffer y top bot edges wconfig growth) 114 event min-height minibuffer y top bot edges wconfig growth)
139 (setq done t) 164 (setq done t)
140 ;; Consider we have a mouse click neither X pos (modeline 165 ;; Consider we have a mouse click neither X pos (modeline
141 ;; scroll) nore Y pos (modeline drag) have changed. 166 ;; scroll) nore Y pos (modeline drag) have changed.
142 (and modeline-click-swaps-buffers 167 (and modeline-click-swaps-buffers
143 (= depress-line (event-y event)) 168 (= depress-line (event-y event))
144 ;; (= start-hscroll (modeline-hscroll start-event-window)) 169 (or (not modeline-scrolling-method)
170 (= start-hscroll
171 (modeline-hscroll start-event-window)))
145 (modeline-swap-buffers event))) 172 (modeline-swap-buffers event)))
146 ((button-event-p event) 173 ((button-event-p event)
147 (setq done t)) 174 (setq done t))
148 ((not (motion-event-p event)) 175 ((not (motion-event-p event))
149 (dispatch-event event)) 176 (dispatch-event event))
151 (setq done t)) 178 (setq done t))
152 ((< (abs (- (event-timestamp event) last-timestamp)) 179 ((< (abs (- (event-timestamp event) last-timestamp))
153 drag-divider-event-lag) 180 drag-divider-event-lag)
154 nil) 181 nil)
155 (t 182 (t
156 ;; (set-modeline-hscroll start-event-window 183 (when modeline-scrolling-method
157 ;; (+ (/ (- (event-x-pixel event) 184 (let ((delta (/ (- (event-x-pixel event) start-x-pixel)
158 ;; start-x-pixel) 185 hscroll-delta)))
159 ;; hscroll-delta) 186 (set-modeline-hscroll start-event-window
160 ;; start-hscroll)) 187 (if (eq modeline-scrolling-method t)
188 (- start-hscroll delta)
189 (+ start-hscroll delta)))
190 ))
161 (setq last-timestamp (event-timestamp event) 191 (setq last-timestamp (event-timestamp event)
162 y (event-y-pixel event) 192 y (event-y-pixel event)
163 edges (window-pixel-edges start-event-window) 193 edges (window-pixel-edges start-event-window)
164 top (nth 1 edges) 194 top (nth 1 edges)
165 bot (nth 3 edges)) 195 bot (nth 3 edges))
261 (define-key modeline-map 'button3 'modeline-menu) 291 (define-key modeline-map 'button3 'modeline-menu)
262 292
263 (make-face 'modeline-mousable "Face for mousable portions of the modeline.") 293 (make-face 'modeline-mousable "Face for mousable portions of the modeline.")
264 (set-face-parent 'modeline-mousable 'modeline nil '(default)) 294 (set-face-parent 'modeline-mousable 'modeline nil '(default))
265 (when (featurep 'window-system) 295 (when (featurep 'window-system)
266 (set-face-foreground 'modeline-mousable 296 (set-face-foreground 'modeline-mousable
267 '(((default color x) . "firebrick") 297 '(((default color x) . "firebrick")
268 ((default color mswindows) . "firebrick")) 298 ((default color mswindows) . "firebrick"))
269 'global)) 299 'global))
270 (when (featurep 'x) 300 (when (featurep 'x)
271 (set-face-font 'modeline-mousable [bold] nil '(default mono x)) 301 (set-face-font 'modeline-mousable [bold] nil '(default mono x))
305 (when (featurep 'window-system) 335 (when (featurep 'window-system)
306 (set-face-foreground 'modeline-mousable-minor-mode 336 (set-face-foreground 'modeline-mousable-minor-mode
307 '(((default color x) . "green4") 337 '(((default color x) . "green4")
308 ((default color x) . "forestgreen") 338 ((default color x) . "forestgreen")
309 ((default color mswindows) . "green4") 339 ((default color mswindows) . "green4")
310 ((default color mswindows) . "forestgreen")) 340 ((default color mswindows) . "forestgreen"))
311 'global)) 341 'global))
312 342
313 (defvar modeline-mousable-minor-mode-extent (make-extent nil nil) 343 (defvar modeline-mousable-minor-mode-extent (make-extent nil nil)
314 ;; alliteration at its finest. 344 ;; alliteration at its finest.
315 "Extent managing the mousable minor mode modeline strings.") 345 "Extent managing the mousable minor mode modeline strings.")
389 extent) 419 extent)
390 (cons modeline-mousable-minor-mode-extent name)) 420 (cons modeline-mousable-minor-mode-extent name))
391 name))) 421 name)))
392 (if (setq el (assq toggle minor-mode-alist)) 422 (if (setq el (assq toggle minor-mode-alist))
393 (setcdr el (list hacked-name)) 423 (setcdr el (list hacked-name))
394 (funcall add-elt 424 (funcall add-elt
395 (list toggle hacked-name) 425 (list toggle hacked-name)
396 'minor-mode-alist)))) 426 'minor-mode-alist))))
397 (when keymap 427 (when keymap
398 (if (setq el (assq toggle minor-mode-map-alist)) 428 (if (setq el (assq toggle minor-mode-map-alist))
399 (setcdr el keymap) 429 (setcdr el keymap)
506 536
507 (make-face 'modeline-buffer-id 537 (make-face 'modeline-buffer-id
508 "Face for the buffer ID string in the modeline.") 538 "Face for the buffer ID string in the modeline.")
509 (set-face-parent 'modeline-buffer-id 'modeline nil '(default)) 539 (set-face-parent 'modeline-buffer-id 'modeline nil '(default))
510 (when (featurep 'window-system) 540 (when (featurep 'window-system)
511 (set-face-foreground 'modeline-buffer-id 541 (set-face-foreground 'modeline-buffer-id
512 '(((default color x) . "blue4") 542 '(((default color x) . "blue4")
513 ((default color mswindows) . "blue4")) 543 ((default color mswindows) . "blue4"))
514 'global)) 544 'global))
515 (when (featurep 'x) 545 (when (featurep 'x)
516 (set-face-font 'modeline-buffer-id [bold-italic] nil '(default mono x)) 546 (set-face-font 'modeline-buffer-id [bold-italic] nil '(default mono x))
519 (set-face-font 'modeline-buffer-id [bold-italic] nil '(default tty))) 549 (set-face-font 'modeline-buffer-id [bold-italic] nil '(default tty)))
520 550
521 (defvar modeline-buffer-id-extent (make-extent nil nil) 551 (defvar modeline-buffer-id-extent (make-extent nil nil)
522 "Extent covering the whole of the buffer-id string.") 552 "Extent covering the whole of the buffer-id string.")
523 (set-extent-face modeline-buffer-id-extent 'modeline-buffer-id) 553 (set-extent-face modeline-buffer-id-extent 'modeline-buffer-id)
524 554
525 (defvar modeline-buffer-id-left-extent (make-extent nil nil) 555 (defvar modeline-buffer-id-left-extent (make-extent nil nil)
526 "Extent covering the left half of the buffer-id string.") 556 "Extent covering the left half of the buffer-id string.")
527 (set-extent-keymap modeline-buffer-id-left-extent 557 (set-extent-keymap modeline-buffer-id-left-extent
528 modeline-buffer-id-left-map) 558 modeline-buffer-id-left-map)
529 (set-extent-property modeline-buffer-id-left-extent 'help-echo 559 (set-extent-property modeline-buffer-id-left-extent 'help-echo