[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
bug#12147: 24.1.50; [PATCH] ansi-color for man
From: |
Wolfgang Jenkner |
Subject: |
bug#12147: 24.1.50; [PATCH] ansi-color for man |
Date: |
Mon, 06 Aug 2012 17:10:52 +0200 |
User-agent: |
Gnus/5.130006 (Ma Gnus v0.6) Emacs/24.1.50 (berkeley-unix) |
Quoting http://article.gmane.org/gmane.emacs.bugs/7327
>> Wouldn't it make sense to _use_ the SGR control sequences by
>> applying `ansi-color-apply-on-region' (from `ansi-color.el') on the
>> output buffer instead of suppressing them?
[...]
> Volunteers welcome.
If you apply the two patches below and then look at grotty(1), you will
see that the text chunk `at the same time' is not rendered correctly:
all words should be bold and underlined but only the first word `at' is
rendered this way, while the other words are only underlined but not
bold. Now, `od -c' shows the raw text is like this
0002460 033 [ 4 m 033 [ 1 m a t 033 [
0002500 2 4 m 033 [ 4 m t h e 033 [ 2 4 m
0002520 033 [ 4 m s a m e 033 [ 2 4 m 033
0002540 [ 4 m t i m e 033 [ 2 4 m \t 033 [ 2
0002560 2 m ( b y u s i n g t h e
but ansi-color does not recognize SGR code 24 to turn off `underlined'
only and so discards _all_ attributes. There's another patch to make
ansi-color support such parameters, see
http://debbugs.gnu.org/cgi/bugreport.cgi?bug=12146
There are two patches below: The first one replaces face-valued
variables by faces (in the same way that this was done for apropos.el,
so it probably needs a NEWS entry as well). This is needed in the
second patch to set up ansi-color-faces-vector.
2012-07-27 Wolfgang Jenkner <wjenkner@inode.at>
* man.el (Man-overstrike-face, Man-underline-face)
(Man-reverse-face): Remove variables.
(Man-overstrike, Man-underline, Man-reverse): New faces.
(Man-fontify-manpage): Use them instead of the variables.
(Man-cleanup-manpage): Comment change.
(Man-ansi-color-map): New variable.
(Man-fontify-manpage): Use it.
Call ansi-color-apply-on-region to replace ad hoc code.
In GNU Emacs 24.1.50.1 (amd64-unknown-freebsd9.0, GTK+ Version 2.24.6)
of 2012-07-20 on iznogoud.viz
Windowing system distributor `The X.Org Foundation', version 11.0.11006000
Configured using:
`configure '--prefix=/opt' '--without-gsettings' 'MAKE=gmake''
Important settings:
value of $LC_CTYPE: en_US.UTF-8
locale-coding-system: utf-8-unix
default enable-multibyte-characters: t
=== modified file 'lisp/man.el'
--- lisp/man.el 2012-07-11 23:13:41 +0000
+++ lisp/man.el 2012-07-26 15:55:07 +0000
@@ -129,20 +129,23 @@
:type 'boolean
:group 'man)
-(defcustom Man-overstrike-face 'bold
+(defface Man-overstrike
+ '((t (:inherit bold)))
"Face to use when fontifying overstrike."
- :type 'face
- :group 'man)
+ :group 'man
+ :version "24.2")
-(defcustom Man-underline-face 'underline
+(defface Man-underline
+ '((t (:inherit underline)))
"Face to use when fontifying underlining."
- :type 'face
- :group 'man)
+ :group 'man
+ :version "24.2")
-(defcustom Man-reverse-face 'highlight
+(defface Man-reverse
+ '((t (:inherit highlight)))
"Face to use when fontifying reverse video."
- :type 'face
- :group 'man)
+ :group 'man
+ :version "24.2")
;; Use the value of the obsolete user option Man-notify, if set.
(defcustom Man-notify-method (if (boundp 'Man-notify) Man-notify 'friendly)
@@ -1082,23 +1085,23 @@
(goto-char (point-min))
(while (search-forward "__\b\b" nil t)
(backward-delete-char 4)
- (put-text-property (point) (1+ (point)) 'face Man-underline-face))
+ (put-text-property (point) (1+ (point)) 'face 'Man-underline))
(goto-char (point-min))
(while (search-forward "\b\b__" nil t)
(backward-delete-char 4)
- (put-text-property (1- (point)) (point) 'face Man-underline-face))))
+ (put-text-property (1- (point)) (point) 'face 'Man-underline))))
(goto-char (point-min))
(while (search-forward "_\b" nil t)
(backward-delete-char 2)
- (put-text-property (point) (1+ (point)) 'face Man-underline-face))
+ (put-text-property (point) (1+ (point)) 'face 'Man-underline))
(goto-char (point-min))
(while (search-forward "\b_" nil t)
(backward-delete-char 2)
- (put-text-property (1- (point)) (point) 'face Man-underline-face))
+ (put-text-property (1- (point)) (point) 'face 'Man-underline))
(goto-char (point-min))
(while (re-search-forward "\\(.\\)\\(\b+\\1\\)+" nil t)
(replace-match "\\1")
- (put-text-property (1- (point)) (point) 'face Man-overstrike-face))
+ (put-text-property (1- (point)) (point) 'face 'Man-overstrike))
(goto-char (point-min))
(while (re-search-forward "o\b\\+\\|\\+\bo" nil t)
(replace-match "o")
@@ -1109,7 +1112,7 @@
(put-text-property (1- (point)) (point) 'face 'bold))
;; When the header is longer than the manpage name, groff tries to
;; condense it to a shorter line interspersed with ^H. Remove ^H with
- ;; their preceding chars (but don't put Man-overstrike-face). (Bug#5566)
+ ;; their preceding chars (but don't put Man-overstrike). (Bug#5566)
(goto-char (point-min))
(while (re-search-forward ".\b" nil t) (backward-delete-char 2))
(goto-char (point-min))
@@ -1120,7 +1123,7 @@
(while (re-search-forward Man-heading-regexp nil t)
(put-text-property (match-beginning 0)
(match-end 0)
- 'face Man-overstrike-face)))
+ 'face 'Man-overstrike)))
(message "%s man page formatted" (Man-page-from-arguments Man-arguments)))
(defun Man-highlight-references (&optional xref-man-type)
@@ -1203,7 +1206,7 @@
(while (re-search-forward "[-|]\\(\b[-|]\\)+" nil t) (replace-match "+"))
;; When the header is longer than the manpage name, groff tries to
;; condense it to a shorter line interspersed with ^H. Remove ^H with
- ;; their preceding chars (but don't put Man-overstrike-face). (Bug#5566)
+ ;; their preceding chars (but don't put Man-overstrike). (Bug#5566)
(goto-char (point-min))
(while (re-search-forward ".\b" nil t) (backward-delete-char 2))
(Man-softhyphen-to-minus)
=== modified file 'lisp/man.el'
--- lisp/man.el 2012-07-26 15:55:07 +0000
+++ lisp/man.el 2012-07-26 15:57:51 +0000
@@ -88,6 +88,7 @@
;;; Code:
+(require 'ansi-color)
(require 'button)
;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
@@ -147,6 +148,12 @@
:group 'man
:version "24.2")
+(defvar Man-ansi-color-map (let ((ansi-color-faces-vector
+ [ default Man-overstrike default Man-underline
+ Man-underline default default Man-reverse
]))
+ (ansi-color-make-color-map))
+ "The value used here for `ansi-color-map'.")
+
;; Use the value of the obsolete user option Man-notify, if set.
(defcustom Man-notify-method (if (boundp 'Man-notify) Man-notify 'friendly)
"Selects the behavior when manpage is ready.
@@ -957,7 +964,6 @@
Man-width)
(Man-width (frame-width))
((window-width))))))
- (setenv "GROFF_NO_SGR" "1")
;; Since man-db 2.4.3-1, man writes plain text with no escape
;; sequences when stdout is not a tty. In 2.5.0, the following
;; env-var was added to allow control of this (see Debian Bug#340673).
@@ -1045,38 +1051,12 @@
(message "Please wait: formatting the %s man page..." Man-arguments)
(goto-char (point-min))
;; Fontify ANSI escapes.
- (let ((faces nil)
- (buffer-undo-list t)
- (start (point)))
- ;; http://www.isthe.com/chongo/tech/comp/ansi_escapes.html
- ;; suggests many codes, but we only handle:
- ;; ESC [ 00 m reset to normal display
- ;; ESC [ 01 m bold
- ;; ESC [ 04 m underline
- ;; ESC [ 07 m reverse-video
- ;; ESC [ 22 m no-bold
- ;; ESC [ 24 m no-underline
- ;; ESC [ 27 m no-reverse-video
- (while (re-search-forward "\e\\[0?\\([1470]\\|2\\([247]\\)\\)m" nil t)
- (if faces (put-text-property start (match-beginning 0) 'face
- (if (cdr faces) faces (car faces))))
- (setq faces
- (cond
- ((match-beginning 2)
- (delq (pcase (char-after (match-beginning 2))
- (?2 Man-overstrike-face)
- (?4 Man-underline-face)
- (?7 Man-reverse-face))
- faces))
- ((eq (char-after (match-beginning 1)) ?0) nil)
- (t
- (cons (pcase (char-after (match-beginning 1))
- (?1 Man-overstrike-face)
- (?4 Man-underline-face)
- (?7 Man-reverse-face))
- faces))))
- (delete-region (match-beginning 0) (match-end 0))
- (setq start (point))))
+ (let ((ansi-color-apply-face-function
+ (lambda (beg end face)
+ (when face
+ (put-text-property beg end 'face face))))
+ (ansi-color-map Man-ansi-color-map))
+ (ansi-color-apply-on-region (point-min) (point-max)))
;; Other highlighting.
(let ((buffer-undo-list t))
(if (< (buffer-size) (position-bytes (point-max)))
- bug#12147: 24.1.50; [PATCH] ansi-color for man,
Wolfgang Jenkner <=