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