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: Sun, 14 Mar 2004 03:13:12 +0900 (JST) Sender: emacs-devel-bounces+emacs-devel=quimby.gnus.org@gnu.org Message-ID: <20040314.031312.21594984.jet@gyve.org> References: <20040312.150538.157235451.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 1079204221 22271 80.91.224.253 (13 Mar 2004 18:57:01 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Sat, 13 Mar 2004 18:57:01 +0000 (UTC) Cc: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+emacs-devel=quimby.gnus.org@gnu.org Sat Mar 13 19:56:46 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 1B2EJS-0004tC-00 for ; Sat, 13 Mar 2004 19:56:46 +0100 Original-Received: from monty-python.gnu.org ([199.232.76.173]) by quimby.gnus.org with esmtp (Exim 3.35 #1 (Debian)) id 1B2EJR-0001KS-00 for ; Sat, 13 Mar 2004 19:56:46 +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 1B2DiD-0006g4-7k for emacs-devel@quimby.gnus.org; Sat, 13 Mar 2004 13:18:17 -0500 Original-Received: from list by monty-python.gnu.org with tmda-scanned (Exim 4.30) id 1B2Dhy-0006f4-4h for emacs-devel@gnu.org; Sat, 13 Mar 2004 13:18:02 -0500 Original-Received: from mail by monty-python.gnu.org with spam-scanned (Exim 4.30) id 1B2DhQ-0006WX-Rj for emacs-devel@gnu.org; Sat, 13 Mar 2004 13:18:00 -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 1B2DdW-0005ai-8f for emacs-devel@gnu.org; Sat, 13 Mar 2004 13:13:26 -0500 Original-Received: from localhost (h220-215-187-129.catv01.itscom.jp [220.215.187.129]) by r-maa.spacetown.ne.jp (8.11.6) with ESMTP id i2DIDEX13789; Sun, 14 Mar 2004 03:13:14 +0900 (JST) Original-To: monnier@iro.umontreal.ca 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:20395 X-Report-Spam: http://spam.gmane.org/gmane.emacs.devel:20395 > > +(defcustom hexl-use-ruler t > > + "If non-nil then show the ruler for hexl mode." > > + :type 'boolean > > + :group 'hexl) > > I'd call it hexl-use-header-line, but maybe that's just me. I will use hexl-use-ruler. After thinking I have defined `ruler-mode-ruler-function' in ruler-mode.el. With the variable, you can define a mode specific ruler. I have used `ruler-mode-ruler-function' in hexl-mode.el. As the result I dont have to create a backup of header format; ruler-mode does it. > > +(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) > > I'd call it `hexl-ascii-cursor' since the user might not know it's an > overlay (and it could actually be implemented as a text-property tomorrow). > Also I'd stick to just `:inverse-video' as much as possible or more > specifically I'd try to make it look just like the normal cursor (since > there's conceptually no difference between the two). You are right. I have changed the code as you wrote. > You could define this with `define-minor-mode'. > But I'd recommend to go even further and replace the above with: > > (defcustom hexl-mode-hook () > "Blabla" > :type 'hook > :options '(hexl-follow-line)) > > (defun hexl-follow-line () > (hl-line-mode 1)) Smart. I use this technique both in follow-line and ruler. I've turned hl-line and ruler on in default. Summary of changes since last review: - scroll-bar-columns is moved from frame.el to scroll-bar.el, and - ruler-mode-current-column-face is used in hexl's ruler, and - ruler-mode-ruler-function is introduced in ruler-mode.el. Regards, Masatake YAMATO Index: lisp/scroll-bar.el =================================================================== RCS file: /cvsroot/emacs/emacs/lisp/scroll-bar.el,v retrieving revision 1.48 diff -u -r1.48 scroll-bar.el --- lisp/scroll-bar.el 20 Sep 2003 23:33:37 -0000 1.48 +++ lisp/scroll-bar.el 13 Mar 2004 17:58:41 -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. 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 13 Mar 2004 17:58:42 -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 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 13 Mar 2004 17:58:42 -0000 @@ -43,6 +43,11 @@ ;;; Code: (require 'eldoc) +(require 'ruler-mode) +(require 'frame) +(require 'fringe) +(eval-when-compile + (require 'hl-line)) ;; ;; vars here @@ -78,6 +83,27 @@ :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)) + +(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-cursor + '((((class color)) (:foreground "blue" :background "cyan" :underline t)) + (t (:inverse-video t))) + "Face for the cursor in ascii area of hexl mode buffer." + :group 'hexl) + (defvar hexl-max-address 0 "Maximum offset into hexl buffer.") @@ -245,6 +271,10 @@ (eldoc-remove-command "hexl-save-buffer" "hexl-current-address") + ;; Set a callback function for ruler. + (set (make-local-variable 'ruler-mode-ruler-function) + 'hexl-mode-ruler) + (if hexl-follow-ascii (hexl-follow-ascii 1))) (run-hooks 'hexl-mode-hook)) @@ -648,6 +678,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 +904,14 @@ (remove-hook 'post-command-hook 'hexl-follow-ascii-find t) ))))) +(defun hexl-activate-ruler () + "Activate `ruler-mode'" + (ruler-mode 1)) + +(defun hexl-follow-line () + "Activate `hl-line-mode'" + (hl-line-mode 1)) + (defun hexl-follow-ascii-find () "Find and highlight the ASCII element corresponding to current point." (let ((pos (+ 51 @@ -872,6 +919,37 @@ (mod (hexl-current-address) 16)))) (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 'ruler-mode-current-column-face s) + ;; Highlight the current ascii column + (put-text-property (+ 12 39 highlight) (+ 12 40 highlight) + 'face 'ruler-mode-current-column-face 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 13 Mar 2004 17:58:42 -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