Mercurial > hg > xemacs-beta
annotate lisp/modeline.el @ 5512:4aa8ee813265
Add a DESTDIR variable to all Makefiles, defaulting to the empty string, and
use it in install targets. See xemacs-patches message
<BANLkTinRnwk9qsCfBj_xkcyf7H4sH9fn7A@mail.gmail.com>.
| author | Jerry James <james@xemacs.org> |
|---|---|
| date | Wed, 25 May 2011 09:15:20 -0600 |
| parents | 308d34e9f07d |
| children | cf2733b1ff4b |
| rev | line source |
|---|---|
| 428 | 1 ;;; modeline.el --- modeline hackery. |
| 2 | |
| 3 ;; Copyright (C) 1988, 1992-1994, 1997 Free Software Foundation, Inc. | |
| 771 | 4 ;; Copyright (C) 1995, 1996, 2002 Ben Wing. |
| 428 | 5 |
| 6 ;; Maintainer: XEmacs Development Team | |
| 7 ;; Keywords: extensions, dumped | |
| 8 | |
| 9 ;; This file is part of XEmacs. | |
| 10 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5267
diff
changeset
|
11 ;; XEmacs is free software: you can redistribute it and/or modify it |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5267
diff
changeset
|
12 ;; under the terms of the GNU General Public License as published by the |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5267
diff
changeset
|
13 ;; Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5267
diff
changeset
|
14 ;; option) any later version. |
| 428 | 15 |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5267
diff
changeset
|
16 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5267
diff
changeset
|
17 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5267
diff
changeset
|
18 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5267
diff
changeset
|
19 ;; for more details. |
| 428 | 20 |
| 21 ;; You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5267
diff
changeset
|
22 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
| 428 | 23 |
| 24 ;;; Synched up with: Not in FSF. | |
| 25 | |
| 26 ;;; Commentary: | |
| 27 | |
| 28 ;; This file is dumped with XEmacs. | |
| 29 | |
| 30 ;;; Code: | |
| 31 | |
| 32 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 33 ;;; General mouse modeline stuff ;;; | |
| 34 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 35 | |
| 36 (defgroup modeline nil | |
| 37 "Modeline customizations." | |
| 38 :group 'environment) | |
| 39 | |
| 442 | 40 (defcustom modeline-3d-p ;; added for the options menu |
| 41 (let ((thickness | |
| 42 (specifier-instance modeline-shadow-thickness))) | |
| 43 (and (integerp thickness) | |
| 44 (> thickness 0))) | |
|
4578
49e17f7182f5
Fix docstring copy-pasto.
"Ville Skyttä <scop@xemacs.org>"
parents:
4043
diff
changeset
|
45 "Whether the modeline is displayed with raised, 3-d appearance. |
| 771 | 46 This option only has an effect when set using `customize-set-variable', |
| 47 or through the Options menu." | |
| 442 | 48 :group 'display |
| 49 :type 'boolean | |
| 50 :set #'(lambda (var val) | |
| 51 (if val | |
| 52 (set-specifier modeline-shadow-thickness 2) | |
| 53 (set-specifier modeline-shadow-thickness 0)) | |
| 54 (redraw-modeline t) | |
| 55 (setq modeline-3d-p val)) | |
| 56 ) | |
| 57 | |
| 428 | 58 (defcustom drag-divider-event-lag 150 |
| 59 "*The pause (in msecs) between divider drag events before redisplaying. | |
| 60 If this value is too small, dragging will be choppy because redisplay cannot | |
| 61 keep up. If it is too large, dragging will be choppy because of the explicit | |
| 62 redisplay delay specified." | |
| 63 :type 'integer | |
| 64 ;; #### Fix group. | |
| 65 :group 'modeline) | |
| 66 | |
| 67 (define-obsolete-variable-alias | |
| 68 'drag-modeline-event-lag | |
| 69 'drag-divider-event-lag) | |
| 70 | |
| 71 (defcustom modeline-click-swaps-buffers nil | |
| 72 "*If non-nil, clicking on the modeline changes the current buffer. | |
| 73 Click on the left half of the modeline cycles forward through the | |
| 74 buffer list and clicking on the right half cycles backward." | |
| 75 :type 'boolean | |
| 76 :group 'modeline) | |
| 77 | |
| 438 | 78 (defcustom modeline-scrolling-method nil |
| 79 "*If non-nil, dragging the modeline with the mouse may also scroll its | |
| 80 text horizontally (vertical motion controls window resizing and horizontal | |
| 81 motion controls modeline scrolling). | |
| 82 | |
| 83 With a value of t, the modeline text is scrolled in the same direction as | |
| 84 the mouse motion. With a value of 'scrollbar, the modeline is considered as | |
| 771 | 85 a scrollbar for its own text, which then moves in the opposite direction. |
| 86 | |
| 87 This option should be set using `customize-set-variable'." | |
| 438 | 88 :type '(choice (const :tag "none" nil) |
| 89 (const :tag "text" t) | |
| 90 (const :tag "scrollbar" scrollbar)) | |
| 91 :set (lambda (sym val) | |
| 92 (set-default sym val) | |
| 93 (when (featurep 'x) | |
| 94 (cond ((eq val t) | |
| 95 (set-glyph-image modeline-pointer-glyph "hand2" 'global 'x)) | |
| 96 ((eq val 'scrollbar) | |
| 97 (set-glyph-image modeline-pointer-glyph "fleur" 'global 'x)) | |
| 98 (t | |
| 99 (set-glyph-image modeline-pointer-glyph "sb_v_double_arrow" | |
| 442 | 100 'global 'x)))) |
| 101 (when (featurep 'mswindows) | |
| 102 (cond ((eq val t) | |
| 103 (set-glyph-image modeline-pointer-glyph | |
| 104 [mswindows-resource :resource-type cursor | |
| 105 :resource-id "SizeAll"] | |
| 106 'global 'mswindows)) | |
| 107 ((eq val 'scrollbar) | |
| 108 (set-glyph-image modeline-pointer-glyph | |
| 109 [mswindows-resource :resource-type cursor | |
| 110 :resource-id "Normal"] | |
| 111 'global 'mswindows)) | |
| 112 (t | |
| 113 (set-glyph-image modeline-pointer-glyph | |
| 114 [mswindows-resource :resource-type cursor | |
| 115 :resource-id "SizeNS"] | |
| 116 'global 'mswindows))))) | |
| 438 | 117 :group 'modeline) |
| 118 | |
| 428 | 119 (defun mouse-drag-modeline (event) |
| 120 "Resize a window by dragging its modeline. | |
| 121 This command should be bound to a button-press event in modeline-map. | |
| 122 Holding down a mouse button and moving the mouse up and down will | |
| 438 | 123 make the clicked-on window taller or shorter. |
| 124 | |
| 125 See also the variable `modeline-scrolling-method'." | |
| 428 | 126 (interactive "e") |
| 127 (or (button-press-event-p event) | |
| 128 (error "%s must be invoked by a mouse-press" this-command)) | |
| 129 (or (event-over-modeline-p event) | |
| 130 (error "not over a modeline")) | |
| 131 ;; Give the modeline a "pressed" look. --hniksic | |
| 132 (let-specifier ((modeline-shadow-thickness | |
| 133 (- (specifier-instance modeline-shadow-thickness | |
| 134 (event-window event))) | |
| 135 (event-window event))) | |
| 136 (let ((done nil) | |
| 137 (depress-line (event-y event)) | |
| 138 (start-event-frame (event-frame event)) | |
| 139 (start-event-window (event-window event)) | |
| 140 (start-nwindows (count-windows t)) | |
| 438 | 141 (hscroll-delta (face-width 'modeline)) |
| 142 (start-hscroll (modeline-hscroll (event-window event))) | |
| 143 (start-x-pixel (event-x-pixel event)) | |
| 428 | 144 (last-timestamp 0) |
| 145 default-line-height | |
| 146 modeline-height | |
| 147 should-enlarge-minibuffer | |
| 148 event min-height minibuffer y top bot edges wconfig growth) | |
| 149 (setq minibuffer (minibuffer-window start-event-frame) | |
| 150 default-line-height (face-height 'default start-event-window) | |
| 151 min-height (+ (* window-min-height default-line-height) | |
| 152 ;; Don't let the window shrink by a | |
| 153 ;; non-multiple of the default line | |
| 154 ;; height. (enlarge-window -1) will do | |
| 155 ;; this if the difference between the | |
| 156 ;; current window height and the minimum | |
| 157 ;; window height is less than the height | |
| 158 ;; of the default font. These extra | |
| 159 ;; lost pixels of height don't come back | |
| 160 ;; if you grow the window again. This | |
| 161 ;; can make it impossible to drag back | |
| 162 ;; to the exact original size, which is | |
| 163 ;; disconcerting. | |
| 164 (% (window-pixel-height start-event-window) | |
| 165 default-line-height)) | |
| 166 modeline-height | |
| 167 (if (specifier-instance has-modeline-p start-event-window) | |
| 168 (+ (face-height 'modeline start-event-window) | |
| 169 (* 2 (specifier-instance modeline-shadow-thickness | |
| 170 start-event-window))) | |
| 171 (* 2 (specifier-instance modeline-shadow-thickness | |
| 172 start-event-window)))) | |
| 173 (if (not (eq (window-frame minibuffer) start-event-frame)) | |
| 174 (setq minibuffer nil)) | |
| 175 (if (and (null minibuffer) (one-window-p t)) | |
| 176 (error "Attempt to resize sole window")) | |
| 177 ;; if this is the bottommost ordinary window, then to | |
| 178 ;; move its modeline the minibuffer must be enlarged. | |
| 179 (setq should-enlarge-minibuffer | |
| 180 (and minibuffer (window-lowest-p start-event-window))) | |
| 181 ;; loop reading events | |
| 182 (while (not done) | |
| 183 (setq event (next-event event)) | |
| 184 ;; requeue event and quit if this is a misc-user, eval or | |
| 185 ;; keypress event. | |
| 186 ;; quit if this is a button press or release event, or if the event | |
| 187 ;; occurred in some other frame. | |
| 188 ;; drag if this is a mouse motion event and the time | |
| 189 ;; between this event and the last event is greater than | |
| 190 ;; drag-divider-event-lag. | |
| 191 ;; do nothing if this is any other kind of event. | |
| 192 (cond ((or (misc-user-event-p event) | |
| 193 (key-press-event-p event)) | |
| 194 (setq unread-command-events (nconc unread-command-events | |
| 195 (list event)) | |
| 196 done t)) | |
| 197 ((button-release-event-p event) | |
| 198 (setq done t) | |
| 199 ;; Consider we have a mouse click neither X pos (modeline | |
| 200 ;; scroll) nore Y pos (modeline drag) have changed. | |
| 201 (and modeline-click-swaps-buffers | |
| 202 (= depress-line (event-y event)) | |
| 438 | 203 (or (not modeline-scrolling-method) |
| 204 (= start-hscroll | |
| 205 (modeline-hscroll start-event-window))) | |
| 428 | 206 (modeline-swap-buffers event))) |
| 207 ((button-event-p event) | |
| 208 (setq done t)) | |
| 209 ((not (motion-event-p event)) | |
| 210 (dispatch-event event)) | |
| 211 ((not (eq start-event-frame (event-frame event))) | |
| 212 (setq done t)) | |
| 213 ((< (abs (- (event-timestamp event) last-timestamp)) | |
| 214 drag-divider-event-lag) | |
| 215 nil) | |
| 216 (t | |
| 438 | 217 (when modeline-scrolling-method |
| 218 (let ((delta (/ (- (event-x-pixel event) start-x-pixel) | |
| 219 hscroll-delta))) | |
| 220 (set-modeline-hscroll start-event-window | |
| 221 (if (eq modeline-scrolling-method t) | |
| 222 (- start-hscroll delta) | |
| 223 (+ start-hscroll delta))) | |
| 224 )) | |
| 428 | 225 (setq last-timestamp (event-timestamp event) |
| 226 y (event-y-pixel event) | |
| 227 edges (window-pixel-edges start-event-window) | |
| 228 top (nth 1 edges) | |
| 229 bot (nth 3 edges)) | |
| 230 ;; scale back a move that would make the | |
| 231 ;; window too short. | |
| 232 (cond ((< (- y top (- modeline-height)) min-height) | |
| 233 (setq y (+ top min-height (- modeline-height))))) | |
| 234 ;; compute size change needed | |
| 235 (setq growth (- y bot (/ (- modeline-height) 2)) | |
| 236 wconfig (current-window-configuration)) | |
| 237 ;; grow/shrink minibuffer? | |
| 238 (if should-enlarge-minibuffer | |
| 239 (progn | |
| 240 ;; yes. scale back shrinkage if it | |
| 241 ;; would make the minibuffer less than 1 | |
| 242 ;; line tall. | |
| 243 ;; | |
| 244 ;; also flip the sign of the computed growth, | |
| 245 ;; since if we want to grow the window with the | |
| 246 ;; modeline we need to shrink the minibuffer | |
| 247 ;; and vice versa. | |
| 248 (if (and (> growth 0) | |
| 249 (< (- (window-pixel-height minibuffer) | |
| 250 growth) | |
| 251 default-line-height)) | |
| 252 (setq growth | |
| 253 (- (window-pixel-height minibuffer) | |
| 254 default-line-height))) | |
| 255 (setq growth (- growth)))) | |
| 256 ;; window grow and shrink by lines not pixels, so | |
| 257 ;; divide the pixel height by the height of the | |
| 258 ;; default face. | |
| 259 (setq growth (/ growth default-line-height)) | |
| 260 ;; grow/shrink the window | |
| 261 (enlarge-window growth nil (if should-enlarge-minibuffer | |
| 262 minibuffer | |
| 263 start-event-window)) | |
| 264 ;; if this window's growth caused another | |
| 265 ;; window to be deleted because it was too | |
| 266 ;; short, rescind the change. | |
| 267 ;; | |
| 268 ;; if size change caused space to be stolen | |
| 269 ;; from a window above this one, rescind the | |
| 270 ;; change, but only if we didn't grow/shrink | |
| 271 ;; the minibuffer. minibuffer size changes | |
| 272 ;; can cause all windows to shrink... no way | |
| 273 ;; around it. | |
| 274 (if (or (/= start-nwindows (count-windows t)) | |
| 275 (and (not should-enlarge-minibuffer) | |
| 276 (/= top (nth 1 (window-pixel-edges | |
| 277 start-event-window))))) | |
| 278 (set-window-configuration wconfig)))))))) | |
| 279 | |
| 280 ;; from Bob Weiner (bob_weiner@pts.mot.com) | |
| 281 ;; Whether this function should be called is now decided in | |
| 282 ;; mouse-drag-modeline - dverna feb. 98 | |
| 283 (defun modeline-swap-buffers (event) | |
| 284 "Handle mouse clicks on modeline by switching buffers. | |
| 285 If click on left half of a frame's modeline, bury current buffer. | |
| 286 If click on right half of a frame's modeline, raise bottommost buffer. | |
| 287 Arg EVENT is the button release event that occurred on the modeline." | |
| 288 (or (event-over-modeline-p event) | |
| 289 (error "not over a modeline")) | |
| 290 (or (button-release-event-p event) | |
| 291 (error "not a button release event")) | |
| 292 (if (< (event-x event) (/ (window-width (event-window event)) 2)) | |
| 293 ;; On left half of modeline, bury current buffer, | |
| 294 ;; displaying second buffer on list. | |
| 295 (mouse-bury-buffer event) | |
| 296 ;; On right half of modeline, raise and display bottommost | |
| 297 ;; buffer in buffer list. | |
| 298 (mouse-unbury-buffer event))) | |
| 299 | |
| 300 (defconst modeline-menu | |
| 301 '("Window Commands" | |
| 302 ["Delete Window Above" delete-window t] | |
| 303 ["Delete Other Windows" delete-other-windows t] | |
| 304 ["Split Window Above" split-window-vertically t] | |
| 305 ["Split Window Horizontally" split-window-horizontally t] | |
| 306 ["Balance Windows" balance-windows t] | |
| 307 )) | |
| 308 | |
| 309 (defun modeline-menu (event) | |
| 310 (interactive "e") | |
| 311 (popup-menu-and-execute-in-window | |
| 312 (cons (format "Window Commands for %S:" | |
| 313 (buffer-name (event-buffer event))) | |
| 314 (cdr modeline-menu)) | |
| 315 event)) | |
| 316 | |
| 317 (defvar modeline-map (make-sparse-keymap 'modeline-map) | |
| 318 "Keymap consulted for mouse-clicks on the modeline of a window. | |
| 319 This variable may be buffer-local; its value will be looked up in | |
| 320 the buffer of the window whose modeline was clicked upon.") | |
| 321 | |
| 322 (define-key modeline-map 'button1 'mouse-drag-modeline) | |
| 323 ;; button2 selects the window without setting point | |
| 324 (define-key modeline-map 'button2 (lambda () (interactive "@"))) | |
| 325 (define-key modeline-map 'button3 'modeline-menu) | |
| 326 | |
| 327 (make-face 'modeline-mousable "Face for mousable portions of the modeline.") | |
| 328 (set-face-parent 'modeline-mousable 'modeline nil '(default)) | |
| 329 (when (featurep 'window-system) | |
| 440 | 330 (set-face-foreground 'modeline-mousable "firebrick" nil '(default color win)) |
| 331 (set-face-font 'modeline-mousable [bold] nil '(default mono win)) | |
| 332 (set-face-font 'modeline-mousable [bold] nil '(default grayscale win))) | |
| 428 | 333 |
| 334 (defmacro make-modeline-command-wrapper (command) | |
| 335 `#'(lambda (event) | |
| 336 (interactive "e") | |
| 337 (save-selected-window | |
| 338 (select-window (event-window event)) | |
| 339 (call-interactively ',(eval command))))) | |
| 340 | |
| 341 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 342 ;;; Minor modes ;;; | |
| 343 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 344 | |
| 345 (defvar minor-mode-alist nil | |
| 346 "Alist saying how to show minor modes in the modeline. | |
| 347 Each element looks like (VARIABLE STRING); | |
| 348 STRING is included in the modeline iff VARIABLE's value is non-nil. | |
| 349 | |
| 350 Actually, STRING need not be a string; any possible modeline element | |
| 351 is okay. See `modeline-format'.") | |
| 352 | |
| 353 ;; Used by C code (lookup-key and friends) but defined here. | |
| 354 (defvar minor-mode-map-alist nil | |
| 355 "Alist of keymaps to use for minor modes. | |
| 356 Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read | |
| 357 key sequences and look up bindings iff VARIABLE's value is non-nil. | |
| 358 If two active keymaps bind the same key, the keymap appearing earlier | |
| 359 in the list takes precedence.") | |
| 360 | |
| 361 (make-face 'modeline-mousable-minor-mode | |
| 362 "Face for mousable minor-mode strings in the modeline.") | |
| 363 (set-face-parent 'modeline-mousable-minor-mode 'modeline-mousable nil | |
| 364 '(default)) | |
| 365 (when (featurep 'window-system) | |
| 440 | 366 (set-face-foreground 'modeline-mousable-minor-mode '("green4" "forestgreen") |
| 367 nil '(default color win))) | |
| 428 | 368 |
| 369 (defvar modeline-mousable-minor-mode-extent (make-extent nil nil) | |
| 370 ;; alliteration at its finest. | |
| 371 "Extent managing the mousable minor mode modeline strings.") | |
| 372 (set-extent-face modeline-mousable-minor-mode-extent | |
| 373 'modeline-mousable-minor-mode) | |
| 374 | |
| 375 ;; This replaces the idiom | |
| 376 ;; | |
| 377 ;; (or (assq 'isearch-mode minor-mode-alist) | |
| 378 ;; (setq minor-mode-alist | |
| 379 ;; (purecopy | |
| 380 ;; (append minor-mode-alist | |
| 381 ;; '((isearch-mode isearch-mode)))))) | |
| 382 | |
| 383 (defun add-minor-mode (toggle name &optional keymap after toggle-fun) | |
| 384 "Add a minor mode to `minor-mode-alist' and `minor-mode-map-alist'. | |
| 385 | |
| 386 TOGGLE is a symbol whose value as a variable specifies whether the | |
| 387 minor mode is active. | |
| 388 | |
| 389 NAME is the name that should appear in the modeline. It should either | |
| 390 be a string beginning with a space, or a symbol with a similar string | |
| 391 as its value. | |
| 392 | |
| 393 KEYMAP is a keymap to make active when the minor mode is active. | |
| 394 | |
| 395 AFTER is the toggling symbol used for another minor mode. If AFTER is | |
| 396 non-nil, then it is used to position the new mode in the minor-mode | |
| 397 alists. | |
| 398 | |
| 399 TOGGLE-FUN specifies an interactive function that is called to toggle | |
| 400 the mode on and off; this affects what happens when button2 is pressed | |
| 401 on the mode, and when button3 is pressed somewhere in the list of | |
| 402 modes. If TOGGLE-FUN is nil and TOGGLE names an interactive function, | |
| 403 TOGGLE is used as the toggle function. | |
| 404 | |
| 405 Example: (add-minor-mode 'view-minor-mode \" View\" view-mode-map)" | |
| 406 (let* ((add-elt #'(lambda (elt sym) | |
| 407 (let (place) | |
| 408 (cond ((null after) ; add to front | |
| 409 (push elt (symbol-value sym))) | |
| 410 ((and (not (eq after t)) | |
| 411 (setq place (memq (assq after | |
| 412 (symbol-value sym)) | |
| 413 (symbol-value sym)))) | |
| 414 (push elt (cdr place))) | |
| 415 (t | |
| 416 (set sym (append (symbol-value sym) | |
| 417 (list elt)))))) | |
| 418 (symbol-value sym))) | |
| 419 el toggle-keymap) | |
| 420 (if toggle-fun | |
| 421 (check-argument-type 'commandp toggle-fun) | |
| 422 (when (commandp toggle) | |
| 423 (setq toggle-fun toggle))) | |
| 424 (when (and toggle-fun name) | |
| 425 (setq toggle-keymap (make-sparse-keymap | |
| 426 (intern (concat "modeline-minor-" | |
| 427 (symbol-name toggle) | |
| 428 "-map")))) | |
| 429 (define-key toggle-keymap 'button2 | |
| 430 ;; defeat the DUMB-ASS byte-compiler, which tries to | |
| 431 ;; expand the macro at compile time and fucks up. | |
| 432 (eval '(make-modeline-command-wrapper toggle-fun))) | |
| 433 (put toggle 'modeline-toggle-function toggle-fun)) | |
| 434 (when name | |
| 435 (let ((hacked-name | |
| 436 (if toggle-keymap | |
| 437 (cons (let ((extent (make-extent nil nil))) | |
| 438 (set-extent-keymap extent toggle-keymap) | |
| 439 (set-extent-property | |
| 440 extent 'help-echo | |
| 441 (concat "button2 turns off " | |
| 442 (if (symbolp toggle-fun) | |
| 443 (symbol-name toggle-fun) | |
| 444 (symbol-name toggle)))) | |
| 445 extent) | |
| 446 (cons modeline-mousable-minor-mode-extent name)) | |
| 447 name))) | |
| 448 (if (setq el (assq toggle minor-mode-alist)) | |
| 449 (setcdr el (list hacked-name)) | |
| 438 | 450 (funcall add-elt |
| 428 | 451 (list toggle hacked-name) |
| 452 'minor-mode-alist)))) | |
| 453 (when keymap | |
| 454 (if (setq el (assq toggle minor-mode-map-alist)) | |
| 455 (setcdr el keymap) | |
| 456 (funcall add-elt | |
| 457 (cons toggle keymap) | |
| 458 'minor-mode-map-alist))))) | |
| 459 | |
| 695 | 460 (defcustom abbrev-mode-line-string " Abbrev" |
| 461 "*String to display in the modeline when `abbrev-mode' is active. | |
| 462 Set this to nil if you don't want a modeline indicator." | |
| 463 :type '(choice string | |
| 729 | 464 (const :tag "none" nil)) |
| 465 :group 'abbrev-mode) | |
| 695 | 466 |
| 467 (defcustom overwrite-mode-line-string " Ovwrt" | |
| 468 "*String to display in the modeline when `overwrite-mode' is active. | |
| 469 Set this to nil if you don't want a modeline indicator." | |
| 470 :type '(choice string | |
| 729 | 471 (const :tag "none" nil)) |
| 472 :group 'editing-basics) | |
| 695 | 473 |
| 474 (defcustom auto-fill-mode-line-string " Fill" | |
| 475 "*String to display in the modeline when `auto-fill-mode' is active. | |
| 476 Set this to nil if you don't want a modeline indicator." | |
| 477 :type '(choice string | |
| 729 | 478 (const :tag "none" nil)) |
| 479 :group 'fill) | |
| 695 | 480 |
| 481 (defcustom defining-kbd-macro-mode-line-string " Def" | |
| 482 "*String to display in the modeline when `defining-kbd-macro' is active. | |
| 483 Set this to nil if you don't want a modeline indicator." | |
| 484 :type '(choice string | |
| 729 | 485 (const :tag "none" nil)) |
| 486 :group 'keyboard) | |
| 695 | 487 |
| 428 | 488 ;; #### TODO: Add `:menu-tag' keyword to add-minor-mode. Or create a |
| 489 ;; separate function to manage the minor mode menu. | |
| 490 | |
| 491 ;(put 'abbrev-mode :menu-tag "Abbreviation Expansion") | |
| 695 | 492 (add-minor-mode 'abbrev-mode 'abbrev-mode-line-string) |
| 428 | 493 ;; only when visiting a file... |
| 695 | 494 (add-minor-mode 'overwrite-mode 'overwrite-mode-line-string) |
| 428 | 495 ;(put 'auto-fill-function :menu-tag "Auto Fill") |
| 695 | 496 (add-minor-mode 'auto-fill-function 'auto-fill-mode-line-string |
| 497 nil nil 'auto-fill-mode) | |
| 428 | 498 |
| 499 ;(put 'defining-kbd-macro :menu-tag "Keyboard Macro") | |
| 695 | 500 (add-minor-mode 'defining-kbd-macro 'defining-kbd-macro-mode-line-string |
| 501 nil nil | |
| 428 | 502 (lambda () |
| 503 (interactive) | |
| 504 (if defining-kbd-macro | |
| 505 (progn | |
| 506 ;; #### This means to disregard the last event. | |
| 507 ;; It is needed because the last recorded | |
| 508 ;; event is usually the mouse event that | |
| 509 ;; invoked the menu item (and this function), | |
| 510 ;; and having it in the macro causes problems. | |
| 511 (zap-last-kbd-macro-event) | |
| 512 (end-kbd-macro nil)) | |
| 513 (start-kbd-macro nil)))) | |
| 514 | |
| 515 (defun modeline-minor-mode-menu (event) | |
| 516 "The menu that pops up when you press `button3' inside the | |
| 517 parentheses on the modeline." | |
| 518 (interactive "e") | |
| 519 (save-excursion | |
| 520 (set-buffer (event-buffer event)) | |
| 521 (popup-menu-and-execute-in-window | |
| 522 (cons | |
| 523 "Minor Mode Toggles" | |
| 524 (sort | |
|
5267
668c73e222fd
Change forms like (delq nil (mapcar ...)) to (mapcan ...).
Aidan Kehoe <kehoea@parhasard.net>
parents:
4578
diff
changeset
|
525 (mapcan |
|
668c73e222fd
Change forms like (delq nil (mapcar ...)) to (mapcan ...).
Aidan Kehoe <kehoea@parhasard.net>
parents:
4578
diff
changeset
|
526 #'(lambda (x) |
|
668c73e222fd
Change forms like (delq nil (mapcar ...)) to (mapcan ...).
Aidan Kehoe <kehoea@parhasard.net>
parents:
4578
diff
changeset
|
527 (let* ((toggle-sym (car x)) |
|
668c73e222fd
Change forms like (delq nil (mapcar ...)) to (mapcan ...).
Aidan Kehoe <kehoea@parhasard.net>
parents:
4578
diff
changeset
|
528 (toggle-fun (or (get toggle-sym |
|
668c73e222fd
Change forms like (delq nil (mapcar ...)) to (mapcan ...).
Aidan Kehoe <kehoea@parhasard.net>
parents:
4578
diff
changeset
|
529 'modeline-toggle-function) |
|
668c73e222fd
Change forms like (delq nil (mapcar ...)) to (mapcan ...).
Aidan Kehoe <kehoea@parhasard.net>
parents:
4578
diff
changeset
|
530 (and (commandp toggle-sym) |
|
668c73e222fd
Change forms like (delq nil (mapcar ...)) to (mapcan ...).
Aidan Kehoe <kehoea@parhasard.net>
parents:
4578
diff
changeset
|
531 toggle-sym))) |
|
668c73e222fd
Change forms like (delq nil (mapcar ...)) to (mapcan ...).
Aidan Kehoe <kehoea@parhasard.net>
parents:
4578
diff
changeset
|
532 (menu-tag (symbol-name (if (symbolp toggle-fun) |
|
668c73e222fd
Change forms like (delq nil (mapcar ...)) to (mapcan ...).
Aidan Kehoe <kehoea@parhasard.net>
parents:
4578
diff
changeset
|
533 toggle-fun |
|
668c73e222fd
Change forms like (delq nil (mapcar ...)) to (mapcan ...).
Aidan Kehoe <kehoea@parhasard.net>
parents:
4578
diff
changeset
|
534 toggle-sym)) |
|
668c73e222fd
Change forms like (delq nil (mapcar ...)) to (mapcan ...).
Aidan Kehoe <kehoea@parhasard.net>
parents:
4578
diff
changeset
|
535 ;; Here a function should maybe be invoked to |
|
668c73e222fd
Change forms like (delq nil (mapcar ...)) to (mapcan ...).
Aidan Kehoe <kehoea@parhasard.net>
parents:
4578
diff
changeset
|
536 ;; beautify the symbol's menu appearance. |
|
668c73e222fd
Change forms like (delq nil (mapcar ...)) to (mapcan ...).
Aidan Kehoe <kehoea@parhasard.net>
parents:
4578
diff
changeset
|
537 )) |
|
668c73e222fd
Change forms like (delq nil (mapcar ...)) to (mapcan ...).
Aidan Kehoe <kehoea@parhasard.net>
parents:
4578
diff
changeset
|
538 (and toggle-fun |
|
668c73e222fd
Change forms like (delq nil (mapcar ...)) to (mapcan ...).
Aidan Kehoe <kehoea@parhasard.net>
parents:
4578
diff
changeset
|
539 (list (vector menu-tag |
|
668c73e222fd
Change forms like (delq nil (mapcar ...)) to (mapcan ...).
Aidan Kehoe <kehoea@parhasard.net>
parents:
4578
diff
changeset
|
540 toggle-fun |
|
668c73e222fd
Change forms like (delq nil (mapcar ...)) to (mapcan ...).
Aidan Kehoe <kehoea@parhasard.net>
parents:
4578
diff
changeset
|
541 ;; The following two are wrong because of |
|
668c73e222fd
Change forms like (delq nil (mapcar ...)) to (mapcan ...).
Aidan Kehoe <kehoea@parhasard.net>
parents:
4578
diff
changeset
|
542 ;; possible name clashes. |
|
668c73e222fd
Change forms like (delq nil (mapcar ...)) to (mapcan ...).
Aidan Kehoe <kehoea@parhasard.net>
parents:
4578
diff
changeset
|
543 ;:active (get toggle-sym :active t) |
|
668c73e222fd
Change forms like (delq nil (mapcar ...)) to (mapcan ...).
Aidan Kehoe <kehoea@parhasard.net>
parents:
4578
diff
changeset
|
544 ;:included (get toggle-sym :included t) |
|
668c73e222fd
Change forms like (delq nil (mapcar ...)) to (mapcan ...).
Aidan Kehoe <kehoea@parhasard.net>
parents:
4578
diff
changeset
|
545 :style 'toggle |
|
668c73e222fd
Change forms like (delq nil (mapcar ...)) to (mapcan ...).
Aidan Kehoe <kehoea@parhasard.net>
parents:
4578
diff
changeset
|
546 :selected (and (boundp toggle-sym) |
|
668c73e222fd
Change forms like (delq nil (mapcar ...)) to (mapcan ...).
Aidan Kehoe <kehoea@parhasard.net>
parents:
4578
diff
changeset
|
547 toggle-sym)))))) |
|
668c73e222fd
Change forms like (delq nil (mapcar ...)) to (mapcan ...).
Aidan Kehoe <kehoea@parhasard.net>
parents:
4578
diff
changeset
|
548 minor-mode-alist) |
|
668c73e222fd
Change forms like (delq nil (mapcar ...)) to (mapcan ...).
Aidan Kehoe <kehoea@parhasard.net>
parents:
4578
diff
changeset
|
549 (lambda (e1 e2) (string< (aref e1 0) (aref e2 0))))) |
| 428 | 550 event))) |
| 551 | |
| 552 (defvar modeline-minor-mode-map (make-sparse-keymap 'modeline-minor-mode-map) | |
| 553 "Keymap consulted for mouse-clicks on the minor-mode modeline list.") | |
| 554 (define-key modeline-minor-mode-map 'button3 'modeline-minor-mode-menu) | |
| 555 | |
| 556 (defvar modeline-minor-mode-extent (make-extent nil nil) | |
| 557 "Extent covering the minor mode modeline strings.") | |
| 558 (set-extent-face modeline-minor-mode-extent 'modeline-mousable) | |
| 559 (set-extent-keymap modeline-minor-mode-extent modeline-minor-mode-map) | |
| 560 | |
| 561 | |
| 562 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 771 | 563 ;;; Modeline definition ;;; |
| 428 | 564 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 565 | |
| 771 | 566 (defmacro define-modeline-control (name contents doc-string &optional face |
| 567 help-echo) | |
| 568 "Define a modeline control named NAME, a symbol. | |
| 569 A modeline control is a section of the modeline whose contents can easily | |
| 570 be changed independently of the rest of the modeline, which can have its | |
| 571 own color, and which can have its own mouse commands, which apply when the | |
| 572 mouse is over the control. | |
| 573 | |
| 574 Logically, a modeline control should be an object; but we have terrible | |
| 575 object support in XEmacs, and so history has given us a series of related | |
| 576 variables, which [hopefully] all follow the same conventions. | |
| 577 | |
| 578 Three variables are created: | |
| 579 | |
| 580 1. The variable holding the control specification is called | |
| 581 `modeline-NAME', and is automatically buffer-local. | |
| 582 | |
| 583 2. The variable holding the extent that covers the control area in the | |
| 584 modeline is called `modeline-NAME-extent'. Onto this extent, colors and | |
| 585 keymaps (and possibly glyphs?) can be added, and will be noticed by the | |
| 586 modeline redisplay code. The attachment of the extent and its control | |
| 587 is done somewhere in the modeline specification: either in the main spec | |
| 588 in `modeline-format', or in some other control, like this: | |
| 589 | |
| 590 (cons modeline-NAME-extent 'modeline-NAME) | |
| 591 | |
| 592 3. The keymap holding the mousable commands for the control is called | |
| 593 `modeline-NAME-map'. This is automatically attached to the extent by | |
| 594 this macro. | |
| 595 | |
| 596 Initial contents of the control are CONTENTS (see `modeline-format' for | |
| 597 information about the structure of this contents). DOC-STRING specifies | |
| 598 help text that will be placed in the control variable's documentation, | |
| 599 indicating what's supposed to be in the control. | |
| 600 | |
| 601 Optional argument FACE specifies the face of the control's | |
| 602 extent. (`modeline-mousable' is a good choice if your control is, in fact, | |
| 603 mousable (i.e. it has some mouse commands defined for it). Optional | |
| 604 argument HELP-ECHO specifies some help-echo to be displayed when the mouse | |
| 605 moves over the control, indicating what mouse strokes are available. " | |
| 606 (let ((control-var (intern (format "modeline-%s" name))) | |
| 607 (extent-var (intern (format "modeline-%s-extent" name))) | |
| 608 (map-var (intern (format "modeline-%s-map" name))) | |
| 609 ) | |
| 610 `(progn | |
| 611 (defconst ,control-var ,contents | |
| 612 ,(format "%s | |
| 613 | |
| 614 The format of the contents of this variable is documented in | |
| 615 `modeline-format'. The way the control is displayed can be changed by | |
| 616 setting the face of `%s'. Mouse commands | |
| 617 for the control can be set using `%s'." doc-string extent-var map-var)) | |
| 618 (make-variable-buffer-local ',control-var) | |
| 619 (defvar ,extent-var (make-extent nil nil) | |
| 620 ,(format "Extent covering the `%s' control." control-var)) | |
| 621 (defvar ,map-var (make-sparse-keymap 'modeline-narrowed-map) | |
| 622 ,(format "Keymap consulted for mouse-clicks on the `%s' control." | |
| 623 control-var)) | |
| 624 (set-extent-face ,extent-var ,face) | |
| 625 (set-extent-keymap ,extent-var ,map-var) | |
| 626 (set-extent-property ,extent-var 'help-echo ,help-echo)))) | |
| 627 (put 'define-modeline-control 'lisp-indent-function 2) | |
| 628 | |
| 629 ;; ------------------------ modeline buffer id ------------------- | |
| 630 | |
| 428 | 631 (defun modeline-buffers-menu (event) |
| 632 (interactive "e") | |
| 633 (popup-menu-and-execute-in-window | |
| 634 '("Buffers Popup Menu" | |
| 635 :filter buffers-menu-filter | |
| 636 ["List All Buffers" list-buffers t] | |
| 637 "--" | |
| 638 ) | |
| 639 event)) | |
| 640 | |
| 771 | 641 (define-modeline-control buffer-id-left |
| 642 'modeline-modified-buffer-highlighted-name ;; "XEmacs:" | |
| 643 "Modeline control for left half of buffer ID." | |
| 644 'modeline-mousable | |
| 645 "button2 cycles to the previous buffer") | |
| 428 | 646 |
| 771 | 647 (define-modeline-control buffer-id-right |
| 648 'modeline-modified-buffer-non-highlighted-name ;; " %17b" | |
| 649 "Modeline control for right half of buffer ID." | |
| 650 nil | |
| 651 "button2 cycles to the next buffer") | |
| 428 | 652 |
| 653 (define-key modeline-buffer-id-left-map 'button2 'mouse-unbury-buffer) | |
| 654 (define-key modeline-buffer-id-right-map 'button2 'mouse-bury-buffer) | |
| 655 (define-key modeline-buffer-id-left-map 'button3 'modeline-buffers-menu) | |
| 656 (define-key modeline-buffer-id-right-map 'button3 'modeline-buffers-menu) | |
| 657 | |
| 658 (make-face 'modeline-buffer-id | |
| 659 "Face for the buffer ID string in the modeline.") | |
| 660 (set-face-parent 'modeline-buffer-id 'modeline nil '(default)) | |
| 661 (when (featurep 'window-system) | |
| 440 | 662 (set-face-foreground 'modeline-buffer-id "blue4" nil '(default color win)) |
| 663 (set-face-font 'modeline-buffer-id [bold-italic] nil '(default mono win)) | |
| 771 | 664 (set-face-font 'modeline-buffer-id [bold-italic] nil '(default grayscale |
| 665 win))) | |
| 428 | 666 (when (featurep 'tty) |
| 667 (set-face-font 'modeline-buffer-id [bold-italic] nil '(default tty))) | |
| 668 | |
| 771 | 669 (define-modeline-control buffer-id |
| 670 (list (cons modeline-buffer-id-left-extent 'modeline-buffer-id-left) | |
| 671 (cons modeline-buffer-id-right-extent 'modeline-buffer-id-right)) | |
| 428 | 672 "Modeline control for identifying the buffer being displayed. |
| 442 | 673 Its default value is |
| 674 | |
| 771 | 675 (list (cons modeline-buffer-id-left-extent 'modeline-buffer-id-left) |
| 676 (cons modeline-buffer-id-right-extent 'modeline-buffer-id-right)) | |
| 442 | 677 |
| 678 Major modes that edit things other than ordinary files may change this | |
| 771 | 679 (e.g. Info, Dired,...)." |
| 680 'modeline-buffer-id) | |
| 681 | |
| 682 (defvaralias 'modeline-buffer-identification 'modeline-buffer-id) | |
| 683 | |
| 684 (defvar modeline-modified-buffer-non-highlighted-name nil) | |
| 685 (make-variable-buffer-local 'modeline-modified-buffer-non-highlighted-name) | |
| 686 (put 'modeline-modified-buffer-non-highlighted-name 'permanent-local t) | |
| 687 | |
| 688 (defvar modeline-modified-buffer-highlighted-name nil) | |
| 689 (make-variable-buffer-local 'modeline-modified-buffer-highlighted-name) | |
| 690 (put 'modeline-modified-buffer-highlighted-name 'permanent-local t) | |
| 691 | |
| 692 (defvar modeline-recorded-buffer-name nil) | |
| 693 (make-variable-buffer-local 'modeline-recorded-buffer-name) | |
| 694 (put 'modeline-recorded-buffer-name 'permanent-local t) | |
| 695 | |
| 696 (defvar modeline-recorded-buffer-file-name nil) | |
| 697 (make-variable-buffer-local 'modeline-recorded-buffer-file-name) | |
| 698 (put 'modeline-recorded-buffer-file-name 'permanent-local t) | |
| 699 | |
| 700 (add-hook 'buffer-list-changed-hook 'modeline-update-buffer-names) | |
| 701 | |
| 702 (defvar modeline-max-buffer-name-size 30) | |
| 703 | |
| 704 (defun modeline-update-buffer-names (frame) | |
| 705 (mapc #'(lambda (buf) | |
| 706 (when (or (not (eq (buffer-name buf) | |
| 707 (symbol-value-in-buffer | |
| 708 'modeline-recorded-buffer-name buf))) | |
| 709 (not (eq (buffer-file-name buf) | |
| 710 (symbol-value-in-buffer | |
| 711 'modeline-recorded-buffer-file-name buf)))) | |
| 712 ;(dp "processing %s" buf) | |
| 713 (with-current-buffer buf | |
| 714 (setq modeline-recorded-buffer-name (buffer-name)) | |
| 715 (setq modeline-recorded-buffer-file-name (buffer-file-name)) | |
| 716 (if (not modeline-recorded-buffer-file-name) | |
| 717 (setq modeline-modified-buffer-non-highlighted-name | |
| 718 modeline-recorded-buffer-name | |
| 719 modeline-modified-buffer-highlighted-name nil) | |
| 720 (let ((fn | |
| 721 (if (<= (length modeline-recorded-buffer-file-name) | |
| 722 modeline-max-buffer-name-size) | |
| 723 modeline-recorded-buffer-file-name | |
| 724 (concat "..." | |
| 725 (substring | |
| 726 modeline-recorded-buffer-file-name | |
| 727 (- modeline-max-buffer-name-size)))))) | |
| 728 (setq modeline-modified-buffer-non-highlighted-name | |
| 729 ;; if the filename is very long, the entire | |
| 730 ;; directory will get truncated to | |
| 731 ;; non-existence. | |
| 732 (let ((dir (file-name-directory fn))) | |
| 733 (if dir | |
| 734 (concat " (" | |
| 735 (directory-file-name | |
| 736 (file-name-directory fn)) | |
| 737 ")") | |
| 738 "")) | |
| 739 modeline-modified-buffer-highlighted-name | |
| 740 (file-name-nondirectory fn)))) | |
| 741 (redraw-modeline)))) | |
| 742 (buffer-list))) | |
| 743 | |
| 744 (defcustom modeline-new-buffer-id-format t | |
| 745 "Whether the new format for the modeline buffer ID (with directory) is used. | |
| 746 This option only has an effect when set using `customize-set-variable', | |
| 747 or through the Options menu." | |
| 748 :group 'modeline | |
| 749 :type 'boolean | |
| 750 :set #'(lambda (var val) | |
| 751 (if val | |
| 752 (progn | |
| 753 (setq-default modeline-buffer-id-left | |
| 754 'modeline-modified-buffer-highlighted-name | |
| 755 modeline-buffer-id-right | |
| 756 'modeline-modified-buffer-non-highlighted-name) | |
| 757 (set-extent-face modeline-buffer-id-left-extent | |
| 758 'modeline-mousable)) | |
| 759 (setq-default modeline-buffer-id-left "XEmacs:" | |
| 760 modeline-buffer-id-right '(" %17b")) | |
| 761 (set-extent-face modeline-buffer-id-left-extent nil)))) | |
| 762 | |
| 763 ;; ------------------------ other modeline controls ------------------- | |
| 428 | 764 |
| 765 ;; These are for the sake of minor mode menu. #### All of this is | |
| 766 ;; kind of dirty. `add-minor-mode' started out as a simple substitute | |
| 767 ;; for (or (assq ...) ...) FSF stuff, but now is used for all kind of | |
| 768 ;; stuff. There should perhaps be a separate function to add toggles | |
| 769 ;; to the minor-mode-menu. | |
| 770 (add-minor-mode 'line-number-mode "") | |
| 771 (add-minor-mode 'column-number-mode "") | |
| 772 | |
| 771 | 773 (define-modeline-control coding-system '("%C") |
| 774 "Modeline control for showing current coding system.") | |
| 775 ;; added March 7, 2002 | |
| 776 (define-obsolete-variable-alias 'modeline-multibyte-status | |
| 777 'modeline-coding-system) | |
| 428 | 778 |
| 771 | 779 (define-modeline-control modified '("--%1*%1+-") |
| 780 "Modeline control for displaying whether current buffer is modified." | |
| 781 'modeline-mousable | |
| 782 "button2 toggles the buffer's read-only status") | |
| 428 | 783 (define-key modeline-modified-map 'button2 |
| 784 (make-modeline-command-wrapper 'modeline-toggle-read-only)) | |
| 785 | |
| 786 ;;; Added for XEmacs 20.3. Provide wrapper for vc since it may not always be | |
| 787 ;;; present, and its symbols are not visible this early in the dump if it | |
| 788 ;;; is. | |
| 789 | |
| 790 (defun modeline-toggle-read-only () | |
| 791 "Change whether this buffer is visiting its file read-only. | |
| 792 With arg, set read-only iff arg is positive. | |
| 793 This function is designed to be called when the read-only indicator on the | |
| 794 modeline is clicked. It will call `vc-toggle-read-only' if available, | |
| 795 otherwise it will call the usual `toggle-read-only'." | |
| 796 (interactive) | |
| 502 | 797 (if-fboundp 'vc-toggle-read-only |
| 428 | 798 (vc-toggle-read-only) |
| 799 (toggle-read-only))) | |
| 800 | |
| 771 | 801 (define-modeline-control line-number (list 'line-number-mode "L%l ") |
| 802 "Modeline control for displaying the line number of point.") | |
| 803 (define-modeline-control column-number (list 'column-number-mode "C%c ") | |
| 804 "Modeline control for displaying the column number of point.") | |
| 805 (define-modeline-control percentage (cons -3 "%p") | |
| 806 "Modeline control for displaying percentage of file above point.") | |
| 807 | |
| 808 (define-modeline-control position-status | |
| 809 (cons 15 (list | |
| 810 (cons modeline-line-number-extent | |
| 811 'modeline-line-number) | |
| 812 (cons modeline-column-number-extent | |
| 813 'modeline-column-number) | |
| 814 (cons modeline-percentage-extent | |
| 815 'modeline-percentage))) | |
| 816 "Modeline control for providing status about the location of point. | |
| 817 Generally includes the line number of point, its column number, and the | |
| 818 percentage of the file above point." | |
| 819 'modeline-buffer-id) | |
| 820 | |
| 821 (defconst modeline-tty-frame-specifier (make-specifier 'boolean)) | |
| 822 (add-hook 'create-frame-hook 'modeline-update-tty-frame-specifier) | |
| 823 (defun modeline-update-tty-frame-specifier (f) | |
| 4043 | 824 (if (and (eq (frame-type f) 'tty) |
| 825 (> (frame-property f 'frame-number) 1)) | |
| 826 (set-specifier modeline-tty-frame-specifier t f))) | |
| 771 | 827 |
| 828 (define-modeline-control tty-frame-id (list modeline-tty-frame-specifier | |
| 829 " [%S]" | |
| 830 ) | |
| 831 "Modeline control for showing which TTY frame is selected.") | |
| 832 | |
| 833 (define-modeline-control narrowed '("%n") | |
| 834 "Modeline control for displaying whether current buffer is narrowed." | |
| 835 'modeline-mousable | |
| 836 "button2 widens the buffer") | |
| 837 (define-key modeline-narrowed-map 'button2 | |
| 838 (make-modeline-command-wrapper 'widen)) | |
| 839 | |
| 840 (define-modeline-control process nil | |
| 841 "Modeline control for displaying info on process status. | |
| 842 Normally nil in most modes, since there is no process to display.") | |
| 843 | |
| 844 (setq-default | |
| 845 modeline-format | |
| 846 (list | |
| 847 "" | |
| 848 (cons modeline-coding-system-extent 'modeline-coding-system) | |
| 849 (cons modeline-modified-extent 'modeline-modified) | |
| 850 (cons modeline-position-status-extent 'modeline-position-status) | |
| 851 (cons modeline-tty-frame-id-extent 'modeline-tty-frame-id) | |
| 852 (cons modeline-buffer-id-extent 'modeline-buffer-id) | |
| 853 " " | |
| 854 'global-mode-string | |
| 855 " %[(" | |
| 856 (cons modeline-minor-mode-extent | |
| 857 (list "" 'mode-name 'minor-mode-alist)) | |
| 858 (cons modeline-narrowed-extent 'modeline-narrowed) | |
| 859 (cons modeline-process-extent 'modeline-process) | |
| 860 ")%]%-")) | |
| 861 | |
| 428 | 862 ;;; modeline.el ends here |