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: ruler support in hexl mode Date: Fri, 05 Mar 2004 14:29:15 +0900 (JST) Sender: emacs-devel-bounces+emacs-devel=quimby.gnus.org@gnu.org Message-ID: <20040305.142915.63122255.jet@gyve.org> 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 1078766727 20603 80.91.224.253 (8 Mar 2004 17:25:27 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Mon, 8 Mar 2004 17:25:27 +0000 (UTC) Original-X-From: emacs-devel-bounces+emacs-devel=quimby.gnus.org@gnu.org Mon Mar 08 18:25:02 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 1B0OUv-0005BX-00 for ; Mon, 08 Mar 2004 18:25:01 +0100 Original-Received: from monty-python.gnu.org ([199.232.76.173]) by quimby.gnus.org with esmtp (Exim 3.35 #1 (Debian)) id 1B0OUu-0002Tl-00 for ; Mon, 08 Mar 2004 18:25:00 +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 1B0OUR-0006XA-4D for emacs-devel@quimby.gnus.org; Mon, 08 Mar 2004 12:24:31 -0500 Original-Received: from list by monty-python.gnu.org with tmda-scanned (Exim 4.30) id 1Az7uH-0006rl-2A for emacs-devel@gnu.org; Fri, 05 Mar 2004 00:29:57 -0500 Original-Received: from mail by monty-python.gnu.org with spam-scanned (Exim 4.30) id 1Az7tk-0006mk-Jq for emacs-devel@gnu.org; Fri, 05 Mar 2004 00:29:56 -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 1Az7tj-0006mZ-Uv for emacs-devel@gnu.org; Fri, 05 Mar 2004 00:29:24 -0500 Original-Received: from localhost (h219-110-074-006.catv01.itscom.jp [219.110.74.6]) by r-maa.spacetown.ne.jp (8.11.6) with ESMTP id i255TIK14735 for ; Fri, 5 Mar 2004 14:29:18 +0900 (JST) Original-To: emacs-devel@gnu.org 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.2 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:20271 X-Report-Spam: http://spam.gmane.org/gmane.emacs.devel:20271 I've added a ruler to hexl mode. Please, review the patch. Masatake YAMATO 2004-03-05 Masatake YAMATO * hexl.el (top-level): Add ruler support in hexl-mode. Require ruler.el. (hexl-follow-line, hexl-use-ruler) (hexl-use-face-on-address-area, hexl-address-area-face) (hexl-use-face-on-ascii-area, hexl-ascii-area-face): New customizable variables. (hexl-mode-old-header-line-format): New internal variable. (hexl-line-overlay): New internal variable. (hexl-mode-header-line-format): New constant. (hexl-mode): Store old `header-line-format' and set new value(ruler) to it. Turn on `hexl-follow-line'. (hexl-mode-exit): remove `hexl-follow-line-find' from `post-command-hook'. Clear `hexl-line-overlay'. (hexl-mode-exit): Restore old `header-line-format'. (hexlify-buffer): Put faces on hexl address area and ascii area. (hexl-follow-line): New function. (hexl-follow-line-find): New function. (hexl-mode-ruler): New function. cvs diff: warning: unrecognized response `access control disabled, clients can connect from any host' from cvs server Index: lisp/hexl.el =================================================================== RCS file: /cvsroot/emacs/emacs/lisp/hexl.el,v retrieving revision 1.84 diff -u -r1.84 hexl.el --- lisp/hexl.el 4 Mar 2004 18:19:18 -0000 1.84 +++ lisp/hexl.el 5 Mar 2004 05:26:29 -0000 @@ -43,6 +43,7 @@ ;;; Code: (require 'eldoc) +(require 'ruler-mode) ;; ;; vars here @@ -78,6 +79,34 @@ :group 'hexl :version "20.3") +(defcustom hexl-follow-line t + "If non-nil then highlight the line address corresponding to point." + :type 'boolean + :group 'hexl) + +(defcustom hexl-use-ruler t + "If non-nil then show the ruler for hexl mode." + :type 'boolean + :group 'hexl) + +(defcustom hexl-use-face-on-address-area t + "If non-nil then put `hexl-address-area-face' on adderss area of hexl-mode buffer." + :type 'face + :group 'hexl) + +(defface hexl-address-area-face + '((t (:inherit header-line))) + "Face used in address are of hexl-mode buffer.") + +(defcustom hexl-use-face-on-ascii-area t + "If non-nil then put `hexl-ascii-area-face' on ascii area of hexl-mode buffer." + :type 'face + :group 'hexl) + +(defface hexl-ascii-area-face + '((t (:inherit header-line))) + "Face used in ascii are of hexl-mode buffer.") + (defvar hexl-max-address 0 "Maximum offset into hexl buffer.") @@ -89,11 +118,20 @@ (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) +(defvar hexl-line-overlay nil + "Overlay used to highlight the address of line corresponding to current point.") +(make-variable-buffer-local 'hexl-line-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,8 +283,13 @@ (eldoc-remove-command "hexl-save-buffer" "hexl-current-address") - (if hexl-follow-ascii (hexl-follow-ascii 1))) - (run-hooks 'hexl-mode-hook)) + (make-variable-buffer-local 'hexl-mode-old-header-line-format) + (setq 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))) (defun hexl-isearch-search-function () @@ -333,7 +376,10 @@ (remove-hook 'after-revert-hook 'hexl-after-revert-hook t) (remove-hook 'change-major-mode-hook 'hexl-maybe-dehexlify-buffer t) (remove-hook 'post-command-hook 'hexl-follow-ascii-find t) + (remove-hook 'post-command-hook 'hexl-follow-line-find t) + (setq hexl-ascii-overlay nil) + (setq hexl-line-overlay nil) (setq require-final-newline hexl-mode-old-require-final-newline) (setq mode-name hexl-mode-old-mode-name) @@ -341,6 +387,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 +695,17 @@ (apply 'call-process-region (point-min) (point-max) (expand-file-name hexl-program exec-directory) t t nil (split-string hexl-options)) + (save-excursion + (when hexl-use-face-on-address-area + (goto-char (point-min)) + (while (re-search-forward "^[0-9a-f]\\{8\\}:" nil t) + (put-text-property (match-beginning 0) (match-end 0) + 'face 'hexl-address-area-face))) + (goto-char (point-min)) + (when hexl-use-face-on-ascii-area + (while (re-search-forward " \\( .+$\\)" nil t) + (put-text-property (match-beginning 1) (match-end 1) + 'face 'hexl-ascii-area-face)))) (if (> (point) (hexl-address-to-marker hexl-max-address)) (hexl-goto-address hexl-max-address)))) @@ -865,6 +923,34 @@ (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-line-overlay)))) + + (if on-p + ;; turn it on + (if (not hexl-line-overlay) + (progn + (setq hexl-line-overlay (make-overlay 1 1) + hexl-follow-line t) + (overlay-put hexl-line-overlay 'face 'highlight) + (add-hook 'post-command-hook 'hexl-follow-line-find nil t))) + ;; turn it off + (if hexl-line-overlay + (progn + (delete-overlay hexl-line-overlay) + (setq hexl-line-overlay nil + hexl-follow-line nil) + (remove-hook 'post-command-hook 'hexl-follow-line-find t) + ))))) + (defun hexl-follow-ascii-find () "Find and highlight the ASCII element corresponding to current point." (let ((pos (+ 51 @@ -872,6 +958,64 @@ (mod (hexl-current-address) 16)))) (move-overlay hexl-ascii-overlay pos (1+ pos)) )) + +(defun hexl-follow-line-find () + "Find and highlight the line address corresponding to current point." + (move-overlay hexl-line-overlay + (line-beginning-position) + (+ (line-beginning-position) 8))) + +;; ruler + +;; This function is derived from `ruler-mode-ruler' in ruler-mode.el. +(defun hexl-mode-ruler () + "Return a string ruler for hexl mode." + (when hexl-use-ruler + (let* ((fullw (ruler-mode-full-window-width)) + (w (window-width)) + (m (window-margins)) + (lsb (ruler-mode-left-scroll-bar-cols)) + (lf (ruler-mode-left-fringe-cols)) + (lm (or (car m) 0)) + (ruler (make-string fullw ?\ )) + (o (+ lsb lf lm)) + (x o) + (highlight (mod (hexl-current-address) 16))) + ;; "87654321" + (do ((i 8 (1- i))) + ((= i 0)) + (aset ruler x (aref (number-to-string i) 0)) + (setq x (1+ x))) + ;; "87654321 " + (setq x (+ x 2)) ; ": " + ;; "87654321 0011 2233 4455 6677 8899 aabb ccdd eeff" + (do* ((i 0 (1+ i)) + (c (format "%x" i) (format "%x" i))) + ((= i 16)) + (aset ruler x (aref c 0)) + (setq x (1+ x)) + (aset ruler x (aref c 0)) + (setq x (1+ x)) + (if (= highlight i) + (put-text-property (- x 2) x + 'face 'highlight + ruler)) + (when (= (mod i 2) 1) + (aset ruler x ?\ ) + (setq x (1+ x)))) + ;; "87654321 0011 2233 4455 6677 8899 aabb ccdd eeff " + (setq x (1+ x)) ; " " + ;; "87654321 0011 2233 4455 6677 8899 aabb ccdd eeff 0123456789abcdef" + (do* ((i 0 (1+ i)) + (c (format "%x" i) (format "%x" i))) + ((= i 16)) + (aset ruler x (aref c 0)) + (setq x (1+ x)) + (if (= highlight i) + (put-text-property (1- x) x + 'face 'highlight + ruler))) + ruler))) ;; startup stuff.