From unknown Tue Sep 09 18:21:50 2025 X-Loop: help-debbugs@gnu.org Subject: bug#12147: 24.1.50; [PATCH] ansi-color for man Resent-From: Wolfgang Jenkner Original-Sender: debbugs-submit-bounces@debbugs.gnu.org Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Mon, 06 Aug 2012 15:23:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 12147 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch To: 12147@debbugs.gnu.org X-Debbugs-Original-To: bug-gnu-emacs@gnu.org Received: via spool by submit@debbugs.gnu.org id=B.134426655128469 (code B ref -1); Mon, 06 Aug 2012 15:23:02 +0000 Received: (at submit) by debbugs.gnu.org; 6 Aug 2012 15:22:31 +0000 Received: from localhost ([127.0.0.1]:37676 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.72) (envelope-from ) id 1SyP8Y-0007P5-6e for submit@debbugs.gnu.org; Mon, 06 Aug 2012 11:22:30 -0400 Received: from eggs.gnu.org ([208.118.235.92]:33802) by debbugs.gnu.org with esmtp (Exim 4.72) (envelope-from ) id 1SyP8V-0007Ox-DR for submit@debbugs.gnu.org; Mon, 06 Aug 2012 11:22:29 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1SyP0n-0001Og-Fw for submit@debbugs.gnu.org; Mon, 06 Aug 2012 11:14:33 -0400 X-Spam-Checker-Version: SpamAssassin 3.3.2 (2011-06-06) on eggs.gnu.org X-Spam-Level: X-Spam-Status: No, score=-6.9 required=5.0 tests=BAYES_00,RCVD_IN_DNSWL_HI autolearn=unavailable version=3.3.2 Received: from lists.gnu.org ([208.118.235.17]:52337) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1SyP0n-0001Oa-C6 for submit@debbugs.gnu.org; Mon, 06 Aug 2012 11:14:29 -0400 Received: from eggs.gnu.org ([208.118.235.92]:49538) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1SyP0i-0007Kx-Ht for bug-gnu-emacs@gnu.org; Mon, 06 Aug 2012 11:14:29 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1SyP0g-0001MD-DW for bug-gnu-emacs@gnu.org; Mon, 06 Aug 2012 11:14:24 -0400 Received: from mx10.lb01.inode.at ([62.99.145.10]:2263 helo=mx.inode.at) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1SyP0f-0001Ll-V8 for bug-gnu-emacs@gnu.org; Mon, 06 Aug 2012 11:14:22 -0400 Received: from [91.119.101.188] (port=8279 helo=iznogoud.viz) by smartmx-10.inode.at with esmtps (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.69) (envelope-from ) id 1SyP0e-0000ht-IW for bug-gnu-emacs@gnu.org; Mon, 06 Aug 2012 17:14:20 +0200 Received: from wolfgang by iznogoud.viz with local (Exim 4.80 (FreeBSD)) (envelope-from ) id 1SyP0d-0006N0-C1 for bug-gnu-emacs@gnu.org; Mon, 06 Aug 2012 17:14:19 +0200 From: Wolfgang Jenkner Date: Mon, 06 Aug 2012 17:10:52 +0200 Message-ID: <85vcgwf3xw.fsf@iznogoud.viz> User-Agent: Gnus/5.130006 (Ma Gnus v0.6) Emacs/24.1.50 (berkeley-unix) MIME-Version: 1.0 Content-Type: text/plain X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6, seldom 2.4 (older, 4) X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6 (newer, 3) X-Received-From: 208.118.235.17 X-Spam-Score: -6.9 (------) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.13 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Sender: debbugs-submit-bounces@debbugs.gnu.org Errors-To: debbugs-submit-bounces@debbugs.gnu.org X-Spam-Score: -6.9 (------) 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 * 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))) From unknown Tue Sep 09 18:21:50 2025 MIME-Version: 1.0 X-Mailer: MIME-tools 5.428 (Entity 5.428) X-Loop: help-debbugs@gnu.org From: help-debbugs@gnu.org (GNU bug Tracking System) To: Wolfgang Jenkner Subject: bug#12147: closed (Re: bug#12147: 24.1.50; [PATCH] ansi-color for man) Message-ID: References: <85vcgwf3xw.fsf@iznogoud.viz> X-Gnu-PR-Message: they-closed 12147 X-Gnu-PR-Package: emacs X-Gnu-PR-Keywords: patch Reply-To: 12147@debbugs.gnu.org Date: Wed, 15 Aug 2012 03:47:01 +0000 Content-Type: multipart/mixed; boundary="----------=_1345002421-21327-1" This is a multi-part message in MIME format... ------------=_1345002421-21327-1 Content-Disposition: inline Content-Transfer-Encoding: quoted-printable Content-Type: text/plain; charset="utf-8" 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@debbugs.gnu.org. --=20 12147: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=3D12147 GNU Bug Tracking System Contact help-debbugs@gnu.org with problems ------------=_1345002421-21327-1 Content-Type: message/rfc822 Content-Disposition: inline Content-Transfer-Encoding: 7bit Received: (at 12147-done) by debbugs.gnu.org; 15 Aug 2012 03:46:09 +0000 Received: from localhost ([127.0.0.1]:57428 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.72) (envelope-from ) id 1T1UYb-0005Wx-6G for submit@debbugs.gnu.org; Tue, 14 Aug 2012 23:46:09 -0400 Received: from ironport2-out.teksavvy.com ([206.248.154.182]:34230) by debbugs.gnu.org with esmtp (Exim 4.72) (envelope-from ) id 1T1UYa-0005Wr-K7 for 12147-done@debbugs.gnu.org; Tue, 14 Aug 2012 23:46:08 -0400 X-IronPort-Anti-Spam-Filtered: true X-IronPort-Anti-Spam-Result: Ai0FAG6Zu09MCqqR/2dsb2JhbABEsEiDSYEIghEFAQUZPSMQCw4mEhQYDSSFXAeCKBa6CZBEA6MzgViDBQ X-IronPort-AV: E=Sophos;i="4.75,637,1330923600"; d="scan'208";a="195711579" Received: from 76-10-170-145.dsl.teksavvy.com (HELO fmsmemgm.homelinux.net) ([76.10.170.145]) by ironport2-out.teksavvy.com with ESMTP/TLS/ADH-AES256-SHA; 14 Aug 2012 23:37:26 -0400 Received: by fmsmemgm.homelinux.net (Postfix, from userid 20848) id 36340AE2F6; Tue, 14 Aug 2012 23:37:26 -0400 (EDT) From: Stefan Monnier To: Wolfgang Jenkner Subject: Re: bug#12147: 24.1.50; [PATCH] ansi-color for man Message-ID: References: <85vcgwf3xw.fsf@iznogoud.viz> Date: Tue, 14 Aug 2012 23:37:26 -0400 In-Reply-To: <85vcgwf3xw.fsf@iznogoud.viz> (Wolfgang Jenkner's message of "Mon, 06 Aug 2012 17:10:52 +0200") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.1.50 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain X-Spam-Score: -1.9 (-) X-Debbugs-Envelope-To: 12147-done Cc: 12147-done@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.13 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Sender: debbugs-submit-bounces@debbugs.gnu.org Errors-To: debbugs-submit-bounces@debbugs.gnu.org X-Spam-Score: -1.9 (-) Thanks, installed, Stefan ------------=_1345002421-21327-1 Content-Type: message/rfc822 Content-Disposition: inline Content-Transfer-Encoding: 7bit Received: (at submit) by debbugs.gnu.org; 6 Aug 2012 15:22:31 +0000 Received: from localhost ([127.0.0.1]:37676 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.72) (envelope-from ) id 1SyP8Y-0007P5-6e for submit@debbugs.gnu.org; Mon, 06 Aug 2012 11:22:30 -0400 Received: from eggs.gnu.org ([208.118.235.92]:33802) by debbugs.gnu.org with esmtp (Exim 4.72) (envelope-from ) id 1SyP8V-0007Ox-DR for submit@debbugs.gnu.org; Mon, 06 Aug 2012 11:22:29 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1SyP0n-0001Og-Fw for submit@debbugs.gnu.org; Mon, 06 Aug 2012 11:14:33 -0400 X-Spam-Checker-Version: SpamAssassin 3.3.2 (2011-06-06) on eggs.gnu.org X-Spam-Level: X-Spam-Status: No, score=-6.9 required=5.0 tests=BAYES_00,RCVD_IN_DNSWL_HI autolearn=unavailable version=3.3.2 Received: from lists.gnu.org ([208.118.235.17]:52337) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1SyP0n-0001Oa-C6 for submit@debbugs.gnu.org; Mon, 06 Aug 2012 11:14:29 -0400 Received: from eggs.gnu.org ([208.118.235.92]:49538) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1SyP0i-0007Kx-Ht for bug-gnu-emacs@gnu.org; Mon, 06 Aug 2012 11:14:29 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1SyP0g-0001MD-DW for bug-gnu-emacs@gnu.org; Mon, 06 Aug 2012 11:14:24 -0400 Received: from mx10.lb01.inode.at ([62.99.145.10]:2263 helo=mx.inode.at) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1SyP0f-0001Ll-V8 for bug-gnu-emacs@gnu.org; Mon, 06 Aug 2012 11:14:22 -0400 Received: from [91.119.101.188] (port=8279 helo=iznogoud.viz) by smartmx-10.inode.at with esmtps (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.69) (envelope-from ) id 1SyP0e-0000ht-IW for bug-gnu-emacs@gnu.org; Mon, 06 Aug 2012 17:14:20 +0200 Received: from wolfgang by iznogoud.viz with local (Exim 4.80 (FreeBSD)) (envelope-from ) id 1SyP0d-0006N0-C1 for bug-gnu-emacs@gnu.org; Mon, 06 Aug 2012 17:14:19 +0200 From: Wolfgang Jenkner To: bug-gnu-emacs@gnu.org Subject: 24.1.50; [PATCH] ansi-color for man Date: Mon, 06 Aug 2012 17:10:52 +0200 Message-ID: <85vcgwf3xw.fsf@iznogoud.viz> User-Agent: Gnus/5.130006 (Ma Gnus v0.6) Emacs/24.1.50 (berkeley-unix) MIME-Version: 1.0 Content-Type: text/plain X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6, seldom 2.4 (older, 4) X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6 (newer, 3) X-Received-From: 208.118.235.17 X-Spam-Score: -6.9 (------) X-Debbugs-Envelope-To: submit X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.13 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Sender: debbugs-submit-bounces@debbugs.gnu.org Errors-To: debbugs-submit-bounces@debbugs.gnu.org X-Spam-Score: -6.9 (------) 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 * 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))) ------------=_1345002421-21327-1--