# HG changeset patch # User Masatake YAMATO # Date 1079335622 0 # Node ID ad02f6299e9aeb096551eedadb2ec6c1bfd52210 # Parent 2decd50569f3bbae768a25e426306459995402f6 2004-03-15 Masatake YAMATO * 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. diff -r 2decd50569f3 -r ad02f6299e9a lisp/ChangeLog --- a/lisp/ChangeLog Mon Mar 15 03:55:24 2004 +0000 +++ b/lisp/ChangeLog Mon Mar 15 07:27:02 2004 +0000 @@ -1,3 +1,35 @@ +2004-03-15 Masatake YAMATO + + * 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 * info-look.el (info-lookup): Reuse an existing Info window. diff -r 2decd50569f3 -r ad02f6299e9a lisp/fringe.el --- a/lisp/fringe.el Mon Mar 15 03:55:24 2004 +0000 +++ b/lisp/fringe.el Mon Mar 15 07:27:02 2004 +0000 @@ -218,6 +218,17 @@ (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 diff -r 2decd50569f3 -r ad02f6299e9a lisp/hexl.el --- a/lisp/hexl.el Mon Mar 15 03:55:24 2004 +0000 +++ b/lisp/hexl.el Mon Mar 15 07:27:02 2004 +0000 @@ -78,6 +78,22 @@ :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.") @@ -648,6 +664,15 @@ (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)))) @@ -865,6 +890,32 @@ (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 @@ -873,6 +924,37 @@ (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 diff -r 2decd50569f3 -r ad02f6299e9a lisp/hl-line.el --- a/lisp/hl-line.el Mon Mar 15 03:55:24 2004 +0000 +++ b/lisp/hl-line.el Mon Mar 15 07:27:02 2004 +0000 @@ -57,6 +57,10 @@ ;; 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 @@ -78,6 +82,15 @@ :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) @@ -124,8 +137,7 @@ (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 () @@ -158,14 +170,30 @@ (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 diff -r 2decd50569f3 -r ad02f6299e9a lisp/ruler-mode.el --- a/lisp/ruler-mode.el Mon Mar 15 03:55:24 2004 +0000 +++ b/lisp/ruler-mode.el Mon Mar 15 07:27:02 2004 +0000 @@ -94,6 +94,9 @@ ;; 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 ;; @@ -108,6 +111,8 @@ ;;; Code: (eval-when-compile (require 'wid-edit)) +(require 'scroll-bar) +(require 'fringe) (defgroup ruler-mode nil "Display a ruler in the header line." @@ -298,42 +303,21 @@ "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." @@ -568,9 +552,17 @@ "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 diff -r 2decd50569f3 -r ad02f6299e9a lisp/scroll-bar.el --- a/lisp/scroll-bar.el Mon Mar 15 03:55:24 2004 +0000 +++ b/lisp/scroll-bar.el Mon Mar 15 07:27:02 2004 +0000 @@ -54,6 +54,23 @@ ;; 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)))) + ;;;; Helpful functions for enabling and disabling scroll bars.