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