git.chise.org Git - chise/xemacs-chise.git.1/blob - lisp/modeline.el

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