Subject: bug#12147: closed (Re: bug#12147: 24.1.50; [PATCH] ansi-color for man)

From: [email-masked] (GNU bug Tracking System)
Date: Wed, 15 Aug 2012 03:47:01 +0000

Your bug report

#12147: 24.1.50; [PATCH] ansi-color for man

which was filed against the emacs package, has been closed.

The explanation is attached below, along with your original report.
If you require more details, please reply to [email-masked].

-- 
12147: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=12147
GNU Bug Tracking System
Contact [email-masked] with problems

Subject: Re: bug#12147: 24.1.50; [PATCH] ansi-color for man
From: Stefan Monnier <[email-masked]>
To: Wolfgang Jenkner <[email-masked]>
Cc: [email-masked]
Date: Tue, 14 Aug 2012 23:37:26 -0400
List-Id: <debbugs-submit.debbugs.gnu.org>

Thanks, installed,

        Stefan

Subject: 24.1.50; [PATCH] ansi-color for man
From: Wolfgang Jenkner <[email-masked]>
To: [email-masked]
Date: Mon, 06 Aug 2012 17:10:52 +0200
List-Id: <debbugs-submit.debbugs.gnu.org>

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  <[email-masked]>

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