* hl-line.el (hl-line-range-function): New variable.
(hl-line-move): New function.
(global-hl-line-highlight): Use `hl-line-move'.
(hl-line-highlight): Ditto.
* scroll-bar.el (scroll-bar-columns): New function derived from
ruler-mode.el.
* fringe.el (fringe-columns): New function derived from
ruler-mode.el.
* ruler-mode.el (top-level): Require scroll-bar and fringe.
(ruler-mode-left-fringe-cols)
(ruler-mode-right-fringe-cols): Use `fringe-columns'.
(ruler-mode-right-scroll-bar-cols)
(ruler-mode-left-scroll-bar-cols): Use `scroll-bar-columns'.
(ruler-mode-ruler-function): New variable.
(ruler-mode-header-line-format): Call `ruler-mode-ruler-function'
if the value for `ruler-mode-ruler-function'is given.
* hexl.el (hexl-mode-hook): Make the hook customizable.
(hexl-address-area, hexl-ascii-area, hexl-ascii-cursor): New
customize variables.
(hexlify-buffer): Put font-lock-faces on the address area and
the ascii area.
(hexl-activate-ruler): New function.
(hexl-follow-line): New function.
(hexl-highlight-line-range): New function.
(hexl-mode-ruler): New function.
+2004-03-15 Masatake YAMATO <jet@gyve.org>
+
+ * hl-line.el (hl-line-range-function): New variable.
+ (hl-line-move): New function.
+ (global-hl-line-highlight): Use `hl-line-move'.
+ (hl-line-highlight): Ditto.
+
+ * scroll-bar.el (scroll-bar-columns): New function derived from
+ ruler-mode.el.
+
+ * fringe.el (fringe-columns): New function derived from
+ ruler-mode.el.
+
+ * ruler-mode.el (top-level): Require scroll-bar and fringe.
+ (ruler-mode-left-fringe-cols)
+ (ruler-mode-right-fringe-cols): Use `fringe-columns'.
+ (ruler-mode-right-scroll-bar-cols)
+ (ruler-mode-left-scroll-bar-cols): Use `scroll-bar-columns'.
+ (ruler-mode-ruler-function): New variable.
+ (ruler-mode-header-line-format): Call `ruler-mode-ruler-function'
+ if the value for `ruler-mode-ruler-function'is given.
+
+ * hexl.el (hexl-mode-hook): Make the hook customizable.
+ (hexl-address-area, hexl-ascii-area, hexl-ascii-cursor): New
+ customize variables.
+ (hexlify-buffer): Put font-lock-faces on the address area and
+ the ascii area.
+ (hexl-activate-ruler): New function.
+ (hexl-follow-line): New function.
+ (hexl-highlight-line-range): New function.
+ (hexl-mode-ruler): New function.
+
2004-03-12 Jesper Harder <harder@ifa.au.dk>
* info-look.el (info-lookup): Reuse an existing Info window.
(list (cons 'left-fringe (if (consp mode) (car mode) mode))
(cons 'right-fringe (if (consp mode) (cdr mode) mode)))))
+(defsubst fringe-columns (side &optional real)
+ "Return the width, measured in columns, of the fringe area on SIDE.
+If optional argument REAL is non-nil, return a real floating point
+number instead of a rounded integer value.
+SIDE must be the symbol `left' or `right'."
+ (funcall (if real '/ 'ceiling)
+ (or (funcall (if (eq side 'left) 'car 'cadr)
+ (window-fringes))
+ 0)
+ (float (frame-char-width))))
+
(provide 'fringe)
;;; arch-tag: 6611ef60-0869-47ed-8b93-587ee7d3ff5d
:group 'hexl
:version "20.3")
+(defcustom hexl-mode-hook '(hexl-follow-line hexl-activate-ruler)
+ "Normal hook run when entering Hexl mode."
+ :type 'hook
+ :options '(hexl-follow-line hexl-activate-ruler turn-on-eldoc-mode)
+ :group 'hexl)
+
+(defface hexl-address-area
+ '((t (:inherit header-line)))
+ "Face used in address are of hexl-mode buffer."
+ :group 'hexl)
+
+(defface hexl-ascii-area
+ '((t (:inherit header-line)))
+ "Face used in ascii are of hexl-mode buffer."
+ :group 'hexl)
+
(defvar hexl-max-address 0
"Maximum offset into hexl buffer.")
(apply 'call-process-region (point-min) (point-max)
(expand-file-name hexl-program exec-directory)
t t nil (split-string hexl-options))
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward "^[0-9a-f]+:" nil t)
+ (put-text-property (match-beginning 0) (match-end 0)
+ 'font-lock-face 'hexl-address-area))
+ (goto-char (point-min))
+ (while (re-search-forward " \\(.+$\\)" nil t)
+ (put-text-property (match-beginning 1) (match-end 1)
+ 'font-lock-face 'hexl-ascii-area)))
(if (> (point) (hexl-address-to-marker hexl-max-address))
(hexl-goto-address hexl-max-address))))
(remove-hook 'post-command-hook 'hexl-follow-ascii-find t)
)))))
+(defun hexl-activate-ruler ()
+ "Activate `ruler-mode'"
+ (require 'ruler-mode)
+ (set (make-local-variable 'ruler-mode-ruler-function)
+ 'hexl-mode-ruler)
+ (ruler-mode 1))
+
+(defun hexl-follow-line ()
+ "Activate `hl-line-mode'"
+ (require 'frame)
+ (require 'fringe)
+ (require 'hl-line)
+ (set (make-local-variable 'hl-line-range-function)
+ 'hexl-highlight-line-range)
+ (set (make-local-variable 'hl-line-face)
+ 'highlight)
+ (hl-line-mode 1))
+
+(defun hexl-highlight-line-range ()
+ "Return the range of address area for the point.
+This function is assumed to be used as call back function for `hl-line-mode'."
+ (cons
+ (line-beginning-position)
+ ;; 9 stands for (length "87654321:")
+ (+ (line-beginning-position) 9)))
+
(defun hexl-follow-ascii-find ()
"Find and highlight the ASCII element corresponding to current point."
(let ((pos (+ 51
(move-overlay hexl-ascii-overlay pos (1+ pos))
))
+(defun hexl-mode-ruler ()
+ "Return a string ruler for hexl mode."
+ (let* ((highlight (mod (hexl-current-address) 16))
+ (s "87654321 0011 2233 4455 6677 8899 aabb ccdd eeff 0123456789abcdef")
+ (pos 0)
+ (spaces (+ (scroll-bar-columns 'left)
+ (fringe-columns 'left)
+ (or (car (window-margins)) 0))))
+ (set-text-properties 0 (length s) nil s)
+ ;; Turn spaces in the header into stretch specs so they work
+ ;; regardless of the header-line face.
+ (while (string-match "[ \t]+" s pos)
+ (setq pos (match-end 0))
+ (put-text-property (match-beginning 0) pos 'display
+ ;; Assume fixed-size chars
+ `(space :align-to (+ (scroll-bar . left)
+ left-fringe left-margin
+ ,pos))
+ s))
+ ;; Highlight the current column.
+ (put-text-property (+ 10 (/ (* 5 highlight) 2))
+ (+ 12 (/ (* 5 highlight) 2))
+ 'face 'highlight s)
+ ;; Highlight the current ascii column
+ (put-text-property (+ 12 39 highlight) (+ 12 40 highlight)
+ 'face 'highlight s)
+ ;; Add the leading space.
+ (concat (propertize (make-string (floor spaces) ? )
+ 'display `(space :width ,spaces))
+ s)))
+
;; startup stuff.
(if hexl-mode-map
;; it to nil to avoid highlighting specific buffers, when the global
;; mode is used.
+;; In default whole the line is highlighted. The range of highlighting
+;; can be changed by defining an appropriate function as the
+;; buffer-local value of `hl-line-range-function'.
+
;;; Code:
(defgroup hl-line nil
:version "21.4"
:group 'hl-line)
+(defvar hl-line-range-function nil
+ "If non-nil, function to call to return highlight range.
+The function of no args should return a cons cell; its car value
+is the beginning position of highlight and its cdr value is the
+end position of highlight in the buffer.
+It should return nil if there's no region to be highlighted.
+
+This variable is expected to be made buffer-local by modes.")
+
(defvar hl-line-overlay nil
"Overlay used by Hl-Line mode to highlight the current line.")
(make-variable-buffer-local 'hl-line-overlay)
(overlay-put hl-line-overlay 'face hl-line-face))
(overlay-put hl-line-overlay
'window (unless hl-line-sticky-flag (selected-window)))
- (move-overlay hl-line-overlay
- (line-beginning-position) (line-beginning-position 2)))
+ (hl-line-move hl-line-overlay))
(hl-line-unhighlight)))
(defun hl-line-unhighlight ()
(setq global-hl-line-overlay (make-overlay 1 1)) ; to be moved
(overlay-put global-hl-line-overlay 'face hl-line-face))
(overlay-put global-hl-line-overlay 'window (selected-window))
- (move-overlay global-hl-line-overlay
- (line-beginning-position) (line-beginning-position 2)))))
+ (hl-line-move global-hl-line-overlay))))
(defun global-hl-line-unhighlight ()
"Deactivate the Global-Hl-Line overlay on the current line."
(if global-hl-line-overlay
(delete-overlay global-hl-line-overlay)))
+(defun hl-line-move (overlay)
+ "Move the hl-line-mode overlay.
+If `hl-line-range-function' is non-nil, move the OVERLAY to the position
+where the function returns. If `hl-line-range-function' is nil, fill
+the line including the point by OVERLAY."
+ (let (tmp b e)
+ (if hl-line-range-function
+ (setq tmp (funcall hl-line-range-function)
+ b (car tmp)
+ e (cdr tmp))
+ (setq tmp t
+ b (line-beginning-position)
+ e (line-beginning-position 2)))
+ (if tmp
+ (move-overlay overlay b e)
+ (move-overlay overlay 1 1))))
+
(provide 'hl-line)
;;; arch-tag: ac806940-0876-4959-8c89-947563ee2833
;; 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.
+;;
+;; You can override the ruler format by defining an appropriate
+;; function as the buffer-local value of `ruler-mode-ruler-function'.
;; Installation
;;
;;; Code:
(eval-when-compile
(require 'wid-edit))
+(require 'scroll-bar)
+(require 'fringe)
(defgroup ruler-mode nil
"Display a ruler in the header line."
"Return the width, measured in columns, of the left fringe area.
If optional argument REAL is non-nil, return a real floating point
number instead of a rounded integer value."
- (funcall (if real '/ 'ceiling)
- (or (car (window-fringes)) 0)
- (float (frame-char-width))))
+ (fringe-columns 'left real))
(defsubst ruler-mode-right-fringe-cols (&optional real)
"Return the width, measured in columns, of the right fringe area.
If optional argument REAL is non-nil, return a real floating point
number instead of a rounded integer value."
- (funcall (if real '/ 'ceiling)
- (or (nth 1 (window-fringes)) 0)
- (float (frame-char-width))))
-
-(defun ruler-mode-scroll-bar-cols (side)
- "Return the width, measured in columns, of the vertical scrollbar on SIDE.
-SIDE must be the symbol `left' or `right'."
- (let* ((wsb (window-scroll-bars))
- (vtype (nth 2 wsb))
- (cols (nth 1 wsb)))
- (cond
- ((not (memq side '(left right)))
- (error "`left' or `right' expected instead of %S" side))
- ((and (eq vtype side) cols))
- ((eq (frame-parameter nil 'vertical-scroll-bars) side)
- ;; nil means it's a non-toolkit scroll bar, and its width in
- ;; columns is 14 pixels rounded up.
- (ceiling (or (frame-parameter nil 'scroll-bar-width) 14)
- (frame-char-width)))
- (0))))
+ (fringe-columns 'right real))
(defmacro ruler-mode-right-scroll-bar-cols ()
"Return the width, measured in columns, of the right vertical scrollbar."
- '(ruler-mode-scroll-bar-cols 'right))
+ '(scroll-bar-columns 'right))
(defmacro ruler-mode-left-scroll-bar-cols ()
"Return the width, measured in columns, of the left vertical scrollbar."
- '(ruler-mode-scroll-bar-cols 'left))
+ '(scroll-bar-columns 'left))
(defsubst ruler-mode-full-window-width ()
"Return the full width of the selected window."
"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.
+This variable is expected to be made buffer-local by modes.")
+
(defconst ruler-mode-header-line-format
- '(:eval (ruler-mode-ruler))
- "`header-line-format' used in ruler mode.")
+ '(:eval (funcall (if ruler-mode-ruler-function
+ ruler-mode-ruler-function
+ 'ruler-mode-ruler)))
+ "`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.")
;;;###autoload
(define-minor-mode ruler-mode
;; with a large scroll bar portion can easily overflow a lisp int.
(truncate (/ (* (float (car num-denom)) whole) (cdr num-denom))))
+(defun scroll-bar-columns (side)
+ "Return the width, measured in columns, of the vertical scrollbar on SIDE.
+SIDE must be the symbol `left' or `right'."
+ (let* ((wsb (window-scroll-bars))
+ (vtype (nth 2 wsb))
+ (cols (nth 1 wsb)))
+ (cond
+ ((not (memq side '(left right)))
+ (error "`left' or `right' expected instead of %S" side))
+ ((and (eq vtype side) cols))
+ ((eq (frame-parameter nil 'vertical-scroll-bars) side)
+ ;; nil means it's a non-toolkit scroll bar, and its width in
+ ;; columns is 14 pixels rounded up.
+ (ceiling (or (frame-parameter nil 'scroll-bar-width) 14)
+ (frame-char-width)))
+ (0))))
+
\f
;;;; Helpful functions for enabling and disabling scroll bars.
projects / emacs.git / commitdiff