Mercurial > hg > xemacs-beta
comparison lisp/modeline.el @ 428:3ecd8885ac67 r21-2-22
Import from CVS: tag r21-2-22
| author | cvs |
|---|---|
| date | Mon, 13 Aug 2007 11:28:15 +0200 |
| parents | |
| children | 84b14dcb0985 |
comparison
equal
deleted
inserted
replaced
| 427:0a0253eac470 | 428:3ecd8885ac67 |
|---|---|
| 1 ;;; modeline.el --- modeline hackery. | |
| 2 | |
| 3 ;; Copyright (C) 1988, 1992-1994, 1997 Free Software Foundation, Inc. | |
| 4 ;; Copyright (C) 1995, 1996 Ben Wing. | |
| 5 | |
| 6 ;; Maintainer: XEmacs Development Team | |
| 7 ;; Keywords: extensions, dumped | |
| 8 | |
| 9 ;; This file is part of XEmacs. | |
| 10 | |
| 11 ;; XEmacs is free software; you can redistribute it and/or modify it | |
| 12 ;; under the terms of the GNU General Public License as published by | |
| 13 ;; the Free Software Foundation; either version 2, or (at your option) | |
| 14 ;; any later version. | |
| 15 | |
| 16 ;; XEmacs is distributed in the hope that it will be useful, but | |
| 17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
| 19 ;; General Public License for more details. | |
| 20 | |
| 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 | |
| 23 ;; Free Software Foundation, 59 Temple Place - Suite 330, | |
| 24 ;; Boston, MA 02111-1307, USA. | |
| 25 | |
| 26 ;;; Synched up with: Not in FSF. | |
| 27 | |
| 28 ;;; Commentary: | |
| 29 | |
| 30 ;; This file is dumped with XEmacs. | |
| 31 | |
| 32 ;;; Code: | |
| 33 | |
| 34 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 35 ;;; General mouse modeline stuff ;;; | |
| 36 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 37 | |
| 38 (defgroup modeline nil | |
| 39 "Modeline customizations." | |
| 40 :group 'environment) | |
| 41 | |
| 42 (defcustom drag-divider-event-lag 150 | |
| 43 "*The pause (in msecs) between divider drag events before redisplaying. | |
| 44 If this value is too small, dragging will be choppy because redisplay cannot | |
| 45 keep up. If it is too large, dragging will be choppy because of the explicit | |
| 46 redisplay delay specified." | |
| 47 :type 'integer | |
| 48 ;; #### Fix group. | |
| 49 :group 'modeline) | |
| 50 | |
| 51 (define-obsolete-variable-alias | |
| 52 'drag-modeline-event-lag | |
| 53 'drag-divider-event-lag) | |
| 54 | |
| 55 (defcustom modeline-click-swaps-buffers nil | |
| 56 "*If non-nil, clicking on the modeline changes the current buffer. | |
| 57 Click on the left half of the modeline cycles forward through the | |
| 58 buffer list and clicking on the right half cycles backward." | |
| 59 :type 'boolean | |
| 60 :group 'modeline) | |
| 61 | |
| 62 (defun mouse-drag-modeline (event) | |
| 63 "Resize a window by dragging its modeline. | |
| 64 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 | |
| 66 make the clicked-on window taller or shorter." | |
| 67 (interactive "e") | |
| 68 (or (button-press-event-p event) | |
| 69 (error "%s must be invoked by a mouse-press" this-command)) | |
| 70 (or (event-over-modeline-p event) | |
| 71 (error "not over a modeline")) | |
| 72 ;; Give the modeline a "pressed" look. --hniksic | |
| 73 (let-specifier ((modeline-shadow-thickness | |
| 74 (- (specifier-instance modeline-shadow-thickness | |
| 75 (event-window event))) | |
| 76 (event-window event))) | |
| 77 (let ((done nil) | |
| 78 (depress-line (event-y event)) | |
| 79 (start-event-frame (event-frame event)) | |
| 80 (start-event-window (event-window event)) | |
| 81 (start-nwindows (count-windows t)) | |
| 82 ;; (hscroll-delta (face-width 'modeline)) | |
| 83 ;; (start-hscroll (modeline-hscroll (event-window event))) | |
| 84 ; (start-x-pixel (event-x-pixel event)) | |
| 85 (last-timestamp 0) | |
| 86 default-line-height | |
| 87 modeline-height | |
| 88 should-enlarge-minibuffer | |
| 89 event min-height minibuffer y top bot edges wconfig growth) | |
| 90 (setq minibuffer (minibuffer-window start-event-frame) | |
| 91 default-line-height (face-height 'default start-event-window) | |
| 92 min-height (+ (* window-min-height default-line-height) | |
| 93 ;; Don't let the window shrink by a | |
| 94 ;; non-multiple of the default line | |
| 95 ;; height. (enlarge-window -1) will do | |
| 96 ;; this if the difference between the | |
| 97 ;; current window height and the minimum | |
| 98 ;; window height is less than the height | |
| 99 ;; of the default font. These extra | |
| 100 ;; lost pixels of height don't come back | |
| 101 ;; if you grow the window again. This | |
| 102 ;; can make it impossible to drag back | |
| 103 ;; to the exact original size, which is | |
| 104 ;; disconcerting. | |
| 105 (% (window-pixel-height start-event-window) | |
| 106 default-line-height)) | |
| 107 modeline-height | |
| 108 (if (specifier-instance has-modeline-p start-event-window) | |
| 109 (+ (face-height 'modeline start-event-window) | |
| 110 (* 2 (specifier-instance modeline-shadow-thickness | |
| 111 start-event-window))) | |
| 112 (* 2 (specifier-instance modeline-shadow-thickness | |
| 113 start-event-window)))) | |
| 114 (if (not (eq (window-frame minibuffer) start-event-frame)) | |
| 115 (setq minibuffer nil)) | |
| 116 (if (and (null minibuffer) (one-window-p t)) | |
| 117 (error "Attempt to resize sole window")) | |
| 118 ;; if this is the bottommost ordinary window, then to | |
| 119 ;; move its modeline the minibuffer must be enlarged. | |
| 120 (setq should-enlarge-minibuffer | |
| 121 (and minibuffer (window-lowest-p start-event-window))) | |
| 122 ;; loop reading events | |
| 123 (while (not done) | |
| 124 (setq event (next-event event)) | |
| 125 ;; requeue event and quit if this is a misc-user, eval or | |
| 126 ;; keypress event. | |
| 127 ;; quit if this is a button press or release event, or if the event | |
| 128 ;; occurred in some other frame. | |
| 129 ;; drag if this is a mouse motion event and the time | |
| 130 ;; between this event and the last event is greater than | |
| 131 ;; drag-divider-event-lag. | |
| 132 ;; do nothing if this is any other kind of event. | |
| 133 (cond ((or (misc-user-event-p event) | |
| 134 (key-press-event-p event)) | |
| 135 (setq unread-command-events (nconc unread-command-events | |
| 136 (list event)) | |
| 137 done t)) | |
| 138 ((button-release-event-p event) | |
| 139 (setq done t) | |
| 140 ;; Consider we have a mouse click neither X pos (modeline | |
| 141 ;; scroll) nore Y pos (modeline drag) have changed. | |
| 142 (and modeline-click-swaps-buffers | |
| 143 (= depress-line (event-y event)) | |
| 144 ;; (= start-hscroll (modeline-hscroll start-event-window)) | |
| 145 (modeline-swap-buffers event))) | |
| 146 ((button-event-p event) | |
| 147 (setq done t)) | |
| 148 ((not (motion-event-p event)) | |
| 149 (dispatch-event event)) | |
| 150 ((not (eq start-event-frame (event-frame event))) | |
| 151 (setq done t)) | |
| 152 ((< (abs (- (event-timestamp event) last-timestamp)) | |
| 153 drag-divider-event-lag) | |
| 154 nil) | |
| 155 (t | |
| 156 ;; (set-modeline-hscroll start-event-window | |
| 157 ;; (+ (/ (- (event-x-pixel event) | |
| 158 ;; start-x-pixel) | |
| 159 ;; hscroll-delta) | |
| 160 ;; start-hscroll)) | |
| 161 (setq last-timestamp (event-timestamp event) | |
| 162 y (event-y-pixel event) | |
| 163 edges (window-pixel-edges start-event-window) | |
| 164 top (nth 1 edges) | |
| 165 bot (nth 3 edges)) | |
| 166 ;; scale back a move that would make the | |
| 167 ;; window too short. | |
| 168 (cond ((< (- y top (- modeline-height)) min-height) | |
| 169 (setq y (+ top min-height (- modeline-height))))) | |
| 170 ;; compute size change needed | |
| 171 (setq growth (- y bot (/ (- modeline-height) 2)) | |
| 172 wconfig (current-window-configuration)) | |
| 173 ;; grow/shrink minibuffer? | |
| 174 (if should-enlarge-minibuffer | |
| 175 (progn | |
| 176 ;; yes. scale back shrinkage if it | |
| 177 ;; would make the minibuffer less than 1 | |
| 178 ;; line tall. | |
| 179 ;; | |
| 180 ;; also flip the sign of the computed growth, | |
| 181 ;; since if we want to grow the window with the | |
| 182 ;; modeline we need to shrink the minibuffer | |
| 183 ;; and vice versa. | |
| 184 (if (and (> growth 0) | |
| 185 (< (- (window-pixel-height minibuffer) | |
| 186 growth) | |
| 187 default-line-height)) | |
| 188 (setq growth | |
| 189 (- (window-pixel-height minibuffer) | |
| 190 default-line-height))) | |
| 191 (setq growth (- growth)))) | |
| 192 ;; window grow and shrink by lines not pixels, so | |
| 193 ;; divide the pixel height by the height of the | |
| 194 ;; default face. | |
| 195 (setq growth (/ growth default-line-height)) | |
| 196 ;; grow/shrink the window | |
| 197 (enlarge-window growth nil (if should-enlarge-minibuffer | |
| 198 minibuffer | |
| 199 start-event-window)) | |
| 200 ;; if this window's growth caused another | |
| 201 ;; window to be deleted because it was too | |
| 202 ;; short, rescind the change. | |
| 203 ;; | |
| 204 ;; if size change caused space to be stolen | |
| 205 ;; from a window above this one, rescind the | |
| 206 ;; change, but only if we didn't grow/shrink | |
| 207 ;; the minibuffer. minibuffer size changes | |
| 208 ;; can cause all windows to shrink... no way | |
| 209 ;; around it. | |
| 210 (if (or (/= start-nwindows (count-windows t)) | |
| 211 (and (not should-enlarge-minibuffer) | |
| 212 (/= top (nth 1 (window-pixel-edges | |
| 213 start-event-window))))) | |
| 214 (set-window-configuration wconfig)))))))) | |
| 215 | |
| 216 ;; from Bob Weiner (bob_weiner@pts.mot.com) | |
| 217 ;; Whether this function should be called is now decided in | |
| 218 ;; mouse-drag-modeline - dverna feb. 98 | |
| 219 (defun modeline-swap-buffers (event) | |
| 220 "Handle mouse clicks on modeline by switching buffers. | |
| 221 If click on left half of a frame's modeline, bury current buffer. | |
| 222 If click on right half of a frame's modeline, raise bottommost buffer. | |
| 223 Arg EVENT is the button release event that occurred on the modeline." | |
| 224 (or (event-over-modeline-p event) | |
| 225 (error "not over a modeline")) | |
| 226 (or (button-release-event-p event) | |
| 227 (error "not a button release event")) | |
| 228 (if (< (event-x event) (/ (window-width (event-window event)) 2)) | |
| 229 ;; On left half of modeline, bury current buffer, | |
| 230 ;; displaying second buffer on list. | |
| 231 (mouse-bury-buffer event) | |
| 232 ;; On right half of modeline, raise and display bottommost | |
| 233 ;; buffer in buffer list. | |
| 234 (mouse-unbury-buffer event))) | |
| 235 | |
| 236 (defconst modeline-menu | |
| 237 '("Window Commands" | |
| 238 ["Delete Window Above" delete-window t] | |
| 239 ["Delete Other Windows" delete-other-windows t] | |
| 240 ["Split Window Above" split-window-vertically t] | |
| 241 ["Split Window Horizontally" split-window-horizontally t] | |
| 242 ["Balance Windows" balance-windows t] | |
| 243 )) | |
| 244 | |
| 245 (defun modeline-menu (event) | |
| 246 (interactive "e") | |
| 247 (popup-menu-and-execute-in-window | |
| 248 (cons (format "Window Commands for %S:" | |
| 249 (buffer-name (event-buffer event))) | |
| 250 (cdr modeline-menu)) | |
| 251 event)) | |
| 252 | |
| 253 (defvar modeline-map (make-sparse-keymap 'modeline-map) | |
| 254 "Keymap consulted for mouse-clicks on the modeline of a window. | |
| 255 This variable may be buffer-local; its value will be looked up in | |
| 256 the buffer of the window whose modeline was clicked upon.") | |
| 257 | |
| 258 (define-key modeline-map 'button1 'mouse-drag-modeline) | |
| 259 ;; button2 selects the window without setting point | |
| 260 (define-key modeline-map 'button2 (lambda () (interactive "@"))) | |
| 261 (define-key modeline-map 'button3 'modeline-menu) | |
| 262 | |
| 263 (make-face 'modeline-mousable "Face for mousable portions of the modeline.") | |
| 264 (set-face-parent 'modeline-mousable 'modeline nil '(default)) | |
| 265 (when (featurep 'window-system) | |
| 266 (set-face-foreground 'modeline-mousable | |
| 267 '(((default color x) . "firebrick") | |
| 268 ((default color mswindows) . "firebrick")) | |
| 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 | |
| 274 (defmacro make-modeline-command-wrapper (command) | |
| 275 `#'(lambda (event) | |
| 276 (interactive "e") | |
| 277 (save-selected-window | |
| 278 (select-window (event-window event)) | |
| 279 (call-interactively ',(eval command))))) | |
| 280 | |
| 281 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 282 ;;; Minor modes ;;; | |
| 283 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 284 | |
| 285 (defvar minor-mode-alist nil | |
| 286 "Alist saying how to show minor modes in the modeline. | |
| 287 Each element looks like (VARIABLE STRING); | |
| 288 STRING is included in the modeline iff VARIABLE's value is non-nil. | |
| 289 | |
| 290 Actually, STRING need not be a string; any possible modeline element | |
| 291 is okay. See `modeline-format'.") | |
| 292 | |
| 293 ;; Used by C code (lookup-key and friends) but defined here. | |
| 294 (defvar minor-mode-map-alist nil | |
| 295 "Alist of keymaps to use for minor modes. | |
| 296 Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read | |
| 297 key sequences and look up bindings iff VARIABLE's value is non-nil. | |
| 298 If two active keymaps bind the same key, the keymap appearing earlier | |
| 299 in the list takes precedence.") | |
| 300 | |
| 301 (make-face 'modeline-mousable-minor-mode | |
| 302 "Face for mousable minor-mode strings in the modeline.") | |
| 303 (set-face-parent 'modeline-mousable-minor-mode 'modeline-mousable nil | |
| 304 '(default)) | |
| 305 (when (featurep 'window-system) | |
| 306 (set-face-foreground 'modeline-mousable-minor-mode | |
| 307 '(((default color x) . "green4") | |
| 308 ((default color x) . "forestgreen") | |
| 309 ((default color mswindows) . "green4") | |
| 310 ((default color mswindows) . "forestgreen")) | |
| 311 'global)) | |
| 312 | |
| 313 (defvar modeline-mousable-minor-mode-extent (make-extent nil nil) | |
| 314 ;; alliteration at its finest. | |
| 315 "Extent managing the mousable minor mode modeline strings.") | |
| 316 (set-extent-face modeline-mousable-minor-mode-extent | |
| 317 'modeline-mousable-minor-mode) | |
| 318 | |
| 319 ;; This replaces the idiom | |
| 320 ;; | |
| 321 ;; (or (assq 'isearch-mode minor-mode-alist) | |
| 322 ;; (setq minor-mode-alist | |
| 323 ;; (purecopy | |
| 324 ;; (append minor-mode-alist | |
| 325 ;; '((isearch-mode isearch-mode)))))) | |
| 326 | |
| 327 (defun add-minor-mode (toggle name &optional keymap after toggle-fun) | |
| 328 "Add a minor mode to `minor-mode-alist' and `minor-mode-map-alist'. | |
| 329 | |
| 330 TOGGLE is a symbol whose value as a variable specifies whether the | |
| 331 minor mode is active. | |
| 332 | |
| 333 NAME is the name that should appear in the modeline. It should either | |
| 334 be a string beginning with a space, or a symbol with a similar string | |
| 335 as its value. | |
| 336 | |
| 337 KEYMAP is a keymap to make active when the minor mode is active. | |
| 338 | |
| 339 AFTER is the toggling symbol used for another minor mode. If AFTER is | |
| 340 non-nil, then it is used to position the new mode in the minor-mode | |
| 341 alists. | |
| 342 | |
| 343 TOGGLE-FUN specifies an interactive function that is called to toggle | |
| 344 the mode on and off; this affects what happens when button2 is pressed | |
| 345 on the mode, and when button3 is pressed somewhere in the list of | |
| 346 modes. If TOGGLE-FUN is nil and TOGGLE names an interactive function, | |
| 347 TOGGLE is used as the toggle function. | |
| 348 | |
| 349 Example: (add-minor-mode 'view-minor-mode \" View\" view-mode-map)" | |
| 350 (let* ((add-elt #'(lambda (elt sym) | |
| 351 (let (place) | |
| 352 (cond ((null after) ; add to front | |
| 353 (push elt (symbol-value sym))) | |
| 354 ((and (not (eq after t)) | |
| 355 (setq place (memq (assq after | |
| 356 (symbol-value sym)) | |
| 357 (symbol-value sym)))) | |
| 358 (push elt (cdr place))) | |
| 359 (t | |
| 360 (set sym (append (symbol-value sym) | |
| 361 (list elt)))))) | |
| 362 (symbol-value sym))) | |
| 363 el toggle-keymap) | |
| 364 (if toggle-fun | |
| 365 (check-argument-type 'commandp toggle-fun) | |
| 366 (when (commandp toggle) | |
| 367 (setq toggle-fun toggle))) | |
| 368 (when (and toggle-fun name) | |
| 369 (setq toggle-keymap (make-sparse-keymap | |
| 370 (intern (concat "modeline-minor-" | |
| 371 (symbol-name toggle) | |
| 372 "-map")))) | |
| 373 (define-key toggle-keymap 'button2 | |
| 374 ;; defeat the DUMB-ASS byte-compiler, which tries to | |
| 375 ;; expand the macro at compile time and fucks up. | |
| 376 (eval '(make-modeline-command-wrapper toggle-fun))) | |
| 377 (put toggle 'modeline-toggle-function toggle-fun)) | |
| 378 (when name | |
| 379 (let ((hacked-name | |
| 380 (if toggle-keymap | |
| 381 (cons (let ((extent (make-extent nil nil))) | |
| 382 (set-extent-keymap extent toggle-keymap) | |
| 383 (set-extent-property | |
| 384 extent 'help-echo | |
| 385 (concat "button2 turns off " | |
| 386 (if (symbolp toggle-fun) | |
| 387 (symbol-name toggle-fun) | |
| 388 (symbol-name toggle)))) | |
| 389 extent) | |
| 390 (cons modeline-mousable-minor-mode-extent name)) | |
| 391 name))) | |
| 392 (if (setq el (assq toggle minor-mode-alist)) | |
| 393 (setcdr el (list hacked-name)) | |
| 394 (funcall add-elt | |
| 395 (list toggle hacked-name) | |
| 396 'minor-mode-alist)))) | |
| 397 (when keymap | |
| 398 (if (setq el (assq toggle minor-mode-map-alist)) | |
| 399 (setcdr el keymap) | |
| 400 (funcall add-elt | |
| 401 (cons toggle keymap) | |
| 402 'minor-mode-map-alist))))) | |
| 403 | |
| 404 ;; #### TODO: Add `:menu-tag' keyword to add-minor-mode. Or create a | |
| 405 ;; separate function to manage the minor mode menu. | |
| 406 | |
| 407 ;(put 'abbrev-mode :menu-tag "Abbreviation Expansion") | |
| 408 (add-minor-mode 'abbrev-mode " Abbrev") | |
| 409 ;; only when visiting a file... | |
| 410 (add-minor-mode 'overwrite-mode 'overwrite-mode) | |
| 411 ;(put 'auto-fill-function :menu-tag "Auto Fill") | |
| 412 (add-minor-mode 'auto-fill-function " Fill" nil nil 'auto-fill-mode) | |
| 413 | |
| 414 ;(put 'defining-kbd-macro :menu-tag "Keyboard Macro") | |
| 415 (add-minor-mode 'defining-kbd-macro " Def" nil nil | |
| 416 (lambda () | |
| 417 (interactive) | |
| 418 (if defining-kbd-macro | |
| 419 (progn | |
| 420 ;; #### This means to disregard the last event. | |
| 421 ;; It is needed because the last recorded | |
| 422 ;; event is usually the mouse event that | |
| 423 ;; invoked the menu item (and this function), | |
| 424 ;; and having it in the macro causes problems. | |
| 425 (zap-last-kbd-macro-event) | |
| 426 (end-kbd-macro nil)) | |
| 427 (start-kbd-macro nil)))) | |
| 428 | |
| 429 (defun modeline-minor-mode-menu (event) | |
| 430 "The menu that pops up when you press `button3' inside the | |
| 431 parentheses on the modeline." | |
| 432 (interactive "e") | |
| 433 (save-excursion | |
| 434 (set-buffer (event-buffer event)) | |
| 435 (popup-menu-and-execute-in-window | |
| 436 (cons | |
| 437 "Minor Mode Toggles" | |
| 438 (sort | |
| 439 (delq nil (mapcar | |
| 440 #'(lambda (x) | |
| 441 (let* ((toggle-sym (car x)) | |
| 442 (toggle-fun (or (get toggle-sym | |
| 443 'modeline-toggle-function) | |
| 444 (and (commandp toggle-sym) | |
| 445 toggle-sym))) | |
| 446 (menu-tag (symbol-name (if (symbolp toggle-fun) | |
| 447 toggle-fun | |
| 448 toggle-sym)) | |
| 449 ;; Here a function should | |
| 450 ;; maybe be invoked to | |
| 451 ;; beautify the symbol's | |
| 452 ;; menu appearance. | |
| 453 )) | |
| 454 (and toggle-fun | |
| 455 (vector menu-tag | |
| 456 toggle-fun | |
| 457 ;; The following two are wrong | |
| 458 ;; because of possible name | |
| 459 ;; clashes. | |
| 460 ;:active (get toggle-sym :active t) | |
| 461 ;:included (get toggle-sym :included t) | |
| 462 :style 'toggle | |
| 463 :selected (and (boundp toggle-sym) | |
| 464 toggle-sym))))) | |
| 465 minor-mode-alist)) | |
| 466 (lambda (e1 e2) | |
| 467 (string< (aref e1 0) (aref e2 0))))) | |
| 468 event))) | |
| 469 | |
| 470 (defvar modeline-minor-mode-map (make-sparse-keymap 'modeline-minor-mode-map) | |
| 471 "Keymap consulted for mouse-clicks on the minor-mode modeline list.") | |
| 472 (define-key modeline-minor-mode-map 'button3 'modeline-minor-mode-menu) | |
| 473 | |
| 474 (defvar modeline-minor-mode-extent (make-extent nil nil) | |
| 475 "Extent covering the minor mode modeline strings.") | |
| 476 (set-extent-face modeline-minor-mode-extent 'modeline-mousable) | |
| 477 (set-extent-keymap modeline-minor-mode-extent modeline-minor-mode-map) | |
| 478 | |
| 479 | |
| 480 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 481 ;;; Other ;;; | |
| 482 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 483 | |
| 484 (defun modeline-buffers-menu (event) | |
| 485 (interactive "e") | |
| 486 (popup-menu-and-execute-in-window | |
| 487 '("Buffers Popup Menu" | |
| 488 :filter buffers-menu-filter | |
| 489 ["List All Buffers" list-buffers t] | |
| 490 "--" | |
| 491 ) | |
| 492 event)) | |
| 493 | |
| 494 (defvar modeline-buffer-id-left-map | |
| 495 (make-sparse-keymap 'modeline-buffer-id-left-map) | |
| 496 "Keymap consulted for mouse-clicks on the left half of the buffer-id string.") | |
| 497 | |
| 498 (defvar modeline-buffer-id-right-map | |
| 499 (make-sparse-keymap 'modeline-buffer-id-right-map) | |
| 500 "Keymap consulted for mouse-clicks on the right half of the buffer-id string.") | |
| 501 | |
| 502 (define-key modeline-buffer-id-left-map 'button2 'mouse-unbury-buffer) | |
| 503 (define-key modeline-buffer-id-right-map 'button2 'mouse-bury-buffer) | |
| 504 (define-key modeline-buffer-id-left-map 'button3 'modeline-buffers-menu) | |
| 505 (define-key modeline-buffer-id-right-map 'button3 'modeline-buffers-menu) | |
| 506 | |
| 507 (make-face 'modeline-buffer-id | |
| 508 "Face for the buffer ID string in the modeline.") | |
| 509 (set-face-parent 'modeline-buffer-id 'modeline nil '(default)) | |
| 510 (when (featurep 'window-system) | |
| 511 (set-face-foreground 'modeline-buffer-id | |
| 512 '(((default color x) . "blue4") | |
| 513 ((default color mswindows) . "blue4")) | |
| 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) | |
| 519 (set-face-font 'modeline-buffer-id [bold-italic] nil '(default tty))) | |
| 520 | |
| 521 (defvar modeline-buffer-id-extent (make-extent nil nil) | |
| 522 "Extent covering the whole of the buffer-id string.") | |
| 523 (set-extent-face modeline-buffer-id-extent 'modeline-buffer-id) | |
| 524 | |
| 525 (defvar modeline-buffer-id-left-extent (make-extent nil nil) | |
| 526 "Extent covering the left half of the buffer-id string.") | |
| 527 (set-extent-keymap modeline-buffer-id-left-extent | |
| 528 modeline-buffer-id-left-map) | |
| 529 (set-extent-property modeline-buffer-id-left-extent 'help-echo | |
| 530 "button2 cycles to the previous buffer") | |
| 531 | |
| 532 (defvar modeline-buffer-id-right-extent (make-extent nil nil) | |
| 533 "Extent covering the right half of the buffer-id string.") | |
| 534 (set-extent-keymap modeline-buffer-id-right-extent | |
| 535 modeline-buffer-id-right-map) | |
| 536 (set-extent-property modeline-buffer-id-right-extent 'help-echo | |
| 537 "button2 cycles to the next buffer") | |
| 538 | |
| 539 (defconst modeline-buffer-identification | |
| 540 (list (cons modeline-buffer-id-left-extent (purecopy "XEmacs%N:")) | |
| 541 ; this used to be "XEmacs:" | |
| 542 (cons modeline-buffer-id-right-extent (purecopy " %17b"))) | |
| 543 "Modeline control for identifying the buffer being displayed. | |
| 544 Its default value is \"XEmacs: %17b\" (NOT!). Major modes that edit things | |
| 545 other than ordinary files may change this (e.g. Info, Dired,...)") | |
| 546 (make-variable-buffer-local 'modeline-buffer-identification) | |
| 547 | |
| 548 ;; These are for the sake of minor mode menu. #### All of this is | |
| 549 ;; kind of dirty. `add-minor-mode' started out as a simple substitute | |
| 550 ;; for (or (assq ...) ...) FSF stuff, but now is used for all kind of | |
| 551 ;; stuff. There should perhaps be a separate function to add toggles | |
| 552 ;; to the minor-mode-menu. | |
| 553 (add-minor-mode 'line-number-mode "") | |
| 554 (add-minor-mode 'column-number-mode "") | |
| 555 | |
| 556 (defconst modeline-process nil | |
| 557 "Modeline control for displaying info on process status. | |
| 558 Normally nil in most modes, since there is no process to display.") | |
| 559 (make-variable-buffer-local 'modeline-process) | |
| 560 | |
| 561 (defvar modeline-modified-map (make-sparse-keymap 'modeline-modified-map) | |
| 562 "Keymap consulted for mouse-clicks on the modeline-modified string.") | |
| 563 (define-key modeline-modified-map 'button2 | |
| 564 (make-modeline-command-wrapper 'modeline-toggle-read-only)) | |
| 565 | |
| 566 (defvar modeline-modified-extent (make-extent nil nil) | |
| 567 "Extent covering the modeline-modified string.") | |
| 568 (set-extent-face modeline-modified-extent 'modeline-mousable) | |
| 569 (set-extent-keymap modeline-modified-extent modeline-modified-map) | |
| 570 (set-extent-property modeline-modified-extent 'help-echo | |
| 571 "button2 toggles the buffer's read-only status") | |
| 572 | |
| 573 (defconst modeline-modified (purecopy '("--%1*%1+-")) | |
| 574 "Modeline control for displaying whether current buffer is modified.") | |
| 575 (make-variable-buffer-local 'modeline-modified) | |
| 576 | |
| 577 (defvar modeline-narrowed-map (make-sparse-keymap 'modeline-narrowed-map) | |
| 578 "Keymap consulted for mouse-clicks on the modeline-narrowed string.") | |
| 579 (define-key modeline-narrowed-map 'button2 | |
| 580 (make-modeline-command-wrapper 'widen)) | |
| 581 | |
| 582 (defvar modeline-narrowed-extent (make-extent nil nil) | |
| 583 "Extent covering the modeline-narrowed string.") | |
| 584 (set-extent-face modeline-narrowed-extent 'modeline-mousable) | |
| 585 (set-extent-keymap modeline-narrowed-extent modeline-narrowed-map) | |
| 586 (set-extent-property modeline-narrowed-extent 'help-echo | |
| 587 "button2 widens the buffer") | |
| 588 | |
| 589 (setq-default | |
| 590 modeline-format | |
| 591 (list | |
| 592 (purecopy "") | |
| 593 (cons modeline-modified-extent 'modeline-modified) | |
| 594 (cons modeline-buffer-id-extent 'modeline-buffer-identification) | |
| 595 (purecopy " ") | |
| 596 'global-mode-string | |
| 597 (purecopy " %[(") | |
| 598 (cons modeline-minor-mode-extent | |
| 599 (list (purecopy "") 'mode-name 'minor-mode-alist)) | |
| 600 (cons modeline-narrowed-extent (purecopy "%n")) | |
| 601 'modeline-process | |
| 602 (purecopy ")%]----") | |
| 603 (list 'line-number-mode (purecopy "L%l--")) | |
| 604 (list 'column-number-mode (purecopy "C%c--")) | |
| 605 (cons -3 (purecopy "%p")) | |
| 606 (purecopy "-%-"))) | |
| 607 | |
| 608 ;;; Added for XEmacs 20.3. Provide wrapper for vc since it may not always be | |
| 609 ;;; present, and its symbols are not visible this early in the dump if it | |
| 610 ;;; is. | |
| 611 | |
| 612 (defun modeline-toggle-read-only () | |
| 613 "Change whether this buffer is visiting its file read-only. | |
| 614 With arg, set read-only iff arg is positive. | |
| 615 This function is designed to be called when the read-only indicator on the | |
| 616 modeline is clicked. It will call `vc-toggle-read-only' if available, | |
| 617 otherwise it will call the usual `toggle-read-only'." | |
| 618 (interactive) | |
| 619 (if (fboundp 'vc-toggle-read-only) | |
| 620 (vc-toggle-read-only) | |
| 621 (toggle-read-only))) | |
| 622 | |
| 623 ;;; modeline.el ends here |