mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-23 07:19:15 +00:00
Code Issues Releases Activity

From David Ponce <david@dponce.com>

Browse Source 
(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
This commit is contained in:
Kim F. Storm 2004-03-19 13:17:16 +00:00
parent 24d0e54531
commit 31da0380c3
2 changed files with 141 additions and 141 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
lisp/ChangeLog
View File

@ -1,3 +1,16 @@
2004-03-19 David Ponce <david@dponce.com>
* ruler-mode.el (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
2004-03-19 Kim F. Storm <storm@cua.dk>
* hexl.el (hexl-mode-ruler): Adapt to new :align-to semantics.

269
lisp/ruler-mode.el
View File

@ -1,6 +1,6 @@
;;; ruler-mode.el --- display a ruler in the header line
;; Copyright (C) 2001, 2002, 2003 Free Software Foundation, Inc.
;; Copyright (C) 2001, 2002, 2003, 2004 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
;; Maintainer: David Ponce <david@dponce.com>
@ -95,7 +95,7 @@
;; important to use the same font family and size for ruler and text
;; areas.
;;
;; You can override the ruler format by defining an appropriate
;; You can override the ruler format by defining an appropriate
;; function as the buffer-local value of `ruler-mode-ruler-function'.
;; Installation
@ -531,19 +531,15 @@ START-EVENT is the mouse click event."
(defvar ruler-mode-header-line-format-old nil
"Hold previous value of `header-line-format'.")
(make-variable-buffer-local 'ruler-mode-header-line-format-old)
(defvar ruler-mode-ruler-function nil
"If non-nil, function to call to return ruler string.
(defvar ruler-mode-ruler-function 'ruler-mode-ruler
"Function to call to return ruler header line format.
This variable is expected to be made buffer-local by modes.")
(defconst ruler-mode-header-line-format
'(:eval (funcall (if ruler-mode-ruler-function
ruler-mode-ruler-function
'ruler-mode-ruler)))
'(:eval (funcall ruler-mode-ruler-function))
"`header-line-format' used in ruler mode.
If the non-nil value for ruler-mode-ruler-function is given, use it.
Else use `ruler-mode-ruler' is used as default value.")
Call `ruler-mode-ruler-function' to compute the ruler value.")
;;;###autoload
(define-minor-mode ruler-mode
@ -556,18 +552,18 @@ Else use `ruler-mode-ruler' is used as default value.")
;; When `ruler-mode' is on save previous header line format
;; and install the ruler header line format.
(when (local-variable-p 'header-line-format)
(setq ruler-mode-header-line-format-old header-line-format))
(set (make-local-variable 'ruler-mode-header-line-format-old)
header-line-format))
(setq header-line-format ruler-mode-header-line-format)
(add-hook 'post-command-hook ; add local hook
#'force-mode-line-update nil t))
(add-hook 'post-command-hook 'force-mode-line-update nil t))
;; When `ruler-mode' is off restore previous header line format if
;; the current one is the ruler header line format.
(when (eq header-line-format ruler-mode-header-line-format)
(kill-local-variable 'header-line-format)
(when (local-variable-p 'ruler-mode-header-line-format-old)
(setq header-line-format ruler-mode-header-line-format-old)))
(remove-hook 'post-command-hook ; remove local hook
#'force-mode-line-update t)))
(setq header-line-format ruler-mode-header-line-format-old)
(kill-local-variable 'ruler-mode-header-line-format-old)))
(remove-hook 'post-command-hook 'force-mode-line-update t)))
;; Add ruler-mode to the minor mode menu in the mode line
(define-key mode-line-mode-menu [ruler-mode]
@ -621,133 +617,124 @@ mouse-2: unset goal column"
(defsubst ruler-mode-space (width &rest props)
"Return a single space string of WIDTH times the normal character width.
Optional argument PROPS specifies other text properties to apply."
(if (> width 0)
(apply 'propertize " " 'display (list 'space :width width) props)
""))
(apply 'propertize " " 'display (list 'space :width width) props))
(defun ruler-mode-ruler ()
"Return a string ruler."
(when ruler-mode
(let* ((w (window-width))
(m (window-margins))
(lsb (scroll-bar-columns 'left))
(lf (fringe-columns 'left t))
(lm (or (car m) 0))
(rsb (scroll-bar-columns 'right))
(rf (fringe-columns 'right t))
(rm (or (cdr m) 0))
(ruler (make-string w ruler-mode-basic-graduation-char))
(i 0)
(j (window-hscroll))
k c l1 l2 r2 r1 h1 h2 f1 f2)
;; Setup the default properties.
(put-text-property 0 w 'face 'ruler-mode-default-face ruler)
(put-text-property 0 w
'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)
(t
ruler-mode-ruler-help-echo))
ruler)
;; Setup the local map.
(put-text-property 0 w 'local-map ruler-mode-map ruler)
;; 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-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.
((= (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-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) '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-face
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-face
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 (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)))
;; Highlight the fringes and margins.
(if (nth 2 (window-fringes))
;; fringes outside margins.
(setq l1 lf
l2 lm
r2 rm
r1 rf
h1 ruler-mode-fringe-help-echo
h2 ruler-mode-margin-help-echo
f1 'ruler-mode-fringes-face
f2 'ruler-mode-margins-face)
;; fringes inside margins.
(setq l1 lm
l2 lf
r2 rf
r1 rm
h1 ruler-mode-margin-help-echo
h2 ruler-mode-fringe-help-echo
f1 'ruler-mode-margins-face
f2 'ruler-mode-fringes-face))
;; Return the ruler propertized string. Using list here,
;; instead of concat visually separate the different areas.
(list
(ruler-mode-space lsb 'face 'ruler-mode-pad-face)
(ruler-mode-space l1 'face f1 'help-echo (format h1 "Left" l1))
(ruler-mode-space l2 'face f2 'help-echo (format h2 "Left" l2))
ruler
(ruler-mode-space r2 'face f2 'help-echo (format h2 "Right" r2))
(ruler-mode-space r1 'face f1 'help-echo (format h1 "Right" r1))
(ruler-mode-space rsb 'face 'ruler-mode-pad-face)))))
"Compute and return an header line ruler."
(let* ((w (window-width))
(m (window-margins))
(f (window-fringes))
(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
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-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.
((= (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-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) '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-face
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-face
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 (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.
(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)))))
(provide 'ruler-mode)