Function: ruler-mode-ruler

ruler-mode-ruler is a byte-compiled function defined in ruler-mode.el.gz.

Signature

(ruler-mode-ruler)

Documentation

Compute and return a header line ruler.

Source Code

;; Defined in /usr/src/emacs/lisp/ruler-mode.el.gz
(defun ruler-mode-ruler ()
  "Compute and return a header line ruler."
  (let* ((w (ruler-mode-text-scaled-window-width))
         (m (window-margins))
         (f (window-fringes))
         (i (if display-line-numbers
                ;; FIXME: ruler-mode relies on I being an integer, so
                ;; the column numbers might be slightly off if the
                ;; line-number face is customized.
                (round (line-number-display-width 'columns))
              0))
         (j (ruler-mode-text-scaled-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 the part of header-line corresponding to the
           ;; line-number display be blank, not filled with
           ;; ruler-mode-basic-graduation-char.
           (if display-line-numbers
               (let* ((lndw (round (line-number-display-width 'columns)))
                      ;; We need a multibyte string here so we could
                      ;; later use aset to insert multibyte characters
                      ;; into that string.
                      (s (make-string lndw ?\s t)))
                 (concat s (make-string (- w lndw)
                                        ruler-mode-basic-graduation-char t)))
             (make-string w ruler-mode-basic-graduation-char t))
           '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
                        ruler-mode-ruler-help-echo-when-goal-column)
                       (ruler-mode-ruler-help-echo))))
         k c)
    ;; Setup the active area.
    (while (< i w)
      ;; Graduations.
      (cond
       ;; Show a number graduation.
       ((= (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.
       ((= (mod j 5) 0)
        (aset ruler i ruler-mode-inter-graduation-char)))
      ;; Special columns.
      (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
         i (1+ i) 'help-echo ruler-mode-goal-column-help-echo
         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
         i (1+ i) 'help-echo ruler-mode-comment-column-help-echo
         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
         i (1+ i) 'help-echo ruler-mode-fill-column-help-echo
         ruler))
       ;; Show the `tab-stop-list' markers.
       ((and ruler-mode-show-tab-stops (= j (indent-next-tab-stop (1- j))))
        (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.
    (if (nth 2 (window-fringes))
        ;; fringes outside margins.
        (list "" (and (eq 'left sbvt) sb) lf lm
              ruler rm rf (and (eq 'right sbvt) sb))
      ;; fringes inside margins.
      (list "" (and (eq 'left sbvt) sb) lm lf
            ruler rf rm (and (eq 'right sbvt) sb)))))