lisp/ruler-mode.el

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