Mercurial > hg > xemacs-beta
comparison lisp/modeline.el @ 209:41ff10fd062f r20-4b3
Import from CVS: tag r20-4b3
| author | cvs |
|---|---|
| date | Mon, 13 Aug 2007 10:04:58 +0200 |
| parents | |
| children | 12579d965149 |
comparison
equal
deleted
inserted
replaced
| 208:f427b8ec4379 | 209:41ff10fd062f |
|---|---|
| 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-modeline-event-lag 150 | |
| 43 "*The pause (in msecs) between drag modeline 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 :group 'modeline) | |
| 49 | |
| 50 (defcustom modeline-click-swaps-buffers nil | |
| 51 "*If non-nil, clicking on the modeline changes the current buffer. | |
| 52 Click on the left half of the modeline cycles forward through the | |
| 53 buffer list and clicking on the right half cycles backward." | |
| 54 :type 'boolean | |
| 55 :group 'modeline) | |
| 56 | |
| 57 (defun mouse-drag-modeline (event) | |
| 58 "Resize a window by dragging its modeline. | |
| 59 This command should be bound to a button-press event in modeline-map. | |
| 60 Holding down a mouse button and moving the mouse up and down will | |
| 61 make the clicked-on window taller or shorter." | |
| 62 (interactive "e") | |
| 63 (or (button-press-event-p event) | |
| 64 (error "%s must be invoked by a mouse-press" this-command)) | |
| 65 (or (event-over-modeline-p event) | |
| 66 (error "not over a modeline")) | |
| 67 (let ((done nil) | |
| 68 (depress-line (event-y event)) | |
| 69 (start-event-frame (event-frame event)) | |
| 70 (start-event-window (event-window event)) | |
| 71 (start-nwindows (count-windows t)) | |
| 72 (last-timestamp 0) | |
| 73 default-line-height | |
| 74 modeline-height | |
| 75 should-enlarge-minibuffer | |
| 76 event min-height minibuffer y top bot edges wconfig growth) | |
| 77 (setq minibuffer (minibuffer-window start-event-frame) | |
| 78 default-line-height (face-height 'default start-event-window) | |
| 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 | |
| 95 (if (specifier-instance has-modeline-p start-event-window) | |
| 96 (+ (face-height 'modeline start-event-window) | |
| 97 (* 2 (specifier-instance modeline-shadow-thickness | |
| 98 start-event-window))) | |
| 99 (* 2 (specifier-instance modeline-shadow-thickness | |
| 100 start-event-window)))) | |
| 101 (if (not (eq (window-frame minibuffer) start-event-frame)) | |
| 102 (setq minibuffer nil)) | |
| 103 (if (and (null minibuffer) (one-window-p t)) | |
| 104 (error "Attempt to resize sole window")) | |
| 105 ;; if this is the bottommost ordinary window, then to | |
| 106 ;; move its modeline the minibuffer must be enlarged. | |
| 107 (setq should-enlarge-minibuffer | |
| 108 (and minibuffer (window-lowest-p start-event-window))) | |
| 109 ;; loop reading events | |
| 110 (while (not done) | |
| 111 (setq event (next-event event)) | |
| 112 ;; requeue event and quit if this is a misc-user, eval or | |
| 113 ;; keypress event. | |
| 114 ;; quit if this is a button press or release event, or if the event | |
| 115 ;; occurred in some other frame. | |
| 116 ;; drag if this is a mouse motion event and the time | |
| 117 ;; between this event and the last event is greater than | |
| 118 ;; drag-modeline-event-lag. | |
| 119 ;; do nothing if this is any other kind of event. | |
| 120 (cond ((or (misc-user-event-p event) | |
| 121 (key-press-event-p event)) | |
| 122 (setq unread-command-events (nconc unread-command-events | |
| 123 (list event)) | |
| 124 done t)) | |
| 125 ((button-release-event-p event) | |
| 126 (setq done t) | |
| 127 (if modeline-click-swaps-buffers | |
| 128 (mouse-release-modeline event depress-line))) | |
| 129 ((button-event-p event) | |
| 130 (setq done t)) | |
| 131 ((not (motion-event-p event)) | |
| 132 (dispatch-event event)) | |
| 133 ((not (eq start-event-frame (event-frame event))) | |
| 134 (setq done t)) | |
| 135 ((< (abs (- (event-timestamp event) last-timestamp)) | |
| 136 drag-modeline-event-lag) | |
| 137 nil) | |
| 138 (t | |
| 139 (setq last-timestamp (event-timestamp event) | |
| 140 y (event-y-pixel event) | |
| 141 edges (window-pixel-edges start-event-window) | |
| 142 top (nth 1 edges) | |
| 143 bot (nth 3 edges)) | |
| 144 ;; scale back a move that would make the | |
| 145 ;; window too short. | |
| 146 (cond ((< (- y top (- modeline-height)) min-height) | |
| 147 (setq y (+ top min-height (- modeline-height))))) | |
| 148 ;; compute size change needed | |
| 149 (setq growth (- y bot (/ (- modeline-height) 2)) | |
| 150 wconfig (current-window-configuration)) | |
| 151 ;; grow/shrink minibuffer? | |
| 152 (if should-enlarge-minibuffer | |
| 153 (progn | |
| 154 ;; yes. scale back shrinkage if it | |
| 155 ;; would make the minibuffer less than 1 | |
| 156 ;; line tall. | |
| 157 ;; | |
| 158 ;; also flip the sign of the computed growth, | |
| 159 ;; since if we want to grow the window with the | |
| 160 ;; modeline we need to shrink the minibuffer | |
| 161 ;; and vice versa. | |
| 162 (if (and (> growth 0) | |
| 163 (< (- (window-pixel-height minibuffer) | |
| 164 growth) | |
| 165 default-line-height)) | |
| 166 (setq growth | |
| 167 (- (window-pixel-height minibuffer) | |
| 168 default-line-height))) | |
| 169 (setq growth (- growth)))) | |
| 170 ;; window grow and shrink by lines not pixels, so | |
| 171 ;; divide the pixel height by the height of the | |
| 172 ;; default face. | |
| 173 (setq growth (/ growth default-line-height)) | |
| 174 ;; grow/shrink the window | |
| 175 (enlarge-window growth nil (if should-enlarge-minibuffer | |
| 176 minibuffer | |
| 177 start-event-window)) | |
| 178 ;; if this window's growth caused another | |
| 179 ;; window to be deleted because it was too | |
| 180 ;; short, rescind the change. | |
| 181 ;; | |
| 182 ;; if size change caused space to be stolen | |
| 183 ;; from a window above this one, rescind the | |
| 184 ;; change, but only if we didn't grow/shrink | |
| 185 ;; the minibuffer. minibuffer size changes | |
| 186 ;; can cause all windows to shrink... no way | |
| 187 ;; around it. | |
| 188 (if (or (/= start-nwindows (count-windows t)) | |
| 189 (and (not should-enlarge-minibuffer) | |
| 190 (/= top (nth 1 (window-pixel-edges | |
| 191 start-event-window))))) | |
| 192 (set-window-configuration wconfig))))))) | |
| 193 | |
| 194 ;; from Bob Weiner (bob_weiner@pts.mot.com) | |
| 195 (defun mouse-release-modeline (event line-num) | |
| 196 "Handle modeline click EVENT on LINE-NUM by switching buffers. | |
| 197 If click on left half of a frame's modeline, bury current buffer. | |
| 198 If click on right half of a frame's modeline, raise bottommost buffer. | |
| 199 Args are: EVENT, the mouse release event, and LINE-NUM, the line number | |
| 200 within the frame at which the mouse was first depressed." | |
| 201 (if (= line-num (event-y event)) | |
| 202 ;; Button press and release are at same line, treat this as | |
| 203 ;; a click and switch buffers. | |
| 204 (if (< (event-x event) (/ (window-width (event-window event)) 2)) | |
| 205 ;; On left half of modeline, bury current buffer, | |
| 206 ;; displaying second buffer on list. | |
| 207 (mouse-bury-buffer event) | |
| 208 ;; On right half of modeline, raise and display bottommost | |
| 209 ;; buffer in buffer list. | |
| 210 (mouse-unbury-buffer event)))) | |
| 211 | |
| 212 (defconst modeline-menu | |
| 213 '("Window Commands" | |
| 214 ["Delete Window Above" delete-window t] | |
| 215 ["Delete Other Windows" delete-other-windows t] | |
| 216 ["Split Window Above" split-window-vertically t] | |
| 217 ["Split Window Horizontally" split-window-horizontally t] | |
| 218 ["Balance Windows" balance-windows t] | |
| 219 )) | |
| 220 | |
| 221 (defun modeline-menu (event) | |
| 222 (interactive "e") | |
| 223 (popup-menu-and-execute-in-window | |
| 224 (cons (format "Window Commands for %S:" | |
| 225 (buffer-name (event-buffer event))) | |
| 226 (cdr modeline-menu)) | |
| 227 event)) | |
| 228 | |
| 229 (defvar modeline-map (make-sparse-keymap 'modeline-map) | |
| 230 "Keymap consulted for mouse-clicks on the modeline of a window. | |
| 231 This variable may be buffer-local; its value will be looked up in | |
| 232 the buffer of the window whose modeline was clicked upon.") | |
| 233 | |
| 234 (define-key modeline-map 'button1 'mouse-drag-modeline) | |
| 235 ;; button2 selects the window without setting point | |
| 236 (define-key modeline-map 'button2 (lambda () (interactive "@"))) | |
| 237 (define-key modeline-map 'button3 'modeline-menu) | |
| 238 | |
| 239 (make-face 'modeline-mousable "Face for mousable portions of the modeline.") | |
| 240 (set-face-parent 'modeline-mousable 'modeline) | |
| 241 (when (featurep 'x) | |
| 242 (set-face-foreground 'modeline-mousable "firebrick" 'global '(color x)) | |
| 243 (set-face-font 'modeline-mousable [bold] nil '(mono x)) | |
| 244 (set-face-font 'modeline-mousable [bold] nil '(grayscale x))) | |
| 245 | |
| 246 (defmacro make-modeline-command-wrapper (command) | |
| 247 `#'(lambda (event) | |
| 248 (interactive "e") | |
| 249 (save-selected-window | |
| 250 (select-window (event-window event)) | |
| 251 (call-interactively ',(eval command))))) | |
| 252 | |
| 253 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 254 ;;; Minor modes ;;; | |
| 255 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 256 | |
| 257 (defvar minor-mode-alist nil | |
| 258 "Alist saying how to show minor modes in the modeline. | |
| 259 Each element looks like (VARIABLE STRING); | |
| 260 STRING is included in the modeline iff VARIABLE's value is non-nil. | |
| 261 | |
| 262 Actually, STRING need not be a string; any possible modeline element | |
| 263 is okay. See `modeline-format'.") | |
| 264 | |
| 265 ;; Used by C code (lookup-key and friends) but defined here. | |
| 266 (defvar minor-mode-map-alist nil | |
| 267 "Alist of keymaps to use for minor modes. | |
| 268 Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read | |
| 269 key sequences and look up bindings iff VARIABLE's value is non-nil. | |
| 270 If two active keymaps bind the same key, the keymap appearing earlier | |
| 271 in the list takes precedence.") | |
| 272 | |
| 273 (make-face 'modeline-mousable-minor-mode | |
| 274 "Face for mousable minor-mode strings in the modeline.") | |
| 275 (set-face-parent 'modeline-mousable-minor-mode 'modeline-mousable) | |
| 276 (when (featurep 'x) | |
| 277 (set-face-foreground 'modeline-mousable-minor-mode | |
| 278 '(((color x) . "green4") | |
| 279 ((color x) . "forestgreen")) 'global)) | |
| 280 | |
| 281 (defvar modeline-mousable-minor-mode-extent (make-extent nil nil) | |
| 282 ;; alliteration at its finest. | |
| 283 "Extent managing the mousable minor mode modeline strings.") | |
| 284 (set-extent-face modeline-mousable-minor-mode-extent | |
| 285 'modeline-mousable-minor-mode) | |
| 286 | |
| 287 ;; This replaces the idiom | |
| 288 ;; | |
| 289 ;; (or (assq 'isearch-mode minor-mode-alist) | |
| 290 ;; (setq minor-mode-alist | |
| 291 ;; (purecopy | |
| 292 ;; (append minor-mode-alist | |
| 293 ;; '((isearch-mode isearch-mode)))))) | |
| 294 | |
| 295 (defvar place) | |
| 296 (defun add-minor-mode (toggle name &optional keymap after toggle-fun) | |
| 297 "Add a minor mode to `minor-mode-alist' and `minor-mode-map-alist'. | |
| 298 TOGGLE is a symbol whose value as a variable specifies whether the | |
| 299 minor mode is active. NAME is the name that should appear in the | |
| 300 modeline (it should either be a string beginning with a space or a | |
| 301 symbol). KEYMAP is a keymap to make active when the minor mode is | |
| 302 active. AFTER is the toggling symbol used for another minor mode. If | |
| 303 AFTER is non-nil, then it is used to position the new mode in the | |
| 304 minor-mode alists. TOGGLE-FUN specifies an interactive function that | |
| 305 is called to toggle the mode on and off; this affects what happens | |
| 306 when button2 is pressed on the mode, and when button3 is pressed | |
| 307 somewhere in the list of modes. If TOGGLE-FUN is nil and TOGGLE names | |
| 308 an interactive function, TOGGLE is used as the toggle function. | |
| 309 | |
| 310 Example: (add-minor-mode 'view-minor-mode \" View\" view-mode-map)" | |
| 311 (let (el place | |
| 312 (add-elt #'(lambda (elt sym) | |
| 313 (cond ((null after) ; add to front | |
| 314 (set sym (cons elt (symbol-value sym)))) | |
| 315 ((and (not (eq after t)) | |
| 316 (setq place (memq (assq after | |
| 317 (symbol-value sym)) | |
| 318 (symbol-value sym)))) | |
| 319 (setq elt (cons elt (cdr place))) | |
| 320 (setcdr place elt)) | |
| 321 (t | |
| 322 (set sym (append (symbol-value sym) (list elt)))) | |
| 323 ) | |
| 324 (symbol-value sym))) | |
| 325 toggle-keymap) | |
| 326 (if toggle-fun | |
| 327 (if (not (commandp toggle-fun)) | |
| 328 (error "not an interactive function: %S" toggle-fun)) | |
| 329 (if (commandp toggle) | |
| 330 (setq toggle-fun toggle))) | |
| 331 (if (and toggle-fun name) | |
| 332 (progn | |
| 333 (setq toggle-keymap (make-sparse-keymap | |
| 334 (intern (concat "modeline-minor-" | |
| 335 (symbol-name toggle) | |
| 336 "-map")))) | |
| 337 (define-key toggle-keymap 'button2 | |
| 338 ;; defeat the DUMB-ASS byte-compiler, which tries to | |
| 339 ;; expand the macro at compile time and fucks up. | |
| 340 (eval '(make-modeline-command-wrapper toggle-fun))) | |
| 341 (put toggle 'modeline-toggle-function toggle-fun))) | |
| 342 (and name | |
| 343 (let ((hacked-name | |
| 344 (if toggle-keymap | |
| 345 (cons (let ((extent (make-extent nil nil))) | |
| 346 (set-extent-keymap extent toggle-keymap) | |
| 347 (set-extent-property | |
| 348 extent 'help-echo | |
| 349 (concat "button2 turns off " | |
| 350 (if (symbolp toggle-fun) | |
| 351 (symbol-name toggle-fun) | |
| 352 (symbol-name toggle)))) | |
| 353 extent) | |
| 354 (cons | |
| 355 modeline-mousable-minor-mode-extent | |
| 356 name)) | |
| 357 name))) | |
| 358 (if (setq el (assq toggle minor-mode-alist)) | |
| 359 (setcdr el (list hacked-name)) | |
| 360 (funcall add-elt | |
| 361 (list toggle hacked-name) | |
| 362 'minor-mode-alist)))) | |
| 363 (and keymap | |
| 364 (if (setq el (assq toggle minor-mode-map-alist)) | |
| 365 (setcdr el keymap) | |
| 366 (funcall add-elt | |
| 367 (cons toggle keymap) | |
| 368 'minor-mode-map-alist))) | |
| 369 )) | |
| 370 | |
| 371 (add-minor-mode 'abbrev-mode " Abbrev") | |
| 372 (add-minor-mode 'overwrite-mode 'overwrite-mode) | |
| 373 (add-minor-mode 'auto-fill-function " Fill" nil nil 'auto-fill-mode) | |
| 374 ;; not really a minor mode... | |
| 375 (add-minor-mode 'defining-kbd-macro " Def") | |
| 376 | |
| 377 (defun modeline-minor-mode-menu (event) | |
| 378 (interactive "e") | |
| 379 (save-excursion | |
| 380 (set-buffer (event-buffer event)) | |
| 381 (popup-menu-and-execute-in-window | |
| 382 (cons (format "Minor Mode Commands for %S:" | |
| 383 (buffer-name (event-buffer event))) | |
| 384 (apply 'nconc | |
| 385 (mapcar | |
| 386 #'(lambda (x) | |
| 387 (let* ((toggle-sym (car x)) | |
| 388 (toggle-fun | |
| 389 (or (get toggle-sym | |
| 390 'modeline-toggle-function) | |
| 391 (and (fboundp toggle-sym) | |
| 392 (commandp toggle-sym) | |
| 393 toggle-sym)))) | |
| 394 (if (not toggle-fun) nil | |
| 395 (list (vector | |
| 396 (concat (if (and (boundp toggle-sym) | |
| 397 (symbol-value toggle-sym)) | |
| 398 "turn off " "turn on ") | |
| 399 (if (symbolp toggle-fun) | |
| 400 (symbol-name toggle-fun) | |
| 401 (symbol-name toggle-sym))) | |
| 402 | |
| 403 toggle-fun | |
| 404 t))))) | |
| 405 minor-mode-alist))) | |
| 406 event))) | |
| 407 | |
| 408 (defvar modeline-minor-mode-map (make-sparse-keymap 'modeline-minor-mode-map) | |
| 409 "Keymap consulted for mouse-clicks on the minor-mode modeline list.") | |
| 410 (define-key modeline-minor-mode-map 'button3 'modeline-minor-mode-menu) | |
| 411 | |
| 412 (defvar modeline-minor-mode-extent (make-extent nil nil) | |
| 413 "Extent covering the minor mode modeline strings.") | |
| 414 (set-extent-face modeline-minor-mode-extent 'modeline-mousable) | |
| 415 (set-extent-keymap modeline-minor-mode-extent modeline-minor-mode-map) | |
| 416 | |
| 417 | |
| 418 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 419 ;;; Other ;;; | |
| 420 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 421 | |
| 422 (defun modeline-buffers-menu (event) | |
| 423 (interactive "e") | |
| 424 (popup-menu-and-execute-in-window | |
| 425 '("Buffers Popup Menu" | |
| 426 :filter buffers-menu-filter | |
| 427 ["List All Buffers" list-buffers t] | |
| 428 "--" | |
| 429 ) | |
| 430 event)) | |
| 431 | |
| 432 (defvar modeline-buffer-id-left-map | |
| 433 (make-sparse-keymap 'modeline-buffer-id-left-map) | |
| 434 "Keymap consulted for mouse-clicks on the left half of the buffer-id string.") | |
| 435 | |
| 436 (defvar modeline-buffer-id-right-map | |
| 437 (make-sparse-keymap 'modeline-buffer-id-right-map) | |
| 438 "Keymap consulted for mouse-clicks on the right half of the buffer-id string.") | |
| 439 | |
| 440 (define-key modeline-buffer-id-left-map 'button2 'mouse-unbury-buffer) | |
| 441 (define-key modeline-buffer-id-right-map 'button2 'mouse-bury-buffer) | |
| 442 (define-key modeline-buffer-id-left-map 'button3 'modeline-buffers-menu) | |
| 443 (define-key modeline-buffer-id-right-map 'button3 'modeline-buffers-menu) | |
| 444 | |
| 445 (make-face 'modeline-buffer-id | |
| 446 "Face for the buffer ID string in the modeline.") | |
| 447 (set-face-parent 'modeline-buffer-id 'modeline) | |
| 448 (when (featurep 'x) | |
| 449 (set-face-foreground 'modeline-buffer-id "blue4" 'global '(color x))) | |
| 450 (when (featurep 'x) | |
| 451 (set-face-font 'modeline-buffer-id [bold-italic] nil '(mono x)) | |
| 452 (set-face-font 'modeline-buffer-id [bold-italic] nil '(grayscale x))) | |
| 453 (when (featurep 'tty) | |
| 454 (set-face-font 'modeline-buffer-id [bold-italic] nil 'tty)) | |
| 455 | |
| 456 (defvar modeline-buffer-id-extent (make-extent nil nil) | |
| 457 "Extent covering the whole of the buffer-id string.") | |
| 458 (set-extent-face modeline-buffer-id-extent 'modeline-buffer-id) | |
| 459 | |
| 460 (defvar modeline-buffer-id-left-extent (make-extent nil nil) | |
| 461 "Extent covering the left half of the buffer-id string.") | |
| 462 (set-extent-keymap modeline-buffer-id-left-extent | |
| 463 modeline-buffer-id-left-map) | |
| 464 (set-extent-property modeline-buffer-id-left-extent 'help-echo | |
| 465 "button2 cycles to the previous buffer") | |
| 466 | |
| 467 (defvar modeline-buffer-id-right-extent (make-extent nil nil) | |
| 468 "Extent covering the right half of the buffer-id string.") | |
| 469 (set-extent-keymap modeline-buffer-id-right-extent | |
| 470 modeline-buffer-id-right-map) | |
| 471 (set-extent-property modeline-buffer-id-right-extent 'help-echo | |
| 472 "button2 cycles to the next buffer") | |
| 473 | |
| 474 (defconst modeline-buffer-identification | |
| 475 (list (cons modeline-buffer-id-left-extent (purecopy "XEmacs%N:")) | |
| 476 ; this used to be "XEmacs:" | |
| 477 (cons modeline-buffer-id-right-extent (purecopy " %17b"))) | |
| 478 "Modeline control for identifying the buffer being displayed. | |
| 479 Its default value is \"XEmacs: %17b\" (NOT!). Major modes that edit things | |
| 480 other than ordinary files may change this (e.g. Info, Dired,...)") | |
| 481 (make-variable-buffer-local 'modeline-buffer-identification) | |
| 482 | |
| 483 (defconst modeline-process nil | |
| 484 "Modeline control for displaying info on process status. | |
| 485 Normally nil in most modes, since there is no process to display.") | |
| 486 (make-variable-buffer-local 'modeline-process) | |
| 487 | |
| 488 (defvar modeline-modified-map (make-sparse-keymap 'modeline-modified-map) | |
| 489 "Keymap consulted for mouse-clicks on the modeline-modified string.") | |
| 490 (define-key modeline-modified-map 'button2 | |
| 491 (make-modeline-command-wrapper 'modeline-toggle-read-only)) | |
| 492 | |
| 493 (defvar modeline-modified-extent (make-extent nil nil) | |
| 494 "Extent covering the modeline-modified string.") | |
| 495 (set-extent-face modeline-modified-extent 'modeline-mousable) | |
| 496 (set-extent-keymap modeline-modified-extent modeline-modified-map) | |
| 497 (set-extent-property modeline-modified-extent 'help-echo | |
| 498 "button2 toggles the buffer's read-only status") | |
| 499 | |
| 500 (defconst modeline-modified (purecopy '("--%1*%1+-")) | |
| 501 "Modeline control for displaying whether current buffer is modified.") | |
| 502 (make-variable-buffer-local 'modeline-modified) | |
| 503 | |
| 504 (defvar modeline-narrowed-map (make-sparse-keymap 'modeline-narrowed-map) | |
| 505 "Keymap consulted for mouse-clicks on the modeline-narrowed string.") | |
| 506 (define-key modeline-narrowed-map 'button2 | |
| 507 (make-modeline-command-wrapper 'widen)) | |
| 508 | |
| 509 (defvar modeline-narrowed-extent (make-extent nil nil) | |
| 510 "Extent covering the modeline-narrowed string.") | |
| 511 (set-extent-face modeline-narrowed-extent 'modeline-mousable) | |
| 512 (set-extent-keymap modeline-narrowed-extent modeline-narrowed-map) | |
| 513 (set-extent-property modeline-narrowed-extent 'help-echo | |
| 514 "button2 widens the buffer") | |
| 515 | |
| 516 (setq-default | |
| 517 modeline-format | |
| 518 (list | |
| 519 (purecopy "") | |
| 520 (cons modeline-modified-extent 'modeline-modified) | |
| 521 (cons modeline-buffer-id-extent 'modeline-buffer-identification) | |
| 522 (purecopy " ") | |
| 523 'global-mode-string | |
| 524 (purecopy " %[(") | |
| 525 (cons modeline-minor-mode-extent (list "" 'mode-name 'minor-mode-alist)) | |
| 526 (cons modeline-narrowed-extent "%n") | |
| 527 'modeline-process | |
| 528 (purecopy ")%]----") | |
| 529 (purecopy '(line-number-mode "L%l--")) | |
| 530 (purecopy '(column-number-mode "C%c--")) | |
| 531 (purecopy '(-3 . "%p")) | |
| 532 (purecopy "-%-"))) | |
| 533 | |
| 534 ;;; Added for XEmacs 20.3. Provide wrapper for vc since it may not always be | |
| 535 ;;; present, and its symbols are not visible this early in the dump if it | |
| 536 ;;; is. | |
| 537 | |
| 538 (defun modeline-toggle-read-only () | |
| 539 "Change whether this buffer is visiting its file read-only. | |
| 540 With arg, set read-only iff arg is positive. | |
| 541 This function is designed to be called when the read-only indicator on the | |
| 542 modeline is clicked. It will call `vc-toggle-read-only' if available, | |
| 543 otherwise it will call the usual `toggle-read-only'." | |
| 544 (interactive) | |
| 545 (if (fboundp 'vc-toggle-read-only) | |
| 546 (vc-toggle-read-only) | |
| 547 (toggle-read-only))) | |
| 548 | |
| 549 ;;; modeline.el ends here |