GNU bug report logs - #12147
24.1.50; [PATCH] ansi-color for man

Previous Next

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 12147 in the body.
You can then email your comments to 12147 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Wolfgang Jenkner <wjenkner <at> inode.at>
To: bug-gnu-emacs <at> gnu.org
Subject: 24.1.50; [PATCH] ansi-color for man
Date: Mon, 06 Aug 2012 17:10:52 +0200

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 <at> 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)))

Message #10 received at 12147-done <at> debbugs.gnu.org (full text, mbox):

From: Stefan Monnier <monnier <at> iro.umontreal.ca>
To: Wolfgang Jenkner <wjenkner <at> inode.at>
Cc: 12147-done <at> debbugs.gnu.org
Subject: Re: bug#12147: 24.1.50; [PATCH] ansi-color for man
Date: Tue, 14 Aug 2012 23:37:26 -0400

Thanks, installed,


        Stefan

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.