From mboxrd@z Thu Jan 1 00:00:00 1970 Path: main.gmane.org!not-for-mail From: Masatake YAMATO Newsgroups: gmane.emacs.devel Subject: Re: ruler support in hexl mode Date: Fri, 12 Mar 2004 15:05:38 +0900 (JST) Sender: emacs-devel-bounces+emacs-devel=quimby.gnus.org@gnu.org Message-ID: <20040312.150538.157235451.jet@gyve.org> References: NNTP-Posting-Host: deer.gmane.org Mime-Version: 1.0 Content-Type: Text/Plain; charset=us-ascii Content-Transfer-Encoding: 7bit X-Trace: sea.gmane.org 1079072570 2750 80.91.224.253 (12 Mar 2004 06:22:50 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Fri, 12 Mar 2004 06:22:50 +0000 (UTC) Original-X-From: emacs-devel-bounces+emacs-devel=quimby.gnus.org@gnu.org Fri Mar 12 07:22:40 2004 Return-path: Original-Received: from quimby.gnus.org ([80.91.224.244]) by deer.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 1B1g48-0003Ki-00 for ; Fri, 12 Mar 2004 07:22:40 +0100 Original-Received: from monty-python.gnu.org ([199.232.76.173]) by quimby.gnus.org with esmtp (Exim 3.35 #1 (Debian)) id 1B1g48-0006Yk-00 for ; Fri, 12 Mar 2004 07:22:40 +0100 Original-Received: from localhost ([127.0.0.1] helo=monty-python.gnu.org) by monty-python.gnu.org with esmtp (Exim 4.30) id 1B1g0c-0004De-VJ for emacs-devel@quimby.gnus.org; Fri, 12 Mar 2004 01:19:02 -0500 Original-Received: from list by monty-python.gnu.org with tmda-scanned (Exim 4.30) id 1B1foO-00029n-GN for emacs-devel@gnu.org; Fri, 12 Mar 2004 01:06:24 -0500 Original-Received: from mail by monty-python.gnu.org with spam-scanned (Exim 4.30) id 1B1fno-00020U-HJ for emacs-devel@gnu.org; Fri, 12 Mar 2004 01:06:20 -0500 Original-Received: from [210.130.136.40] (helo=r-maa.spacetown.ne.jp) by monty-python.gnu.org with esmtp (Exim 4.30) id 1B1fnn-000207-Du for emacs-devel@gnu.org; Fri, 12 Mar 2004 01:05:47 -0500 Original-Received: from localhost (nat-pool.jp.redhat.com [219.120.63.249]) by r-maa.spacetown.ne.jp (8.11.6) with ESMTP id i2C65dL27927 for ; Fri, 12 Mar 2004 15:05:39 +0900 (JST) Original-To: emacs-devel@gnu.org In-Reply-To: X-Mailer: Mew version 4.0.62 on Emacs 21.3.50 / Mule 5.0 (SAKAKI) X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.4 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+emacs-devel=quimby.gnus.org@gnu.org Xref: main.gmane.org gmane.emacs.devel:20341 X-Report-Spam: http://spam.gmane.org/gmane.emacs.devel:20341 Based on Stefan and Kim's suggestions, I have revised the patch. I've moved the essential functions(`scroll-bar-columns' and `fringe-columns') in ruler-mode.el to frame.el and fringe.el and use new functions in ruler-mode.el and hexl.el. Index: lisp/ruler-mode.el =================================================================== RCS file: /cvsroot/emacs/emacs/lisp/ruler-mode.el,v retrieving revision 1.17 diff -u -r1.17 ruler-mode.el --- lisp/ruler-mode.el 20 Oct 2003 23:27:52 -0000 1.17 +++ lisp/ruler-mode.el 12 Mar 2004 06:01:27 -0000 @@ -107,7 +107,9 @@ ;;; Code: (eval-when-compile - (require 'wid-edit)) + (require 'wid-edit) + (require 'frame) + (require 'fringe)) (defgroup ruler-mode nil "Display a ruler in the header line." @@ -298,42 +300,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." Index: lisp/hexl.el =================================================================== RCS file: /cvsroot/emacs/emacs/lisp/hexl.el,v retrieving revision 1.85 diff -u -r1.85 hexl.el --- lisp/hexl.el 9 Mar 2004 01:25:27 -0000 1.85 +++ lisp/hexl.el 12 Mar 2004 06:01:27 -0000 @@ -42,7 +42,11 @@ ;;; Code: -(require 'eldoc) +(eval-when-compile + (require 'frame) + (require 'fringe) + (require 'eldoc) + (require 'hl-line)) ;; ;; vars here @@ -78,6 +82,33 @@ :group 'hexl :version "20.3") +(defcustom hexl-follow-line t + "If non-nil then turn `hl-line-mode' on." + :type 'boolean + :group 'hexl) + +(defcustom hexl-use-ruler t + "If non-nil then show the ruler for hexl mode." + :type 'boolean + :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) + +(defface hexl-ascii-overlay + ;; Definition borrowed from vcursor.el. + '((((class color)) (:foreground "blue" :background "cyan" :underline t)) + (t (:inverse-video t :underline t))) + "Face for the overlay in ascii area of hexl mode buffer." + :group 'hexl) + (defvar hexl-max-address 0 "Maximum offset into hexl buffer.") @@ -89,11 +120,16 @@ (defvar hexl-mode-old-isearch-search-fun-function) (defvar hexl-mode-old-require-final-newline) (defvar hexl-mode-old-syntax-table) +(defvar hexl-mode-old-header-line-format) (defvar hexl-ascii-overlay nil "Overlay used to highlight ASCII element corresponding to current point.") (make-variable-buffer-local 'hexl-ascii-overlay) +(defconst hexl-mode-header-line-format + '(:eval (hexl-mode-ruler)) + "`header-line-format' used in hexl mode.") + ;; routines (put 'hexl-mode 'mode-class 'special) @@ -245,7 +281,11 @@ (eldoc-remove-command "hexl-save-buffer" "hexl-current-address") - (if hexl-follow-ascii (hexl-follow-ascii 1))) + (set (make-local-variable 'hexl-mode-old-header-line-format) header-line-format) + (setq header-line-format hexl-mode-header-line-format) + + (if hexl-follow-ascii (hexl-follow-ascii 1)) + (if hexl-follow-line (hexl-follow-line 1))) (run-hooks 'hexl-mode-hook)) @@ -341,6 +381,7 @@ (use-local-map hexl-mode-old-local-map) (set-syntax-table hexl-mode-old-syntax-table) (setq major-mode hexl-mode-old-major-mode) + (setq header-line-format hexl-mode-old-header-line-format) (force-mode-line-update)) (defun hexl-maybe-dehexlify-buffer () @@ -648,6 +689,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)))) @@ -854,7 +904,7 @@ (progn (setq hexl-ascii-overlay (make-overlay 1 1) hexl-follow-ascii t) - (overlay-put hexl-ascii-overlay 'face 'highlight) + (overlay-put hexl-ascii-overlay 'face 'hexl-ascii-overlay) (add-hook 'post-command-hook 'hexl-follow-ascii-find nil t))) ;; turn it off (if hexl-ascii-overlay @@ -865,6 +915,20 @@ (remove-hook 'post-command-hook 'hexl-follow-ascii-find t) ))))) +(defun hexl-follow-line (&optional arg) + "Toggle following line address in Hexl buffers. +With prefix ARG, turn on following if and only if ARG is positive. +When following is enabled, the line address corresponding to the +element under the point is highlighted. +Customize the variable `hexl-follow-line' to disable this feature." + (interactive "P") + (let ((on-p (if arg + (> (prefix-numeric-value arg) 0) + (not hexl-follow-line)))) + + (setq hexl-follow-line on-p) + (hl-line-mode (if on-p 1 -1)))) + (defun hexl-follow-ascii-find () "Find and highlight the ASCII element corresponding to current point." (let ((pos (+ 51 @@ -872,6 +936,38 @@ (mod (hexl-current-address) 16)))) (move-overlay hexl-ascii-overlay pos (1+ pos)) )) + +(defun hexl-mode-ruler () + "Return a string ruler for hexl mode." + (when hexl-use-ruler + (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. Index: lisp/fringe.el =================================================================== RCS file: /cvsroot/emacs/emacs/lisp/fringe.el,v retrieving revision 1.10 diff -u -r1.10 fringe.el --- lisp/fringe.el 8 Feb 2004 23:33:16 -0000 1.10 +++ lisp/fringe.el 12 Mar 2004 06:01:27 -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 Index: lisp/frame.el =================================================================== RCS file: /cvsroot/emacs/emacs/lisp/frame.el,v retrieving revision 1.206 diff -u -r1.206 frame.el --- lisp/frame.el 29 Dec 2003 19:17:24 -0000 1.206 +++ lisp/frame.el 12 Mar 2004 06:01:27 -0000 @@ -1215,6 +1215,22 @@ :group 'scrolling) (defvaralias 'automatic-hscrolling 'auto-hscroll-mode) +(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)))) ;; Blinking cursor