lisp/ruler-mode.el

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