aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorKim F. Storm2004-03-19 13:17:16 +0000
committerKim F. Storm2004-03-19 13:17:16 +0000
commit31da0380c3a405a17301eda125f0a573695d15ed (patch)
tree3cf223f9f1ee2a264ad3608bd3b6d63a90c27657 /lisp
parent24d0e54531d54615d983e45da080c2222fde0f7d (diff)
downloademacs-31da0380c3a405a17301eda125f0a573695d15ed.tar.gz
emacs-31da0380c3a405a17301eda125f0a573695d15ed.zip
From David Ponce <david@dponce.com>
(ruler-mode-header-line-format-old): Don't `make-variable-buffer-local'. (ruler-mode-ruler-function): Default to `ruler-mode-ruler'. (ruler-mode-header-line-format): Simply funcall the above. (ruler-mode): Use `make-local-variable' and `kill-local-variable' to save/restore a previous header line format. (ruler-mode-space): Don't depend on a numeric WIDTH value. (ruler-mode-ruler): Use symbolic display elements for scrollbar, fringes and margins width. (ruler-mode-ruler-function): Default to ruler-mode-ruler
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog13
-rw-r--r--lisp/ruler-mode.el269
2 files changed, 141 insertions, 141 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 499c10bf22c..f9ad6ef801d 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,16 @@
12004-03-19 David Ponce <david@dponce.com>
2
3 * ruler-mode.el (ruler-mode-header-line-format-old): Don't
4 `make-variable-buffer-local'.
5 (ruler-mode-ruler-function): Default to `ruler-mode-ruler'.
6 (ruler-mode-header-line-format): Simply funcall the above.
7 (ruler-mode): Use `make-local-variable' and `kill-local-variable'
8 to save/restore a previous header line format.
9 (ruler-mode-space): Don't depend on a numeric WIDTH value.
10 (ruler-mode-ruler): Use symbolic display elements for scrollbar,
11 fringes and margins width.
12 (ruler-mode-ruler-function): Default to ruler-mode-ruler
13
12004-03-19 Kim F. Storm <storm@cua.dk> 142004-03-19 Kim F. Storm <storm@cua.dk>
2 15
3 * hexl.el (hexl-mode-ruler): Adapt to new :align-to semantics. 16 * hexl.el (hexl-mode-ruler): Adapt to new :align-to semantics.
diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el
index 7cadcc7368b..e6861cc486c 100644
--- a/lisp/ruler-mode.el
+++ b/lisp/ruler-mode.el
@@ -1,6 +1,6 @@
1;;; ruler-mode.el --- display a ruler in the header line 1;;; ruler-mode.el --- display a ruler in the header line
2 2
3;; Copyright (C) 2001, 2002, 2003 Free Software Foundation, Inc. 3;; Copyright (C) 2001, 2002, 2003, 2004 Free Software Foundation, Inc.
4 4
5;; Author: David Ponce <david@dponce.com> 5;; Author: David Ponce <david@dponce.com>
6;; Maintainer: David Ponce <david@dponce.com> 6;; Maintainer: David Ponce <david@dponce.com>
@@ -95,7 +95,7 @@
95;; important to use the same font family and size for ruler and text 95;; important to use the same font family and size for ruler and text
96;; areas. 96;; areas.
97;; 97;;
98;; You can override the ruler format by defining an appropriate 98;; You can override the ruler format by defining an appropriate
99;; function as the buffer-local value of `ruler-mode-ruler-function'. 99;; function as the buffer-local value of `ruler-mode-ruler-function'.
100 100
101;; Installation 101;; Installation
@@ -531,19 +531,15 @@ START-EVENT is the mouse click event."
531 531
532(defvar ruler-mode-header-line-format-old nil 532(defvar ruler-mode-header-line-format-old nil
533 "Hold previous value of `header-line-format'.") 533 "Hold previous value of `header-line-format'.")
534(make-variable-buffer-local 'ruler-mode-header-line-format-old)
535 534
536(defvar ruler-mode-ruler-function nil 535(defvar ruler-mode-ruler-function 'ruler-mode-ruler
537 "If non-nil, function to call to return ruler string. 536 "Function to call to return ruler header line format.
538This variable is expected to be made buffer-local by modes.") 537This variable is expected to be made buffer-local by modes.")
539 538
540(defconst ruler-mode-header-line-format 539(defconst ruler-mode-header-line-format
541 '(:eval (funcall (if ruler-mode-ruler-function 540 '(:eval (funcall ruler-mode-ruler-function))
542 ruler-mode-ruler-function
543 'ruler-mode-ruler)))
544 "`header-line-format' used in ruler mode. 541 "`header-line-format' used in ruler mode.
545If the non-nil value for ruler-mode-ruler-function is given, use it. 542Call `ruler-mode-ruler-function' to compute the ruler value.")
546Else use `ruler-mode-ruler' is used as default value.")
547 543
548;;;###autoload 544;;;###autoload
549(define-minor-mode ruler-mode 545(define-minor-mode ruler-mode
@@ -556,18 +552,18 @@ Else use `ruler-mode-ruler' is used as default value.")
556 ;; When `ruler-mode' is on save previous header line format 552 ;; When `ruler-mode' is on save previous header line format
557 ;; and install the ruler header line format. 553 ;; and install the ruler header line format.
558 (when (local-variable-p 'header-line-format) 554 (when (local-variable-p 'header-line-format)
559 (setq ruler-mode-header-line-format-old header-line-format)) 555 (set (make-local-variable 'ruler-mode-header-line-format-old)
556 header-line-format))
560 (setq header-line-format ruler-mode-header-line-format) 557 (setq header-line-format ruler-mode-header-line-format)
561 (add-hook 'post-command-hook ; add local hook 558 (add-hook 'post-command-hook 'force-mode-line-update nil t))
562 #'force-mode-line-update nil t))
563 ;; When `ruler-mode' is off restore previous header line format if 559 ;; When `ruler-mode' is off restore previous header line format if
564 ;; the current one is the ruler header line format. 560 ;; the current one is the ruler header line format.
565 (when (eq header-line-format ruler-mode-header-line-format) 561 (when (eq header-line-format ruler-mode-header-line-format)
566 (kill-local-variable 'header-line-format) 562 (kill-local-variable 'header-line-format)
567 (when (local-variable-p 'ruler-mode-header-line-format-old) 563 (when (local-variable-p 'ruler-mode-header-line-format-old)
568 (setq header-line-format ruler-mode-header-line-format-old))) 564 (setq header-line-format ruler-mode-header-line-format-old)
569 (remove-hook 'post-command-hook ; remove local hook 565 (kill-local-variable 'ruler-mode-header-line-format-old)))
570 #'force-mode-line-update t))) 566 (remove-hook 'post-command-hook 'force-mode-line-update t)))
571 567
572;; Add ruler-mode to the minor mode menu in the mode line 568;; Add ruler-mode to the minor mode menu in the mode line
573(define-key mode-line-mode-menu [ruler-mode] 569(define-key mode-line-mode-menu [ruler-mode]
@@ -621,133 +617,124 @@ mouse-2: unset goal column"
621(defsubst ruler-mode-space (width &rest props) 617(defsubst ruler-mode-space (width &rest props)
622 "Return a single space string of WIDTH times the normal character width. 618 "Return a single space string of WIDTH times the normal character width.
623Optional argument PROPS specifies other text properties to apply." 619Optional argument PROPS specifies other text properties to apply."
624 (if (> width 0) 620 (apply 'propertize " " 'display (list 'space :width width) props))
625 (apply 'propertize " " 'display (list 'space :width width) props)
626 ""))
627 621
628(defun ruler-mode-ruler () 622(defun ruler-mode-ruler ()
629 "Return a string ruler." 623 "Compute and return an header line ruler."
630 (when ruler-mode 624 (let* ((w (window-width))
631 (let* ((w (window-width)) 625 (m (window-margins))
632 (m (window-margins)) 626 (f (window-fringes))
633 (lsb (scroll-bar-columns 'left)) 627 (i 0)
634 (lf (fringe-columns 'left t)) 628 (j (window-hscroll))
635 (lm (or (car m) 0)) 629 ;; Setup the scrollbar, fringes, and margins areas.
636 (rsb (scroll-bar-columns 'right)) 630 (lf (ruler-mode-space
637 (rf (fringe-columns 'right t)) 631 'left-fringe
638 (rm (or (cdr m) 0)) 632 'face 'ruler-mode-fringes-face
639 (ruler (make-string w ruler-mode-basic-graduation-char)) 633 'help-echo (format ruler-mode-fringe-help-echo
640 (i 0) 634 "Left" (or (car f) 0))))
641 (j (window-hscroll)) 635 (rf (ruler-mode-space
642 k c l1 l2 r2 r1 h1 h2 f1 f2) 636 'right-fringe
643 637 'face 'ruler-mode-fringes-face
644 ;; Setup the default properties. 638 'help-echo (format ruler-mode-fringe-help-echo
645 (put-text-property 0 w 'face 'ruler-mode-default-face ruler) 639 "Right" (or (cadr f) 0))))
646 (put-text-property 0 w 640 (lm (ruler-mode-space
647 'help-echo 641 'left-margin
648 (cond 642 'face 'ruler-mode-margins-face
649 (ruler-mode-show-tab-stops 643 'help-echo (format ruler-mode-margin-help-echo
650 ruler-mode-ruler-help-echo-when-tab-stops) 644 "Left" (or (car m) 0))))
651 (goal-column 645 (rm (ruler-mode-space
652 ruler-mode-ruler-help-echo-when-goal-column) 646 'right-margin
653 (t 647 'face 'ruler-mode-margins-face
654 ruler-mode-ruler-help-echo)) 648 'help-echo (format ruler-mode-margin-help-echo
655 ruler) 649 "Right" (or (cdr m) 0))))
656 ;; Setup the local map. 650 (sb (ruler-mode-space
657 (put-text-property 0 w 'local-map ruler-mode-map ruler) 651 'scroll-bar
658 652 'face 'ruler-mode-pad-face))
659 ;; Setup the active area. 653 ;; Remember the scrollbar vertical type.
660 (while (< i w) 654 (sbvt (car (window-current-scroll-bars)))
661 ;; Graduations. 655 ;; Create an "clean" ruler.
662 (cond 656 (ruler
663 ;; Show a number graduation. 657 (propertize
664 ((= (mod j 10) 0) 658 (make-string w ruler-mode-basic-graduation-char)
665 (setq c (number-to-string (/ j 10)) 659 'face 'ruler-mode-default-face
666 m (length c) 660 'local-map ruler-mode-map
667 k i) 661 'help-echo (cond
668 (put-text-property 662 (ruler-mode-show-tab-stops
669 i (1+ i) 'face 'ruler-mode-column-number-face 663 ruler-mode-ruler-help-echo-when-tab-stops)
670 ruler) 664 (goal-column
671 (while (and (> m 0) (>= k 0)) 665 ruler-mode-ruler-help-echo-when-goal-column)
672 (aset ruler k (aref c (setq m (1- m)))) 666 (ruler-mode-ruler-help-echo))))
673 (setq k (1- k)))) 667 k c)
674 ;; Show an intermediate graduation. 668 ;; Setup the active area.
675 ((= (mod j 5) 0) 669 (while (< i w)
676 (aset ruler i ruler-mode-inter-graduation-char))) 670 ;; Graduations.
677 ;; Special columns. 671 (cond
678 (cond 672 ;; Show a number graduation.
679 ;; Show the `current-column' marker. 673 ((= (mod j 10) 0)
680 ((= j (current-column)) 674 (setq c (number-to-string (/ j 10))
681 (aset ruler i ruler-mode-current-column-char) 675 m (length c)
682 (put-text-property 676 k i)
683 i (1+ i) 'face 'ruler-mode-current-column-face 677 (put-text-property
684 ruler)) 678 i (1+ i) 'face 'ruler-mode-column-number-face
685 ;; Show the `goal-column' marker. 679 ruler)
686 ((and goal-column (= j goal-column)) 680 (while (and (> m 0) (>= k 0))
687 (aset ruler i ruler-mode-goal-column-char) 681 (aset ruler k (aref c (setq m (1- m))))
688 (put-text-property 682 (setq k (1- k))))
689 i (1+ i) 'face 'ruler-mode-goal-column-face 683 ;; Show an intermediate graduation.
690 ruler) 684 ((= (mod j 5) 0)
691 (put-text-property 685 (aset ruler i ruler-mode-inter-graduation-char)))
692 i (1+ i) 'help-echo ruler-mode-goal-column-help-echo 686 ;; Special columns.
693 ruler)) 687 (cond
694 ;; Show the `comment-column' marker. 688 ;; Show the `current-column' marker.
695 ((= j comment-column) 689 ((= j (current-column))
696 (aset ruler i ruler-mode-comment-column-char) 690 (aset ruler i ruler-mode-current-column-char)
697 (put-text-property 691 (put-text-property
698 i (1+ i) 'face 'ruler-mode-comment-column-face 692 i (1+ i) 'face 'ruler-mode-current-column-face
699 ruler) 693 ruler))
700 (put-text-property 694 ;; Show the `goal-column' marker.
701 i (1+ i) 'help-echo ruler-mode-comment-column-help-echo 695 ((and goal-column (= j goal-column))
702 ruler)) 696 (aset ruler i ruler-mode-goal-column-char)
703 ;; Show the `fill-column' marker. 697 (put-text-property
704 ((= j fill-column) 698 i (1+ i) 'face 'ruler-mode-goal-column-face
705 (aset ruler i ruler-mode-fill-column-char) 699 ruler)
706 (put-text-property 700 (put-text-property
707 i (1+ i) 'face 'ruler-mode-fill-column-face 701 i (1+ i) 'help-echo ruler-mode-goal-column-help-echo
708 ruler) 702 ruler))
709 (put-text-property 703 ;; Show the `comment-column' marker.
710 i (1+ i) 'help-echo ruler-mode-fill-column-help-echo 704 ((= j comment-column)
711 ruler)) 705 (aset ruler i ruler-mode-comment-column-char)
712 ;; Show the `tab-stop-list' markers. 706 (put-text-property
713 ((and ruler-mode-show-tab-stops (member j tab-stop-list)) 707 i (1+ i) 'face 'ruler-mode-comment-column-face
714 (aset ruler i ruler-mode-tab-stop-char) 708 ruler)
715 (put-text-property 709 (put-text-property
716 i (1+ i) 'face 'ruler-mode-tab-stop-face 710 i (1+ i) 'help-echo ruler-mode-comment-column-help-echo
717 ruler))) 711 ruler))
718 (setq i (1+ i) 712 ;; Show the `fill-column' marker.
719 j (1+ j))) 713 ((= j fill-column)
720 714 (aset ruler i ruler-mode-fill-column-char)
721 ;; Highlight the fringes and margins. 715 (put-text-property
722 (if (nth 2 (window-fringes)) 716 i (1+ i) 'face 'ruler-mode-fill-column-face
723 ;; fringes outside margins. 717 ruler)
724 (setq l1 lf 718 (put-text-property
725 l2 lm 719 i (1+ i) 'help-echo ruler-mode-fill-column-help-echo
726 r2 rm 720 ruler))
727 r1 rf 721 ;; Show the `tab-stop-list' markers.
728 h1 ruler-mode-fringe-help-echo 722 ((and ruler-mode-show-tab-stops (member j tab-stop-list))
729 h2 ruler-mode-margin-help-echo 723 (aset ruler i ruler-mode-tab-stop-char)
730 f1 'ruler-mode-fringes-face 724 (put-text-property
731 f2 'ruler-mode-margins-face) 725 i (1+ i) 'face 'ruler-mode-tab-stop-face
732 ;; fringes inside margins. 726 ruler)))
733 (setq l1 lm 727 (setq i (1+ i)
734 l2 lf 728 j (1+ j)))
735 r2 rf 729 ;; Return the ruler propertized string. Using list here,
736 r1 rm 730 ;; instead of concat visually separate the different areas.
737 h1 ruler-mode-margin-help-echo 731 (if (nth 2 (window-fringes))
738 h2 ruler-mode-fringe-help-echo 732 ;; fringes outside margins.
739 f1 'ruler-mode-margins-face 733 (list "" (and (eq 'left sbvt) sb) lf lm
740 f2 'ruler-mode-fringes-face)) 734 ruler rm rf (and (eq 'right sbvt) sb))
741 ;; Return the ruler propertized string. Using list here, 735 ;; fringes inside margins.
742 ;; instead of concat visually separate the different areas. 736 (list "" (and (eq 'left sbvt) sb) lm lf
743 (list 737 ruler rf rm (and (eq 'right sbvt) sb)))))
744 (ruler-mode-space lsb 'face 'ruler-mode-pad-face)
745 (ruler-mode-space l1 'face f1 'help-echo (format h1 "Left" l1))
746 (ruler-mode-space l2 'face f2 'help-echo (format h2 "Left" l2))
747 ruler
748 (ruler-mode-space r2 'face f2 'help-echo (format h2 "Right" r2))
749 (ruler-mode-space r1 'face f1 'help-echo (format h1 "Right" r1))
750 (ruler-mode-space rsb 'face 'ruler-mode-pad-face)))))
751 738
752(provide 'ruler-mode) 739(provide 'ruler-mode)
753 740