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