code.delx.au - gnu-emacs/blob - 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 (defvar ruler-mode nil
 554   "Non-nil if Ruler mode is enabled.
 555 Use the command `ruler-mode' to change this variable.")
 556 (make-variable-buffer-local 'ruler-mode)
 557
 558 (defun ruler--save-header-line-format ()
 559   "Install the header line format for Ruler mode.
 560 Unless Ruler mode is already enabled, save the old header line
 561 format first."
 562   (when (and (not ruler-mode)
 563              (local-variable-p 'header-line-format)
 564              (not (local-variable-p 'ruler-mode-header-line-format-old)))
 565     (set (make-local-variable 'ruler-mode-header-line-format-old)
 566          header-line-format))
 567   (setq header-line-format ruler-mode-header-line-format))
 568
 569 ;;;###autoload
 570 (define-minor-mode ruler-mode
 571   "Toggle Ruler mode.
 572 In Ruler mode, Emacs displays a ruler in the header line."
 573   nil nil
 574   ruler-mode-map
 575   :group 'ruler-mode
 576   :variable (ruler-mode
 577              . (lambda (enable)
 578                  (when enable
 579                    (ruler--save-header-line-format))
 580                  (setq ruler-mode enable)))
 581   (if ruler-mode
 582       (add-hook 'post-command-hook 'force-mode-line-update nil t)
 583     ;; When `ruler-mode' is off restore previous header line format if
 584     ;; the current one is the ruler header line format.
 585     (when (eq header-line-format ruler-mode-header-line-format)
 586       (kill-local-variable 'header-line-format)
 587       (when (local-variable-p 'ruler-mode-header-line-format-old)
 588         (setq header-line-format ruler-mode-header-line-format-old)
 589         (kill-local-variable 'ruler-mode-header-line-format-old)))
 590     (remove-hook 'post-command-hook 'force-mode-line-update t)))
 591 \f
 592 ;; Add ruler-mode to the minor mode menu in the mode line
 593 (define-key mode-line-mode-menu [ruler-mode]
 594   `(menu-item "Ruler" ruler-mode
 595               :button (:toggle . ruler-mode)))
 596
 597 (defconst ruler-mode-ruler-help-echo
 598   "\
 599 S-mouse-1/3: set L/R margin, \
 600 mouse-2: set goal column, \
 601 C-mouse-2: show tabs"
 602   "Help string shown when mouse is over the ruler.
 603 `ruler-mode-show-tab-stops' is nil.")
 604
 605 (defconst ruler-mode-ruler-help-echo-when-goal-column
 606   "\
 607 S-mouse-1/3: set L/R margin, \
 608 C-mouse-2: show tabs"
 609   "Help string shown when mouse is over the ruler.
 610 `goal-column' is set and `ruler-mode-show-tab-stops' is nil.")
 611
 612 (defconst ruler-mode-ruler-help-echo-when-tab-stops
 613   "\
 614 C-mouse1/3: set/unset tab, \
 615 C-mouse-2: hide tabs"
 616   "Help string shown when mouse is over the ruler.
 617 `ruler-mode-show-tab-stops' is non-nil.")
 618
 619 (defconst ruler-mode-fill-column-help-echo
 620   "drag-mouse-2: set fill column"
 621   "Help string shown when mouse is on the fill column character.")
 622
 623 (defconst ruler-mode-comment-column-help-echo
 624   "drag-mouse-2: set comment column"
 625   "Help string shown when mouse is on the comment column character.")
 626
 627 (defconst ruler-mode-goal-column-help-echo
 628   "\
 629 drag-mouse-2: set goal column, \
 630 mouse-2: unset goal column"
 631   "Help string shown when mouse is on the goal column character.")
 632
 633 (defconst ruler-mode-margin-help-echo
 634   "%s margin %S"
 635   "Help string shown when mouse is over a margin area.")
 636
 637 (defconst ruler-mode-fringe-help-echo
 638   "%s fringe %S"
 639   "Help string shown when mouse is over a fringe area.")
 640
 641 (defsubst ruler-mode-space (width &rest props)
 642   "Return a single space string of WIDTH times the normal character width.
 643 Optional argument PROPS specifies other text properties to apply."
 644   (apply 'propertize " " 'display (list 'space :width width) props))
 645 \f
 646 (defun ruler-mode-ruler ()
 647   "Compute and return a header line ruler."
 648   (let* ((w (window-width))
 649          (m (window-margins))
 650          (f (window-fringes))
 651          (i 0)
 652          (j (window-hscroll))
 653          ;; Setup the scrollbar, fringes, and margins areas.
 654          (lf (ruler-mode-space
 655               'left-fringe
 656               'face 'ruler-mode-fringes
 657               'help-echo (format ruler-mode-fringe-help-echo
 658                                  "Left" (or (car f) 0))))
 659          (rf (ruler-mode-space
 660               'right-fringe
 661               'face 'ruler-mode-fringes
 662               'help-echo (format ruler-mode-fringe-help-echo
 663                                  "Right" (or (cadr f) 0))))
 664          (lm (ruler-mode-space
 665               'left-margin
 666               'face 'ruler-mode-margins
 667               'help-echo (format ruler-mode-margin-help-echo
 668                                  "Left" (or (car m) 0))))
 669          (rm (ruler-mode-space
 670               'right-margin
 671               'face 'ruler-mode-margins
 672               'help-echo (format ruler-mode-margin-help-echo
 673                                  "Right" (or (cdr m) 0))))
 674          (sb (ruler-mode-space
 675               'scroll-bar
 676               'face 'ruler-mode-pad))
 677          ;; Remember the scrollbar vertical type.
 678          (sbvt (car (window-current-scroll-bars)))
 679          ;; Create an "clean" ruler.
 680          (ruler
 681           (propertize
 682            (string-to-multibyte
 683             (make-string w ruler-mode-basic-graduation-char))
 684            'face 'ruler-mode-default
 685            'local-map ruler-mode-map
 686            'help-echo (cond
 687                        (ruler-mode-show-tab-stops
 688                         ruler-mode-ruler-help-echo-when-tab-stops)
 689                        (goal-column
 690                         ruler-mode-ruler-help-echo-when-goal-column)
 691                        (ruler-mode-ruler-help-echo))))
 692          k c)
 693     ;; Setup the active area.
 694     (while (< i w)
 695       ;; Graduations.
 696       (cond
 697        ;; Show a number graduation.
 698        ((= (mod j 10) 0)
 699         (setq c (number-to-string (/ j 10))
 700               m (length c)
 701               k i)
 702         (put-text-property
 703          i (1+ i) 'face 'ruler-mode-column-number
 704          ruler)
 705         (while (and (> m 0) (>= k 0))
 706           (aset ruler k (aref c (setq m (1- m))))
 707           (setq k (1- k))))
 708        ;; Show an intermediate graduation.
 709        ((= (mod j 5) 0)
 710         (aset ruler i ruler-mode-inter-graduation-char)))
 711       ;; Special columns.
 712       (cond
 713        ;; Show the `current-column' marker.
 714        ((= j (current-column))
 715         (aset ruler i ruler-mode-current-column-char)
 716         (put-text-property
 717          i (1+ i) 'face 'ruler-mode-current-column
 718          ruler))
 719        ;; Show the `goal-column' marker.
 720        ((and goal-column (= j goal-column))
 721         (aset ruler i ruler-mode-goal-column-char)
 722         (put-text-property
 723          i (1+ i) 'face 'ruler-mode-goal-column
 724          ruler)
 725         (put-text-property
 726          i (1+ i) 'mouse-face 'mode-line-highlight
 727          ruler)
 728         (put-text-property
 729          i (1+ i) 'help-echo ruler-mode-goal-column-help-echo
 730          ruler))
 731        ;; Show the `comment-column' marker.
 732        ((= j comment-column)
 733         (aset ruler i ruler-mode-comment-column-char)
 734         (put-text-property
 735          i (1+ i) 'face 'ruler-mode-comment-column
 736          ruler)
 737         (put-text-property
 738          i (1+ i) 'mouse-face 'mode-line-highlight
 739          ruler)
 740         (put-text-property
 741          i (1+ i) 'help-echo ruler-mode-comment-column-help-echo
 742          ruler))
 743        ;; Show the `fill-column' marker.
 744        ((= j fill-column)
 745         (aset ruler i ruler-mode-fill-column-char)
 746         (put-text-property
 747          i (1+ i) 'face 'ruler-mode-fill-column
 748          ruler)
 749         (put-text-property
 750          i (1+ i) 'mouse-face 'mode-line-highlight
 751          ruler)
 752         (put-text-property
 753          i (1+ i) 'help-echo ruler-mode-fill-column-help-echo
 754          ruler))
 755        ;; Show the `tab-stop-list' markers.
 756        ((and ruler-mode-show-tab-stops (member j tab-stop-list))
 757         (aset ruler i ruler-mode-tab-stop-char)
 758         (put-text-property
 759          i (1+ i) 'face 'ruler-mode-tab-stop
 760          ruler)))
 761       (setq i (1+ i)
 762             j (1+ j)))
 763     ;; Return the ruler propertized string.  Using list here,
 764     ;; instead of concat visually separate the different areas.
 765     (if (nth 2 (window-fringes))
 766         ;; fringes outside margins.
 767         (list "" (and (eq 'left sbvt) sb) lf lm
 768               ruler rm rf (and (eq 'right sbvt) sb))
 769       ;; fringes inside margins.
 770       (list "" (and (eq 'left sbvt) sb) lm lf
 771             ruler rf rm (and (eq 'right sbvt) sb)))))
 772
 773 (provide 'ruler-mode)
 774
 775 ;; Local Variables:
 776 ;; coding: iso-latin-1
 777 ;; End:
 778
 779 ;; arch-tag: b2f24546-5605-44c4-b67b-c9a4eeba3ee8
 780 ;;; ruler-mode.el ends here