lisp/ruler-mode.el

   1 ;;; ruler-mode.el --- display a ruler in the header line
   2
   3 ;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007,
   4 ;;   2008, 2009, 2010, 2011 Free Software Foundation, Inc.
   5
   6 ;; Author: David Ponce <david@dponce.com>
   7 ;; Maintainer: David Ponce <david@dponce.com>
   8 ;; Created: 24 Mar 2001
   9 ;; Version: 1.6
  10 ;; Keywords: convenience
  11
  12 ;; This file is part of GNU Emacs.
  13
  14 ;; GNU Emacs is free software: you can redistribute it and/or modify
  15 ;; it under the terms of the GNU General Public License as published by
  16 ;; the Free Software Foundation, either version 3 of the License, or
  17 ;; (at your option) any later version.
  18
  19 ;; GNU Emacs is distributed in the hope that it will be useful,
  20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ;; GNU General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  26
  27 ;;; Commentary:
  28
  29 ;; This library provides a minor mode to display a ruler in the header
  30 ;; line.  It works from Emacs 21 onwards.
  31 ;;
  32 ;; You can use the mouse to change the `fill-column' `comment-column',
  33 ;; `goal-column', `window-margins' and `tab-stop-list' settings:
  34 ;;
  35 ;; [header-line (shift down-mouse-1)] set left margin end to the ruler
  36 ;; graduation where the mouse pointer is on.
  37 ;;
  38 ;; [header-line (shift down-mouse-3)] set right margin beginning to
  39 ;; the ruler graduation where the mouse pointer is on.
  40 ;;
  41 ;; [header-line down-mouse-2] Drag the `fill-column', `comment-column'
  42 ;; or `goal-column' to a ruler graduation.
  43 ;;
  44 ;; [header-line (control down-mouse-1)] add a tab stop to the ruler
  45 ;; graduation where the mouse pointer is on.
  46 ;;
  47 ;; [header-line (control down-mouse-3)] remove the tab stop at the
  48 ;; ruler graduation where the mouse pointer is on.
  49 ;;
  50 ;; [header-line (control down-mouse-2)] or M-x
  51 ;; `ruler-mode-toggle-show-tab-stops' toggle showing and visually
  52 ;; editing `tab-stop-list' setting.  The `ruler-mode-show-tab-stops'
  53 ;; option controls if the ruler shows tab stops by default.
  54 ;;
  55 ;; In the ruler the character `ruler-mode-current-column-char' shows
  56 ;; the `current-column' location, `ruler-mode-fill-column-char' shows
  57 ;; the `fill-column' location, `ruler-mode-comment-column-char' shows
  58 ;; the `comment-column' location, `ruler-mode-goal-column-char' shows
  59 ;; the `goal-column' and `ruler-mode-tab-stop-char' shows tab stop
  60 ;; locations.  Graduations in `window-margins' and `window-fringes'
  61 ;; areas are shown with a different foreground color.
  62 ;;
  63 ;; It is also possible to customize the following characters:
  64 ;;
  65 ;; - `ruler-mode-basic-graduation-char' character used for basic
  66 ;;   graduations ('.' by default).
  67 ;; - `ruler-mode-inter-graduation-char' character used for
  68 ;;   intermediate graduations ('!' by default).
  69 ;;
  70 ;; The following faces are customizable:
  71 ;;
  72 ;; - `ruler-mode-default' the ruler default face.
  73 ;; - `ruler-mode-fill-column' the face used to highlight the
  74 ;;   `fill-column' character.
  75 ;; - `ruler-mode-comment-column' the face used to highlight the
  76 ;;   `comment-column' character.
  77 ;; - `ruler-mode-goal-column' the face used to highlight the
  78 ;;   `goal-column' character.
  79 ;; - `ruler-mode-current-column' the face used to highlight the
  80 ;;   `current-column' character.
  81 ;; - `ruler-mode-tab-stop' the face used to highlight tab stop
  82 ;;   characters.
  83 ;; - `ruler-mode-margins' the face used to highlight graduations
  84 ;;   in the `window-margins' areas.
  85 ;; - `ruler-mode-fringes' the face used to highlight graduations
  86 ;;   in the `window-fringes' areas.
  87 ;; - `ruler-mode-column-number' the face used to highlight the
  88 ;;   numbered graduations.
  89 ;;
  90 ;; `ruler-mode-default' inherits from the built-in `default' face.
  91 ;; All `ruler-mode' faces inherit from `ruler-mode-default'.
  92 ;;
  93 ;; WARNING: To keep ruler graduations aligned on text columns it is
  94 ;; important to use the same font family and size for ruler and text
  95 ;; areas.
  96 ;;
  97 ;; You can override the ruler format by defining an appropriate
  98 ;; function as the buffer-local value of `ruler-mode-ruler-function'.
  99
 100 ;; Installation
 101 ;;
 102 ;; To automatically display the ruler in specific major modes use:
 103 ;;
 104 ;;    (add-hook '<major-mode>-hook 'ruler-mode)
 105 ;;
 106
 107 ;;; History:
 108 ;;
 109 \f
 110 ;;; Code:
 111 (eval-when-compile
 112   (require 'wid-edit))
 113 (require 'scroll-bar)
 114 (require 'fringe)
 115
 116 (defgroup ruler-mode nil
 117   "Display a ruler in the header line."
 118   :version "22.1"
 119   :group 'convenience)
 120
 121 (defcustom ruler-mode-show-tab-stops nil
 122   "If non-nil the ruler shows tab stop positions.
 123 Also allowing to visually change `tab-stop-list' setting using
 124 <C-down-mouse-1> and <C-down-mouse-3> on the ruler to respectively add
 125 or remove a tab stop.  \\[ruler-mode-toggle-show-tab-stops] or
 126 <C-down-mouse-2> on the ruler toggles showing/editing of tab stops."
 127   :group 'ruler-mode
 128   :type 'boolean)
 129
 130 ;; IMPORTANT: This function must be defined before the following
 131 ;; defcustoms because it is used in their :validate clause.
 132 (defun ruler-mode-character-validate (widget)
 133   "Ensure WIDGET value is a valid character value."
 134   (save-excursion
 135     (let ((value (widget-value widget)))
 136       (unless (characterp value)
 137         (widget-put widget :error
 138                     (format "Invalid character value: %S" value))
 139         widget))))
 140
 141 (defcustom ruler-mode-fill-column-char (if (char-displayable-p ?¶)
 142                                            ?\¶
 143                                          ?\|)
 144   "Character used at the `fill-column' location."
 145   :group 'ruler-mode
 146   :type '(choice
 147           (character :tag "Character")
 148           (integer :tag "Integer char value"
 149                    :validate ruler-mode-character-validate)))
 150
 151 (defcustom ruler-mode-comment-column-char ?\#
 152   "Character used at the `comment-column' location."
 153   :group 'ruler-mode
 154   :type '(choice
 155           (character :tag "Character")
 156           (integer :tag "Integer char value"
 157                    :validate ruler-mode-character-validate)))
 158
 159 (defcustom ruler-mode-goal-column-char ?G
 160   "Character used at the `goal-column' location."
 161   :group 'ruler-mode
 162   :type '(choice
 163           (character :tag "Character")
 164           (integer :tag "Integer char value"
 165                    :validate ruler-mode-character-validate)))
 166
 167 (defcustom ruler-mode-current-column-char (if (char-displayable-p ?¦)
 168                                               ?\¦
 169                                             ?\@)
 170   "Character used at the `current-column' location."
 171   :group 'ruler-mode
 172   :type '(choice
 173           (character :tag "Character")
 174           (integer :tag "Integer char value"
 175                    :validate ruler-mode-character-validate)))
 176
 177 (defcustom ruler-mode-tab-stop-char ?\T
 178   "Character used at `tab-stop-list' locations."
 179   :group 'ruler-mode
 180   :type '(choice
 181           (character :tag "Character")
 182           (integer :tag "Integer char value"
 183                    :validate ruler-mode-character-validate)))
 184
 185 (defcustom ruler-mode-basic-graduation-char ?\.
 186   "Character used for basic graduations."
 187   :group 'ruler-mode
 188   :type '(choice
 189           (character :tag "Character")
 190           (integer :tag "Integer char value"
 191                    :validate ruler-mode-character-validate)))
 192
 193 (defcustom ruler-mode-inter-graduation-char ?\!
 194   "Character used for intermediate graduations."
 195   :group 'ruler-mode
 196   :type '(choice
 197           (character :tag "Character")
 198           (integer :tag "Integer char value"
 199                    :validate ruler-mode-character-validate)))
 200
 201 (defcustom ruler-mode-set-goal-column-ding-flag t
 202   "Non-nil means do `ding' when `goal-column' is set."
 203   :group 'ruler-mode
 204   :type 'boolean)
 205 \f
 206 (defface ruler-mode-default
 207   '((((type tty))
 208      (:inherit default
 209                :background "grey64"
 210                :foreground "grey50"
 211                ))
 212     (t
 213      (:inherit default
 214                :background "grey76"
 215                :foreground "grey64"
 216                :box (:color "grey76"
 217                             :line-width 1
 218                             :style released-button)
 219                )))
 220   "Default face used by the ruler."
 221   :group 'ruler-mode)
 222
 223 (defface ruler-mode-pad
 224   '((((type tty))
 225      (:inherit ruler-mode-default
 226                :background "grey50"
 227                ))
 228     (t
 229      (:inherit ruler-mode-default
 230                :background "grey64"
 231                )))
 232   "Face used to pad inactive ruler areas."
 233   :group 'ruler-mode)
 234
 235 (defface ruler-mode-margins
 236   '((t
 237      (:inherit ruler-mode-default
 238                :foreground "white"
 239                )))
 240   "Face used to highlight margin areas."
 241   :group 'ruler-mode)
 242
 243 (defface ruler-mode-fringes
 244   '((t
 245      (:inherit ruler-mode-default
 246                :foreground "green"
 247                )))
 248   "Face used to highlight fringes areas."
 249   :group 'ruler-mode)
 250
 251 (defface ruler-mode-column-number
 252   '((t
 253      (:inherit ruler-mode-default
 254                :foreground "black"
 255                )))
 256   "Face used to highlight number graduations."
 257   :group 'ruler-mode)
 258
 259 (defface ruler-mode-fill-column
 260   '((t
 261      (:inherit ruler-mode-default
 262                :foreground "red"
 263                )))
 264   "Face used to highlight the fill column character."
 265   :group 'ruler-mode)
 266
 267 (defface ruler-mode-comment-column
 268   '((t
 269      (:inherit ruler-mode-default
 270                :foreground "red"
 271                )))
 272   "Face used to highlight the comment column character."
 273   :group 'ruler-mode)
 274
 275 (defface ruler-mode-goal-column
 276   '((t
 277      (:inherit ruler-mode-default
 278                :foreground "red"
 279                )))
 280   "Face used to highlight the goal column character."
 281   :group 'ruler-mode)
 282
 283 (defface ruler-mode-tab-stop
 284   '((t
 285      (:inherit ruler-mode-default
 286                :foreground "steelblue"
 287                )))
 288   "Face used to highlight tab stop characters."
 289   :group 'ruler-mode)
 290
 291 (defface ruler-mode-current-column
 292   '((t
 293      (:inherit ruler-mode-default
 294                :weight bold
 295                :foreground "yellow"
 296                )))
 297   "Face used to highlight the `current-column' character."
 298   :group 'ruler-mode)
 299 \f
 300
 301 (defsubst ruler-mode-full-window-width ()
 302   "Return the full width of the selected window."
 303   (let ((edges (window-edges)))
 304     (- (nth 2 edges) (nth 0 edges))))
 305
 306 (defsubst ruler-mode-window-col (n)
 307   "Return a column number relative to the selected window.
 308 N is a column number relative to selected frame."
 309   (- n
 310      (car (window-edges))
 311      (or (car (window-margins)) 0)
 312      (fringe-columns 'left)
 313      (scroll-bar-columns 'left)))
 314 \f
 315 (defun ruler-mode-mouse-set-left-margin (start-event)
 316   "Set left margin end to the graduation where the mouse pointer is on.
 317 START-EVENT is the mouse click event."
 318   (interactive "e")
 319   (let* ((start (event-start start-event))
 320          (end   (event-end   start-event))
 321          col w lm rm)
 322     (when (eq start end) ;; mouse click
 323       (save-selected-window
 324         (select-window (posn-window start))
 325         (setq col (- (car (posn-col-row start)) (car (window-edges))
 326                      (scroll-bar-columns 'left))
 327               w   (- (ruler-mode-full-window-width)
 328                      (scroll-bar-columns 'left)
 329                      (scroll-bar-columns 'right)))
 330         (when (and (>= col 0) (< col w))
 331           (setq lm (window-margins)
 332                 rm (or (cdr lm) 0)
 333                 lm (or (car lm) 0))
 334           (message "Left margin set to %d (was %d)" col lm)
 335           (set-window-margins nil col rm))))))
 336
 337 (defun ruler-mode-mouse-set-right-margin (start-event)
 338   "Set right margin beginning to the graduation where the mouse pointer is on.
 339 START-EVENT is the mouse click event."
 340   (interactive "e")
 341   (let* ((start (event-start start-event))
 342          (end   (event-end   start-event))
 343          col w lm rm)
 344     (when (eq start end) ;; mouse click
 345       (save-selected-window
 346         (select-window (posn-window start))
 347         (setq col (- (car (posn-col-row start)) (car (window-edges))
 348                      (scroll-bar-columns 'left))
 349               w   (- (ruler-mode-full-window-width)
 350                      (scroll-bar-columns 'left)
 351                      (scroll-bar-columns 'right)))
 352         (when (and (>= col 0) (< col w))
 353           (setq lm  (window-margins)
 354                 rm  (or (cdr lm) 0)
 355                 lm  (or (car lm) 0)
 356                 col (- w col 1))
 357           (message "Right margin set to %d (was %d)" col rm)
 358           (set-window-margins nil lm col))))))
 359
 360 (defvar ruler-mode-dragged-symbol nil
 361   "Column symbol dragged in the ruler.
 362 That is `fill-column', `comment-column', `goal-column', or nil when
 363 nothing is dragged.")
 364
 365 (defun ruler-mode-mouse-grab-any-column (start-event)
 366   "Drag a column symbol on the ruler.
 367 Start dragging on mouse down event START-EVENT, and update the column
 368 symbol value with the current value of the ruler graduation while
 369 dragging.  See also the variable `ruler-mode-dragged-symbol'."
 370   (interactive "e")
 371   (setq ruler-mode-dragged-symbol nil)
 372   (let* ((start (event-start start-event))
 373          col newc oldc)
 374     (save-selected-window
 375       (select-window (posn-window start))
 376       (setq col  (ruler-mode-window-col (car (posn-col-row start)))
 377             newc (+ col (window-hscroll)))
 378       (and
 379        (>= col 0) (< col (window-width))
 380        (cond
 381
 382         ;; Handle the fill column.
 383         ((eq newc fill-column)
 384          (setq oldc fill-column
 385                ruler-mode-dragged-symbol 'fill-column)
 386          t) ;; Start dragging
 387
 388         ;; Handle the comment column.
 389         ((eq newc comment-column)
 390          (setq oldc comment-column
 391                ruler-mode-dragged-symbol 'comment-column)
 392          t) ;; Start dragging
 393
 394         ;; Handle the goal column.
 395         ;; A. On mouse down on the goal column character on the ruler,
 396         ;;    update the `goal-column' value while dragging.
 397         ;; B. If `goal-column' is nil, set the goal column where the
 398         ;;    mouse is clicked.
 399         ;; C. On mouse click on the goal column character on the
 400         ;;    ruler, unset the goal column.
 401         ((eq newc goal-column)          ; A. Drag the goal column.
 402          (setq oldc goal-column
 403                ruler-mode-dragged-symbol 'goal-column)
 404          t) ;; Start dragging
 405
 406         ((null goal-column)             ; B. Set the goal column.
 407          (setq oldc goal-column
 408                goal-column newc)
 409          ;; mouse-2 coming AFTER drag-mouse-2 invokes `ding'.  This
 410          ;; `ding' flushes the next messages about setting goal
 411          ;; column.  So here I force fetch the event(mouse-2) and
 412          ;; throw away.
 413          (read-event)
 414          ;; Ding BEFORE `message' is OK.
 415          (when ruler-mode-set-goal-column-ding-flag
 416            (ding))
 417          (message "Goal column set to %d (click on %s again to unset it)"
 418                   newc
 419                   (propertize (char-to-string ruler-mode-goal-column-char)
 420                               'face 'ruler-mode-goal-column))
 421          nil) ;; Don't start dragging.
 422         )
 423        (if (eq 'click (ruler-mode-mouse-drag-any-column-iteration
 424                        (posn-window start)))
 425            (when (eq 'goal-column ruler-mode-dragged-symbol)
 426              ;; C. Unset the goal column.
 427              (set-goal-column t))
 428          ;; At end of dragging, report the updated column symbol.
 429          (message "%s is set to %d (was %d)"
 430                   ruler-mode-dragged-symbol
 431                   (symbol-value ruler-mode-dragged-symbol)
 432                   oldc))))))
 433
 434 (defun ruler-mode-mouse-drag-any-column-iteration (window)
 435   "Update the ruler while dragging the mouse.
 436 WINDOW is the window where occurred the last down-mouse event.
 437 Return the symbol `drag' if the mouse has been dragged, or `click' if
 438 the mouse has been clicked."
 439   (let ((drags 0)
 440         event)
 441     (track-mouse
 442       (while (mouse-movement-p (setq event (read-event)))
 443         (setq drags (1+ drags))
 444         (when (eq window (posn-window (event-end event)))
 445           (ruler-mode-mouse-drag-any-column event)
 446           (force-mode-line-update))))
 447     (if (and (zerop drags) (eq 'click (car (event-modifiers event))))
 448         'click
 449       'drag)))
 450
 451 (defun ruler-mode-mouse-drag-any-column (start-event)
 452   "Update the value of the symbol dragged on the ruler.
 453 Called on each mouse motion event START-EVENT."
 454   (let* ((start (event-start start-event))
 455          (end   (event-end   start-event))
 456          col newc)
 457     (save-selected-window
 458       (select-window (posn-window start))
 459       (setq col  (ruler-mode-window-col (car (posn-col-row end)))
 460             newc (+ col (window-hscroll)))
 461       (when (and (>= col 0) (< col (window-width)))
 462         (set ruler-mode-dragged-symbol newc)))))
 463 \f
 464 (defun ruler-mode-mouse-add-tab-stop (start-event)
 465   "Add a tab stop to the graduation where the mouse pointer is on.
 466 START-EVENT is the mouse click event."
 467   (interactive "e")
 468   (when ruler-mode-show-tab-stops
 469     (let* ((start (event-start start-event))
 470            (end   (event-end   start-event))
 471            col ts)
 472       (when (eq start end) ;; mouse click
 473         (save-selected-window
 474           (select-window (posn-window start))
 475           (setq col (ruler-mode-window-col (car (posn-col-row start)))
 476                 ts  (+ col (window-hscroll)))
 477           (and (>= col 0) (< col (window-width))
 478                (not (member ts tab-stop-list))
 479                (progn
 480                  (message "Tab stop set to %d" ts)
 481                  (setq tab-stop-list (sort (cons ts tab-stop-list)
 482                                            #'<)))))))))
 483
 484 (defun ruler-mode-mouse-del-tab-stop (start-event)
 485   "Delete tab stop at the graduation where the mouse pointer is on.
 486 START-EVENT is the mouse click event."
 487   (interactive "e")
 488   (when ruler-mode-show-tab-stops
 489     (let* ((start (event-start start-event))
 490            (end   (event-end   start-event))
 491            col ts)
 492       (when (eq start end) ;; mouse click
 493         (save-selected-window
 494           (select-window (posn-window start))
 495           (setq col (ruler-mode-window-col (car (posn-col-row start)))
 496                 ts  (+ col (window-hscroll)))
 497           (and (>= col 0) (< col (window-width))
 498                (member ts tab-stop-list)
 499                (progn
 500                  (message "Tab stop at %d deleted" ts)
 501                  (setq tab-stop-list (delete ts tab-stop-list)))))))))
 502
 503 (defun ruler-mode-toggle-show-tab-stops ()
 504   "Toggle showing of tab stops on the ruler."
 505   (interactive)
 506   (setq ruler-mode-show-tab-stops (not ruler-mode-show-tab-stops))
 507   (force-mode-line-update))
 508 \f
 509 (defvar ruler-mode-map
 510   (let ((km (make-sparse-keymap)))
 511     (define-key km [header-line down-mouse-1]
 512       #'ignore)
 513     (define-key km [header-line down-mouse-3]
 514       #'ignore)
 515     (define-key km [header-line down-mouse-2]
 516       #'ruler-mode-mouse-grab-any-column)
 517     (define-key km [header-line (shift down-mouse-1)]
 518       #'ruler-mode-mouse-set-left-margin)
 519     (define-key km [header-line (shift down-mouse-3)]
 520       #'ruler-mode-mouse-set-right-margin)
 521     (define-key km [header-line (control down-mouse-1)]
 522       #'ruler-mode-mouse-add-tab-stop)
 523     (define-key km [header-line (control down-mouse-3)]
 524       #'ruler-mode-mouse-del-tab-stop)
 525     (define-key km [header-line (control down-mouse-2)]
 526       #'ruler-mode-toggle-show-tab-stops)
 527     (define-key km [header-line (shift mouse-1)]
 528       'ignore)
 529     (define-key km [header-line (shift mouse-3)]
 530       'ignore)
 531     (define-key km [header-line (control mouse-1)]
 532       'ignore)
 533     (define-key km [header-line (control mouse-3)]
 534       'ignore)
 535     (define-key km [header-line (control mouse-2)]
 536       'ignore)
 537     km)
 538   "Keymap for ruler minor mode.")
 539
 540 (defvar ruler-mode-header-line-format-old nil
 541   "Hold previous value of `header-line-format'.")
 542
 543 (defvar ruler-mode-ruler-function 'ruler-mode-ruler
 544   "Function to call to return ruler header line format.
 545 This variable is expected to be made buffer-local by modes.")
 546
 547 (defconst ruler-mode-header-line-format
 548   '(:eval (funcall ruler-mode-ruler-function))
 549   "`header-line-format' used in ruler mode.
 550 Call `ruler-mode-ruler-function' to compute the ruler value.")
 551
 552 ;;;###autoload
 553 (define-minor-mode ruler-mode
 554   "Display a ruler in the header line if ARG > 0."
 555   nil nil
 556   ruler-mode-map
 557   :group 'ruler-mode
 558   (if ruler-mode
 559       (progn
 560         ;; When `ruler-mode' is on save previous header line format
 561         ;; and install the ruler header line format.
 562         (when (and (local-variable-p 'header-line-format)
 563                    (not (local-variable-p 'ruler-mode-header-line-format-old)))
 564           (set (make-local-variable 'ruler-mode-header-line-format-old)
 565                header-line-format))
 566         (setq header-line-format ruler-mode-header-line-format)
 567         (add-hook 'post-command-hook 'force-mode-line-update nil t))
 568     ;; When `ruler-mode' is off restore previous header line format if
 569     ;; the current one is the ruler header line format.
 570     (when (eq header-line-format ruler-mode-header-line-format)
 571       (kill-local-variable 'header-line-format)
 572       (when (local-variable-p 'ruler-mode-header-line-format-old)
 573         (setq header-line-format ruler-mode-header-line-format-old)
 574         (kill-local-variable 'ruler-mode-header-line-format-old)))
 575     (remove-hook 'post-command-hook 'force-mode-line-update t)))
 576 \f
 577 ;; Add ruler-mode to the minor mode menu in the mode line
 578 (define-key mode-line-mode-menu [ruler-mode]
 579   `(menu-item "Ruler" ruler-mode
 580               :button (:toggle . ruler-mode)))
 581
 582 (defconst ruler-mode-ruler-help-echo
 583   "\
 584 S-mouse-1/3: set L/R margin, \
 585 mouse-2: set goal column, \
 586 C-mouse-2: show tabs"
 587   "Help string shown when mouse is over the ruler.
 588 `ruler-mode-show-tab-stops' is nil.")
 589
 590 (defconst ruler-mode-ruler-help-echo-when-goal-column
 591   "\
 592 S-mouse-1/3: set L/R margin, \
 593 C-mouse-2: show tabs"
 594   "Help string shown when mouse is over the ruler.
 595 `goal-column' is set and `ruler-mode-show-tab-stops' is nil.")
 596
 597 (defconst ruler-mode-ruler-help-echo-when-tab-stops
 598   "\
 599 C-mouse1/3: set/unset tab, \
 600 C-mouse-2: hide tabs"
 601   "Help string shown when mouse is over the ruler.
 602 `ruler-mode-show-tab-stops' is non-nil.")
 603
 604 (defconst ruler-mode-fill-column-help-echo
 605   "drag-mouse-2: set fill column"
 606   "Help string shown when mouse is on the fill column character.")
 607
 608 (defconst ruler-mode-comment-column-help-echo
 609   "drag-mouse-2: set comment column"
 610   "Help string shown when mouse is on the comment column character.")
 611
 612 (defconst ruler-mode-goal-column-help-echo
 613   "\
 614 drag-mouse-2: set goal column, \
 615 mouse-2: unset goal column"
 616   "Help string shown when mouse is on the goal column character.")
 617
 618 (defconst ruler-mode-margin-help-echo
 619   "%s margin %S"
 620   "Help string shown when mouse is over a margin area.")
 621
 622 (defconst ruler-mode-fringe-help-echo
 623   "%s fringe %S"
 624   "Help string shown when mouse is over a fringe area.")
 625
 626 (defsubst ruler-mode-space (width &rest props)
 627   "Return a single space string of WIDTH times the normal character width.
 628 Optional argument PROPS specifies other text properties to apply."
 629   (apply 'propertize " " 'display (list 'space :width width) props))
 630 \f
 631 (defun ruler-mode-ruler ()
 632   "Compute and return a header line ruler."
 633   (let* ((w (window-width))
 634          (m (window-margins))
 635          (f (window-fringes))
 636          (i 0)
 637          (j (window-hscroll))
 638          ;; Setup the scrollbar, fringes, and margins areas.
 639          (lf (ruler-mode-space
 640               'left-fringe
 641               'face 'ruler-mode-fringes
 642               'help-echo (format ruler-mode-fringe-help-echo
 643                                  "Left" (or (car f) 0))))
 644          (rf (ruler-mode-space
 645               'right-fringe
 646               'face 'ruler-mode-fringes
 647               'help-echo (format ruler-mode-fringe-help-echo
 648                                  "Right" (or (cadr f) 0))))
 649          (lm (ruler-mode-space
 650               'left-margin
 651               'face 'ruler-mode-margins
 652               'help-echo (format ruler-mode-margin-help-echo
 653                                  "Left" (or (car m) 0))))
 654          (rm (ruler-mode-space
 655               'right-margin
 656               'face 'ruler-mode-margins
 657               'help-echo (format ruler-mode-margin-help-echo
 658                                  "Right" (or (cdr m) 0))))
 659          (sb (ruler-mode-space
 660               'scroll-bar
 661               'face 'ruler-mode-pad))
 662          ;; Remember the scrollbar vertical type.
 663          (sbvt (car (window-current-scroll-bars)))
 664          ;; Create an "clean" ruler.
 665          (ruler
 666           (propertize
 667            (string-to-multibyte
 668             (make-string w ruler-mode-basic-graduation-char))
 669            'face 'ruler-mode-default
 670            'local-map ruler-mode-map
 671            'help-echo (cond
 672                        (ruler-mode-show-tab-stops
 673                         ruler-mode-ruler-help-echo-when-tab-stops)
 674                        (goal-column
 675                         ruler-mode-ruler-help-echo-when-goal-column)
 676                        (ruler-mode-ruler-help-echo))))
 677          k c)
 678     ;; Setup the active area.
 679     (while (< i w)
 680       ;; Graduations.
 681       (cond
 682        ;; Show a number graduation.
 683        ((= (mod j 10) 0)
 684         (setq c (number-to-string (/ j 10))
 685               m (length c)
 686               k i)
 687         (put-text-property
 688          i (1+ i) 'face 'ruler-mode-column-number
 689          ruler)
 690         (while (and (> m 0) (>= k 0))
 691           (aset ruler k (aref c (setq m (1- m))))
 692           (setq k (1- k))))
 693        ;; Show an intermediate graduation.
 694        ((= (mod j 5) 0)
 695         (aset ruler i ruler-mode-inter-graduation-char)))
 696       ;; Special columns.
 697       (cond
 698        ;; Show the `current-column' marker.
 699        ((= j (current-column))
 700         (aset ruler i ruler-mode-current-column-char)
 701         (put-text-property
 702          i (1+ i) 'face 'ruler-mode-current-column
 703          ruler))
 704        ;; Show the `goal-column' marker.
 705        ((and goal-column (= j goal-column))
 706         (aset ruler i ruler-mode-goal-column-char)
 707         (put-text-property
 708          i (1+ i) 'face 'ruler-mode-goal-column
 709          ruler)
 710         (put-text-property
 711          i (1+ i) 'mouse-face 'mode-line-highlight
 712          ruler)
 713         (put-text-property
 714          i (1+ i) 'help-echo ruler-mode-goal-column-help-echo
 715          ruler))
 716        ;; Show the `comment-column' marker.
 717        ((= j comment-column)
 718         (aset ruler i ruler-mode-comment-column-char)
 719         (put-text-property
 720          i (1+ i) 'face 'ruler-mode-comment-column
 721          ruler)
 722         (put-text-property
 723          i (1+ i) 'mouse-face 'mode-line-highlight
 724          ruler)
 725         (put-text-property
 726          i (1+ i) 'help-echo ruler-mode-comment-column-help-echo
 727          ruler))
 728        ;; Show the `fill-column' marker.
 729        ((= j fill-column)
 730         (aset ruler i ruler-mode-fill-column-char)
 731         (put-text-property
 732          i (1+ i) 'face 'ruler-mode-fill-column
 733          ruler)
 734         (put-text-property
 735          i (1+ i) 'mouse-face 'mode-line-highlight
 736          ruler)
 737         (put-text-property
 738          i (1+ i) 'help-echo ruler-mode-fill-column-help-echo
 739          ruler))
 740        ;; Show the `tab-stop-list' markers.
 741        ((and ruler-mode-show-tab-stops (member j tab-stop-list))
 742         (aset ruler i ruler-mode-tab-stop-char)
 743         (put-text-property
 744          i (1+ i) 'face 'ruler-mode-tab-stop
 745          ruler)))
 746       (setq i (1+ i)
 747             j (1+ j)))
 748     ;; Return the ruler propertized string.  Using list here,
 749     ;; instead of concat visually separate the different areas.
 750     (if (nth 2 (window-fringes))
 751         ;; fringes outside margins.
 752         (list "" (and (eq 'left sbvt) sb) lf lm
 753               ruler rm rf (and (eq 'right sbvt) sb))
 754       ;; fringes inside margins.
 755       (list "" (and (eq 'left sbvt) sb) lm lf
 756             ruler rf rm (and (eq 'right sbvt) sb)))))
 757
 758 (provide 'ruler-mode)
 759
 760 ;; Local Variables:
 761 ;; coding: iso-latin-1
 762 ;; End:
 763
 764 ;; arch-tag: b2f24546-5605-44c4-b67b-c9a4eeba3ee8
 765 ;;; ruler-mode.el ends here