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

Previous Next

Package: emacs;

Reported by: Wolfgang Jenkner <wjenkner <at> inode.at>

Date: Mon, 6 Aug 2012 15:23:02 UTC

Severity: normal

Tags: patch

Found in version 24.1.50

Done: Stefan Monnier <monnier <at> iro.umontreal.ca>

Bug is archived. No further changes may be made.

Full log


View this message in rfc822 format

From: help-debbugs <at> gnu.org (GNU bug Tracking System)
To: Wolfgang Jenkner <wjenkner <at> inode.at>
Subject: bug#12147: closed (Re: bug#12147: 24.1.50; [PATCH] ansi-color for
 man)
Date: Wed, 15 Aug 2012 03:47:01 +0000
[Message part 1 (text/plain, inline)]
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 12147 <at> debbugs.gnu.org.

-- 
12147: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=12147
GNU Bug Tracking System
Contact help-debbugs <at> gnu.org with problems
[Message part 2 (message/rfc822, inline)]
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

[Message part 3 (message/rfc822, inline)]
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)))





This bug report was last modified 13 years ago.

Previous Next


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