mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-23 07:19:15 +00:00
2004-03-15 Masatake YAMATO <jet@gyve.org>
* 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.
This commit is contained in:
Masatake YAMATO
parent
6e54fa536d
commit
9fd76d04e8
@ -1,3 +1,35 @@
|
||||
2004-03-15 Masatake YAMATO <jet@gyve.org>
|
||||
|
||||
* 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 <harder@ifa.au.dk>
|
||||
|
||||
* info-look.el (info-lookup): Reuse an existing Info window.
|
||||
|
||||
@ -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
|
||||
|
||||
82
lisp/hexl.el
82
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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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.
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user