From: Masatake YAMATO Date: Mon, 15 Mar 2004 07:27:02 +0000 (+0000) Subject: 2004-03-15 Masatake YAMATO X-Git-Tag: ttn-vms-21-2-B4~7243 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=9fd76d04e8b93bb6116dffe49b8fdabdac71286f;p=emacs.git 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 --git a/lisp/ChangeLog b/lisp/ChangeLog index fe1b7db508e..b28512af321 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -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 --git a/lisp/fringe.el b/lisp/fringe.el index ab7709332f5..f52ecdf64d2 100644 --- a/lisp/fringe.el +++ b/lisp/fringe.el @@ -218,6 +218,17 @@ default appearance of fringes on all frames, see the command (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 --git a/lisp/hexl.el b/lisp/hexl.el index 9fd21824f26..66aceeaee71 100644 --- a/lisp/hexl.el +++ b/lisp/hexl.el @@ -78,6 +78,22 @@ Quoting cannot be used, so the arguments cannot themselves contain spaces." :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 @@ This discards the buffer's undo information." (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 @@ Customize the variable `hexl-follow-ascii' to disable this feature." (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 @@ Customize the variable `hexl-follow-ascii' to disable this feature." (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 --git a/lisp/hl-line.el b/lisp/hl-line.el index 58921aaa58a..5ed334f4049 100644 --- a/lisp/hl-line.el +++ b/lisp/hl-line.el @@ -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 @@ the command `hl-line-mode' to turn Hl-Line mode on." :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 @@ addition to `hl-line-highlight' on `post-command-hook'." (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 @@ Global-Hl-Line mode uses the functions `global-hl-line-unhighlight' and (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 --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el index 18fdcddd507..d6c205a23b4 100644 --- a/lisp/ruler-mode.el +++ b/lisp/ruler-mode.el @@ -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 @@ or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or "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 @@ START-EVENT is the mouse click event." "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 --git a/lisp/scroll-bar.el b/lisp/scroll-bar.el index a2f2d22da5d..2d2921e9fc9 100644 --- a/lisp/scroll-bar.el +++ b/lisp/scroll-bar.el @@ -54,6 +54,23 @@ that scroll bar position." ;; 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.