comparison lisp/ruler-mode.el @ 90195:a1b34dec1104

Revision: [e-mail]--gnu-2005/emacs--unicode--0--patch-63 Merge from emacs--cvs-trunk--0 Patches applied: * emacs--cvs-trunk--0 (patch 358-423) - Update from CVS - Remove "-face" suffix from widget faces - Remove "-face" suffix from custom faces - Remove "-face" suffix from change-log faces - Remove "-face" suffix from compilation faces - Remove "-face" suffix from diff-mode faces - lisp/longlines.el (longlines-visible-face): Face removed - Remove "-face" suffix from woman faces - Remove "-face" suffix from whitespace-highlight face - Remove "-face" suffix from ruler-mode faces - Remove "-face" suffix from show-paren faces - Remove "-face" suffix from log-view faces - Remove "-face" suffix from smerge faces - Remove "-face" suffix from show-tabs faces - Remove "-face" suffix from highlight-changes faces - Remove "-face" suffix from and downcase info faces - Remove "-face" suffix from pcvs faces - Update uses of renamed pcvs faces - Tweak ChangeLog - Remove "-face" suffix from strokes-char face - Remove "-face" suffix from compare-windows face - Remove "-face" suffix from calendar faces - Remove "-face" suffix from diary-button face - Remove "-face" suffix from testcover faces - Remove "-face" suffix from viper faces - Remove "-face" suffix from org faces - Remove "-face" suffix from sgml-namespace face - Remove "-face" suffix from table-cell face - Remove "-face" suffix from tex-mode faces - Remove "-face" suffix from texinfo-heading face - Remove "-face" suffix from flyspell faces - Remove "-face" suffix from gomoku faces - Remove "-face" suffix from mpuz faces - Merge from gnus--rel--5.10 - Remove "-face" suffix from Buffer-menu-buffer face - Remove "-face" suffix from antlr-mode faces - Remove "-face" suffix from ebrowse faces - Remove "-face" suffix from flymake faces - Remove "-face" suffix from idlwave faces - Remove "-face" suffix from sh-script faces - Remove "-face" suffix from vhdl-mode faces - Remove "-face" suffix from which-func face - Remove "-face" suffix from cperl-mode faces - Remove "-face" suffix from ld-script faces - Fix cperl-mode font-lock problem - Tweak which-func face * gnus--rel--5.10 (patch 80-82) - Merge from emacs--cvs-trunk--0 - Update from CVS

90194:d940db5a66b9

;;; ruler-mode.el --- display a ruler in the header line

;; Copyright (C) 2001, 2002, 2003, 2004 Free Software Foundation, Inc.

;; Author: David Ponce <[e-mail]>
;; Maintainer: David Ponce <[e-mail]>
;; Created: 24 Mar 2001
;; Version: 1.6

;; - `ruler-mode-inter-graduation-char' character used for
;;   intermediate graduations ('!' by default).
;;
;; The following faces are customizable:
;;
;; - `ruler-mode-default-face' the ruler default face.
;; - `ruler-mode-fill-column-face' the face used to highlight the
;;   `fill-column' character.
;; - `ruler-mode-comment-column-face' the face used to highlight the
;;   `comment-column' character.
;; - `ruler-mode-goal-column-face' the face used to highlight the
;;   `goal-column' character.
;; - `ruler-mode-current-column-face' the face used to highlight the
;;   `current-column' character.
;; - `ruler-mode-tab-stop-face' the face used to highlight tab stop
;;   characters.
;; - `ruler-mode-margins-face' the face used to highlight graduations
;;   in the `window-margins' areas.
;; - `ruler-mode-fringes-face' the face used to highlight graduations
;;   in the `window-fringes' areas.
;; - `ruler-mode-column-number-face' the face used to highlight the
;;   numbered graduations.
;;
;; `ruler-mode-default-face' inherits from the built-in `default' face.
;; All `ruler-mode' faces inherit from `ruler-mode-default-face'.
;;
;; WARNING: To keep ruler graduations aligned on text columns it is
;; important to use the same font family and size for ruler and text
;; areas.
;;

(defcustom ruler-mode-set-goal-column-ding-flag t
  "*Non-nil means do `ding' when `goal-column' is set."
  :group 'ruler-mode
  :type 'boolean)

(defface ruler-mode-default-face
  '((((type tty))
     (:inherit default
               :background "grey64"
               :foreground "grey50"
               ))

                            :line-width 1
                            :style released-button)
               )))
  "Default face used by the ruler."
  :group 'ruler-mode)

(defface ruler-mode-pad-face
  '((((type tty))
     (:inherit ruler-mode-default-face
               :background "grey50"
               ))
    (t
     (:inherit ruler-mode-default-face
               :background "grey64"
               )))
  "Face used to pad inactive ruler areas."
  :group 'ruler-mode)

(defface ruler-mode-margins-face
  '((t
     (:inherit ruler-mode-default-face
               :foreground "white"
               )))
  "Face used to highlight margin areas."
  :group 'ruler-mode)

(defface ruler-mode-fringes-face
  '((t
     (:inherit ruler-mode-default-face
               :foreground "green"
               )))
  "Face used to highlight fringes areas."
  :group 'ruler-mode)

(defface ruler-mode-column-number-face
  '((t
     (:inherit ruler-mode-default-face
               :foreground "black"
               )))
  "Face used to highlight number graduations."
  :group 'ruler-mode)

(defface ruler-mode-fill-column-face
  '((t
     (:inherit ruler-mode-default-face
               :foreground "red"
               )))
  "Face used to highlight the fill column character."
  :group 'ruler-mode)

(defface ruler-mode-comment-column-face
  '((t
     (:inherit ruler-mode-default-face
               :foreground "red"
               )))
  "Face used to highlight the comment column character."
  :group 'ruler-mode)

(defface ruler-mode-goal-column-face
  '((t
     (:inherit ruler-mode-default-face
               :foreground "red"
               )))
  "Face used to highlight the goal column character."
  :group 'ruler-mode)

(defface ruler-mode-tab-stop-face
  '((t
     (:inherit ruler-mode-default-face
               :foreground "steelblue"
               )))
  "Face used to highlight tab stop characters."
  :group 'ruler-mode)

(defface ruler-mode-current-column-face
  '((t
     (:inherit ruler-mode-default-face
               :weight bold
               :foreground "yellow"
               )))
  "Face used to highlight the `current-column' character."
  :group 'ruler-mode)


(defsubst ruler-mode-full-window-width ()
  "Return the full width of the selected window."
  (let ((edges (window-edges)))

         (when ruler-mode-set-goal-column-ding-flag
           (ding))
         (message "Goal column set to %d (click on %s again to unset it)"
                  newc
                  (propertize (char-to-string ruler-mode-goal-column-char)
                              'face 'ruler-mode-goal-column-face))
         nil) ;; Don't start dragging.
        )
       (if (eq 'click (ruler-mode-mouse-drag-any-column-iteration
                       (posn-window start)))
           (when (eq 'goal-column ruler-mode-dragged-symbol)

         (i 0)
         (j (window-hscroll))
         ;; Setup the scrollbar, fringes, and margins areas.
         (lf (ruler-mode-space
              'left-fringe
              'face 'ruler-mode-fringes-face
              'help-echo (format ruler-mode-fringe-help-echo
                                 "Left" (or (car f) 0))))
         (rf (ruler-mode-space
              'right-fringe
              'face 'ruler-mode-fringes-face
              'help-echo (format ruler-mode-fringe-help-echo
                                 "Right" (or (cadr f) 0))))
         (lm (ruler-mode-space
              'left-margin
              'face 'ruler-mode-margins-face
              'help-echo (format ruler-mode-margin-help-echo
                                 "Left" (or (car m) 0))))
         (rm (ruler-mode-space
              'right-margin
              'face 'ruler-mode-margins-face
              'help-echo (format ruler-mode-margin-help-echo
                                 "Right" (or (cdr m) 0))))
         (sb (ruler-mode-space
              'scroll-bar
              'face 'ruler-mode-pad-face))
         ;; Remember the scrollbar vertical type.
         (sbvt (car (window-current-scroll-bars)))
         ;; Create an "clean" ruler.
         (ruler
          (propertize
           (make-string w ruler-mode-basic-graduation-char)
           'face 'ruler-mode-default-face
           'local-map ruler-mode-map
           'help-echo (cond
                       (ruler-mode-show-tab-stops
                        ruler-mode-ruler-help-echo-when-tab-stops)
                       (goal-column

       ((= (mod j 10) 0)
        (setq c (number-to-string (/ j 10))
              m (length c)
              k i)
        (put-text-property
         i (1+ i) 'face 'ruler-mode-column-number-face
         ruler)
        (while (and (> m 0) (>= k 0))
          (aset ruler k (aref c (setq m (1- m))))
          (setq k (1- k))))
       ;; Show an intermediate graduation.

      (cond
       ;; Show the `current-column' marker.
       ((= j (current-column))
        (aset ruler i ruler-mode-current-column-char)
        (put-text-property
         i (1+ i) 'face 'ruler-mode-current-column-face
         ruler))
       ;; Show the `goal-column' marker.
       ((and goal-column (= j goal-column))
        (aset ruler i ruler-mode-goal-column-char)
        (put-text-property
         i (1+ i) 'face 'ruler-mode-goal-column-face
         ruler)
	(put-text-property
         i (1+ i) 'mouse-face 'mode-line-highlight
         ruler)
        (put-text-property

         ruler))
       ;; Show the `comment-column' marker.
       ((= j comment-column)
        (aset ruler i ruler-mode-comment-column-char)
        (put-text-property
         i (1+ i) 'face 'ruler-mode-comment-column-face
         ruler)
	(put-text-property
         i (1+ i) 'mouse-face 'mode-line-highlight
         ruler)
        (put-text-property

         ruler))
       ;; Show the `fill-column' marker.
       ((= j fill-column)
        (aset ruler i ruler-mode-fill-column-char)
        (put-text-property
         i (1+ i) 'face 'ruler-mode-fill-column-face
         ruler)
	(put-text-property
         i (1+ i) 'mouse-face 'mode-line-highlight
         ruler)
        (put-text-property

         ruler))
       ;; Show the `tab-stop-list' markers.
       ((and ruler-mode-show-tab-stops (member j tab-stop-list))
        (aset ruler i ruler-mode-tab-stop-char)
        (put-text-property
         i (1+ i) 'face 'ruler-mode-tab-stop-face
         ruler)))
      (setq i (1+ i)
            j (1+ j)))
    ;; Return the ruler propertized string.  Using list here,
    ;; instead of concat visually separate the different areas.

90195:a1b34dec1104

;;; ruler-mode.el --- display a ruler in the header line

;; Copyright (C) 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.

;; Author: David Ponce <[e-mail]>
;; Maintainer: David Ponce <[e-mail]>
;; Created: 24 Mar 2001
;; Version: 1.6

;; - `ruler-mode-inter-graduation-char' character used for
;;   intermediate graduations ('!' by default).
;;
;; The following faces are customizable:
;;
;; - `ruler-mode-default' the ruler default face.
;; - `ruler-mode-fill-column' the face used to highlight the
;;   `fill-column' character.
;; - `ruler-mode-comment-column' the face used to highlight the
;;   `comment-column' character.
;; - `ruler-mode-goal-column' the face used to highlight the
;;   `goal-column' character.
;; - `ruler-mode-current-column' the face used to highlight the
;;   `current-column' character.
;; - `ruler-mode-tab-stop' the face used to highlight tab stop
;;   characters.
;; - `ruler-mode-margins' the face used to highlight graduations
;;   in the `window-margins' areas.
;; - `ruler-mode-fringes' the face used to highlight graduations
;;   in the `window-fringes' areas.
;; - `ruler-mode-column-number' the face used to highlight the
;;   numbered graduations.
;;
;; `ruler-mode-default' inherits from the built-in `default' face.
;; All `ruler-mode' faces inherit from `ruler-mode-default'.
;;
;; WARNING: To keep ruler graduations aligned on text columns it is
;; important to use the same font family and size for ruler and text
;; areas.
;;

(defcustom ruler-mode-set-goal-column-ding-flag t
  "*Non-nil means do `ding' when `goal-column' is set."
  :group 'ruler-mode
  :type 'boolean)

(defface ruler-mode-default
  '((((type tty))
     (:inherit default
               :background "grey64"
               :foreground "grey50"
               ))

                            :line-width 1
                            :style released-button)
               )))
  "Default face used by the ruler."
  :group 'ruler-mode)
;; backward-compatibility alias
(put 'ruler-mode-default-face 'face-alias 'ruler-mode-default)

(defface ruler-mode-pad
  '((((type tty))
     (:inherit ruler-mode-default
               :background "grey50"
               ))
    (t
     (:inherit ruler-mode-default
               :background "grey64"
               )))
  "Face used to pad inactive ruler areas."
  :group 'ruler-mode)
;; backward-compatibility alias
(put 'ruler-mode-pad-face 'face-alias 'ruler-mode-pad)

(defface ruler-mode-margins
  '((t
     (:inherit ruler-mode-default
               :foreground "white"
               )))
  "Face used to highlight margin areas."
  :group 'ruler-mode)
;; backward-compatibility alias
(put 'ruler-mode-margins-face 'face-alias 'ruler-mode-margins)

(defface ruler-mode-fringes
  '((t
     (:inherit ruler-mode-default
               :foreground "green"
               )))
  "Face used to highlight fringes areas."
  :group 'ruler-mode)
;; backward-compatibility alias
(put 'ruler-mode-fringes-face 'face-alias 'ruler-mode-fringes)

(defface ruler-mode-column-number
  '((t
     (:inherit ruler-mode-default
               :foreground "black"
               )))
  "Face used to highlight number graduations."
  :group 'ruler-mode)
;; backward-compatibility alias
(put 'ruler-mode-column-number-face 'face-alias 'ruler-mode-column-number)

(defface ruler-mode-fill-column
  '((t
     (:inherit ruler-mode-default
               :foreground "red"
               )))
  "Face used to highlight the fill column character."
  :group 'ruler-mode)
;; backward-compatibility alias
(put 'ruler-mode-fill-column-face 'face-alias 'ruler-mode-fill-column)

(defface ruler-mode-comment-column
  '((t
     (:inherit ruler-mode-default
               :foreground "red"
               )))
  "Face used to highlight the comment column character."
  :group 'ruler-mode)
;; backward-compatibility alias
(put 'ruler-mode-comment-column-face 'face-alias 'ruler-mode-comment-column)

(defface ruler-mode-goal-column
  '((t
     (:inherit ruler-mode-default
               :foreground "red"
               )))
  "Face used to highlight the goal column character."
  :group 'ruler-mode)
;; backward-compatibility alias
(put 'ruler-mode-goal-column-face 'face-alias 'ruler-mode-goal-column)

(defface ruler-mode-tab-stop
  '((t
     (:inherit ruler-mode-default
               :foreground "steelblue"
               )))
  "Face used to highlight tab stop characters."
  :group 'ruler-mode)
;; backward-compatibility alias
(put 'ruler-mode-tab-stop-face 'face-alias 'ruler-mode-tab-stop)

(defface ruler-mode-current-column
  '((t
     (:inherit ruler-mode-default
               :weight bold
               :foreground "yellow"
               )))
  "Face used to highlight the `current-column' character."
  :group 'ruler-mode)
;; backward-compatibility alias
(put 'ruler-mode-current-column-face 'face-alias 'ruler-mode-current-column)


(defsubst ruler-mode-full-window-width ()
  "Return the full width of the selected window."
  (let ((edges (window-edges)))

         (when ruler-mode-set-goal-column-ding-flag
           (ding))
         (message "Goal column set to %d (click on %s again to unset it)"
                  newc
                  (propertize (char-to-string ruler-mode-goal-column-char)
                              'face 'ruler-mode-goal-column))
         nil) ;; Don't start dragging.
        )
       (if (eq 'click (ruler-mode-mouse-drag-any-column-iteration
                       (posn-window start)))
           (when (eq 'goal-column ruler-mode-dragged-symbol)

         (i 0)
         (j (window-hscroll))
         ;; Setup the scrollbar, fringes, and margins areas.
         (lf (ruler-mode-space
              'left-fringe
              'face 'ruler-mode-fringes
              'help-echo (format ruler-mode-fringe-help-echo
                                 "Left" (or (car f) 0))))
         (rf (ruler-mode-space
              'right-fringe
              'face 'ruler-mode-fringes
              'help-echo (format ruler-mode-fringe-help-echo
                                 "Right" (or (cadr f) 0))))
         (lm (ruler-mode-space
              'left-margin
              'face 'ruler-mode-margins
              'help-echo (format ruler-mode-margin-help-echo
                                 "Left" (or (car m) 0))))
         (rm (ruler-mode-space
              'right-margin
              'face 'ruler-mode-margins
              'help-echo (format ruler-mode-margin-help-echo
                                 "Right" (or (cdr m) 0))))
         (sb (ruler-mode-space
              'scroll-bar
              'face 'ruler-mode-pad))
         ;; Remember the scrollbar vertical type.
         (sbvt (car (window-current-scroll-bars)))
         ;; Create an "clean" ruler.
         (ruler
          (propertize
           (make-string w ruler-mode-basic-graduation-char)
           'face 'ruler-mode-default
           'local-map ruler-mode-map
           'help-echo (cond
                       (ruler-mode-show-tab-stops
                        ruler-mode-ruler-help-echo-when-tab-stops)
                       (goal-column

       ((= (mod j 10) 0)
        (setq c (number-to-string (/ j 10))
              m (length c)
              k i)
        (put-text-property
         i (1+ i) 'face 'ruler-mode-column-number
         ruler)
        (while (and (> m 0) (>= k 0))
          (aset ruler k (aref c (setq m (1- m))))
          (setq k (1- k))))
       ;; Show an intermediate graduation.

      (cond
       ;; Show the `current-column' marker.
       ((= j (current-column))
        (aset ruler i ruler-mode-current-column-char)
        (put-text-property
         i (1+ i) 'face 'ruler-mode-current-column
         ruler))
       ;; Show the `goal-column' marker.
       ((and goal-column (= j goal-column))
        (aset ruler i ruler-mode-goal-column-char)
        (put-text-property
         i (1+ i) 'face 'ruler-mode-goal-column
         ruler)
	(put-text-property
         i (1+ i) 'mouse-face 'mode-line-highlight
         ruler)
        (put-text-property

         ruler))
       ;; Show the `comment-column' marker.
       ((= j comment-column)
        (aset ruler i ruler-mode-comment-column-char)
        (put-text-property
         i (1+ i) 'face 'ruler-mode-comment-column
         ruler)
	(put-text-property
         i (1+ i) 'mouse-face 'mode-line-highlight
         ruler)
        (put-text-property

         ruler))
       ;; Show the `fill-column' marker.
       ((= j fill-column)
        (aset ruler i ruler-mode-fill-column-char)
        (put-text-property
         i (1+ i) 'face 'ruler-mode-fill-column
         ruler)
	(put-text-property
         i (1+ i) 'mouse-face 'mode-line-highlight
         ruler)
        (put-text-property

         ruler))
       ;; Show the `tab-stop-list' markers.
       ((and ruler-mode-show-tab-stops (member j tab-stop-list))
        (aset ruler i ruler-mode-tab-stop-char)
        (put-text-property
         i (1+ i) 'face 'ruler-mode-tab-stop
         ruler)))
      (setq i (1+ i)
            j (1+ j)))
    ;; Return the ruler propertized string.  Using list here,
    ;; instead of concat visually separate the different areas.