Mercurial > hg > xemacs-beta

comparison lisp/modeline.el @ 398:74fd4e045ea6 r21-2-29

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-29
author cvs
date Mon, 13 Aug 2007 11:13:30 +0200
parents 8626e4521993
children a86b2b5e0111
comparison
equal deleted inserted replaced
397:f4aeb21a5bad 398:74fd4e045ea6
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 "firebrick" nil '(default color win))
267 '(((default color x) . "firebrick") 297 (set-face-font 'modeline-mousable [bold] nil '(default mono win))
268 ((default color mswindows) . "firebrick")) 298 (set-face-font 'modeline-mousable [bold] nil '(default grayscale win)))
269 'global))
270 (when (featurep 'x)
271 (set-face-font 'modeline-mousable [bold] nil '(default mono x))
272 (set-face-font 'modeline-mousable [bold] nil '(default grayscale x)))
273 299
274 (defmacro make-modeline-command-wrapper (command) 300 (defmacro make-modeline-command-wrapper (command)
275 `#'(lambda (event) 301 `#'(lambda (event)
276 (interactive "e") 302 (interactive "e")
277 (save-selected-window 303 (save-selected-window
301 (make-face 'modeline-mousable-minor-mode 327 (make-face 'modeline-mousable-minor-mode
302 "Face for mousable minor-mode strings in the modeline.") 328 "Face for mousable minor-mode strings in the modeline.")
303 (set-face-parent 'modeline-mousable-minor-mode 'modeline-mousable nil 329 (set-face-parent 'modeline-mousable-minor-mode 'modeline-mousable nil
304 '(default)) 330 '(default))
305 (when (featurep 'window-system) 331 (when (featurep 'window-system)
306 (set-face-foreground 'modeline-mousable-minor-mode 332 (set-face-foreground 'modeline-mousable-minor-mode '("green4" "forestgreen")
307 '(((default color x) . "green4") 333 nil '(default color win)))
308 ((default color x) . "forestgreen")
309 ((default color mswindows) . "green4")
310 ((default color mswindows) . "forestgreen"))
311 'global))
312 334
313 (defvar modeline-mousable-minor-mode-extent (make-extent nil nil) 335 (defvar modeline-mousable-minor-mode-extent (make-extent nil nil)
314 ;; alliteration at its finest. 336 ;; alliteration at its finest.
315 "Extent managing the mousable minor mode modeline strings.") 337 "Extent managing the mousable minor mode modeline strings.")
316 (set-extent-face modeline-mousable-minor-mode-extent 338 (set-extent-face modeline-mousable-minor-mode-extent
389 extent) 411 extent)
390 (cons modeline-mousable-minor-mode-extent name)) 412 (cons modeline-mousable-minor-mode-extent name))
391 name))) 413 name)))
392 (if (setq el (assq toggle minor-mode-alist)) 414 (if (setq el (assq toggle minor-mode-alist))
393 (setcdr el (list hacked-name)) 415 (setcdr el (list hacked-name))
394 (funcall add-elt 416 (funcall add-elt
395 (list toggle hacked-name) 417 (list toggle hacked-name)
396 'minor-mode-alist)))) 418 'minor-mode-alist))))
397 (when keymap 419 (when keymap
398 (if (setq el (assq toggle minor-mode-map-alist)) 420 (if (setq el (assq toggle minor-mode-map-alist))
399 (setcdr el keymap) 421 (setcdr el keymap)
506 528
507 (make-face 'modeline-buffer-id 529 (make-face 'modeline-buffer-id
508 "Face for the buffer ID string in the modeline.") 530 "Face for the buffer ID string in the modeline.")
509 (set-face-parent 'modeline-buffer-id 'modeline nil '(default)) 531 (set-face-parent 'modeline-buffer-id 'modeline nil '(default))
510 (when (featurep 'window-system) 532 (when (featurep 'window-system)
511 (set-face-foreground 'modeline-buffer-id 533 (set-face-foreground 'modeline-buffer-id "blue4" nil '(default color win))
512 '(((default color x) . "blue4") 534 (set-face-font 'modeline-buffer-id [bold-italic] nil '(default mono win))
513 ((default color mswindows) . "blue4")) 535 (set-face-font 'modeline-buffer-id [bold-italic] nil '(default grayscale win)))
514 'global))
515 (when (featurep 'x)
516 (set-face-font 'modeline-buffer-id [bold-italic] nil '(default mono x))
517 (set-face-font 'modeline-buffer-id [bold-italic] nil '(default grayscale x)))
518 (when (featurep 'tty) 536 (when (featurep 'tty)
519 (set-face-font 'modeline-buffer-id [bold-italic] nil '(default tty))) 537 (set-face-font 'modeline-buffer-id [bold-italic] nil '(default tty)))
520 538
521 (defvar modeline-buffer-id-extent (make-extent nil nil) 539 (defvar modeline-buffer-id-extent (make-extent nil nil)
522 "Extent covering the whole of the buffer-id string.") 540 "Extent covering the whole of the buffer-id string.")
523 (set-extent-face modeline-buffer-id-extent 'modeline-buffer-id) 541 (set-extent-face modeline-buffer-id-extent 'modeline-buffer-id)
524 542
525 (defvar modeline-buffer-id-left-extent (make-extent nil nil) 543 (defvar modeline-buffer-id-left-extent (make-extent nil nil)
526 "Extent covering the left half of the buffer-id string.") 544 "Extent covering the left half of the buffer-id string.")
527 (set-extent-keymap modeline-buffer-id-left-extent 545 (set-extent-keymap modeline-buffer-id-left-extent
528 modeline-buffer-id-left-map) 546 modeline-buffer-id-left-map)
529 (set-extent-property modeline-buffer-id-left-extent 'help-echo 547 (set-extent-property modeline-buffer-id-left-extent 'help-echo
593 (cons modeline-modified-extent 'modeline-modified) 611 (cons modeline-modified-extent 'modeline-modified)
594 (cons modeline-buffer-id-extent 'modeline-buffer-identification) 612 (cons modeline-buffer-id-extent 'modeline-buffer-identification)
595 (purecopy " ") 613 (purecopy " ")
596 'global-mode-string 614 'global-mode-string
597 (purecopy " %[(") 615 (purecopy " %[(")
598 (cons modeline-minor-mode-extent (list "" 'mode-name 'minor-mode-alist)) 616 (cons modeline-minor-mode-extent
599 (cons modeline-narrowed-extent "%n") 617 (list (purecopy "") 'mode-name 'minor-mode-alist))
618 (cons modeline-narrowed-extent (purecopy "%n"))
600 'modeline-process 619 'modeline-process
601 (purecopy ")%]----") 620 (purecopy ")%]----")
602 (purecopy '(line-number-mode "L%l--")) 621 (list 'line-number-mode (purecopy "L%l--"))
603 (purecopy '(column-number-mode "C%c--")) 622 (list 'column-number-mode (purecopy "C%c--"))
604 (purecopy '(-3 . "%p")) 623 (cons -3 (purecopy "%p"))
605 (purecopy "-%-"))) 624 (purecopy "-%-")))
606 625
607 ;;; Added for XEmacs 20.3. Provide wrapper for vc since it may not always be 626 ;;; Added for XEmacs 20.3. Provide wrapper for vc since it may not always be
608 ;;; present, and its symbols are not visible this early in the dump if it 627 ;;; present, and its symbols are not visible this early in the dump if it
609 ;;; is. 628 ;;; is.