GNU bug report logs - #12146
24.1.50; [PATCH] ANSI SGR parameters 22-27 for ansi-color

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 12146 in the body.
You can then email your comments to 12146 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
Cc: Alex Schroeder <alex <at> gnu.org>
Subject: 24.1.50; [PATCH] ANSI SGR parameters 22-27 for ansi-color
Date: Mon, 06 Aug 2012 15:43:51 +0200

This patch implements ANSI SGR parameters which turn off "graphic
rendition aspects" in the 1-7 range.  Part of the motivation for this
change is using ansi-color to render man pages, see the "ansi-color for
man" bug report (and patch) for more details.

The patch introduces an incompatible change (more or less behind the
scenes): Previously, the car of the ansi-color-context and
ansi-color-context-region variables contained a list of faces while it
now contains a list of ANSI SGR parameters instead (referred to in the
source as "codes"); this also affects the second argument passed to
ansi-color-apply-sequence.  This is because different parameters could
be mapped to the same face.  If they are both mapped to `default' this
already triggers a bug in the current version of ansi-color: In
a shell-mode buffer type

printf '\033[4mfoo\033[2mbar\033[m\n'

and note that "bar" is not underlined in the output (SGR parameter
2 "faint" is mapped to the `default' face and is therefore treated in
the same way as parameter 0).

I've run a simple test to check that the new code doesn't slow down
ansi-color, viz.

./emacs/src/emacs --batch -Q -l ./ansi-color-test.el

where ansi-color-test.el contains the form

(progn
  (require 'ansi-color)
  (garbage-collect)
  (let ((ansi-color-apply-face-function
	 (lambda (beg end face)
	   (when face
	     (put-text-property beg end 'face face))))
	(file "/tmp/ansi-color-test"))
    (with-temp-file file
      (shell-command "PAGER=cat MANPAGER=cat MAN_KEEP_FORMATTING=1 man bash"
		     (current-buffer)))
    (let ((time (current-time)))
      (dotimes (i 100)
	(with-temp-buffer
	  (insert-file file)
	  (ansi-color-apply-on-region (point-min) (point-max))))
      (message "%s" (time-subtract (current-time) time)))))


2012-08-02  Wolfgang Jenkner  <wjenkner <at> inode.at>

        Implement ANSI SGR parameters 22-27.
        * ansi-color.el (ansi-colors): Doc fix.
        (ansi-color-context, ansi-color-context-region): Doc fix.
        (ansi-color--find-face): New function.
        (ansi-color-apply, ansi-color-apply-on-region): Use it.  Rename
        the local variable `face' to `codes' since it is now a list of
        ansi codes.  Doc fix.
        (ansi-color-get-face): Remove.
        (ansi-color-parse-sequence): New function, derived from
        ansi-color-get-face.
        (ansi-color-apply-sequence): Use it.  Rewrite, and support ansi
        codes 22-27.


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/ansi-color.el'
--- lisp/ansi-color.el	2012-06-23 09:28:10 +0000
+++ lisp/ansi-color.el	2012-08-05 13:24:19 +0000
@@ -83,7 +83,7 @@
   "Translating SGR control sequences to faces.
 This translation effectively colorizes strings and regions based upon
 SGR control sequences embedded in the text.  SGR (Select Graphic
-Rendition) control sequences are defined in section 3.8.117 of the
+Rendition) control sequences are defined in section 8.3.117 of the
 ECMA-48 standard \(identical to ISO/IEC 6429), which is freely available
 as a PDF file <URL:http://www.ecma.ch/ecma1/STAND/ECMA-048.HTM>."
   :version "21.1"
@@ -236,9 +236,10 @@
 ;; Working with strings
 (defvar ansi-color-context nil
   "Context saved between two calls to `ansi-color-apply'.
-This is a list of the form (FACES FRAGMENT) or nil.  FACES is a list of
-faces the last call to `ansi-color-apply' ended with, and FRAGMENT is a
-string starting with an escape sequence, possibly the start of a new
+This is a list of the form (CODES FRAGMENT) or nil.  CODES
+represents the state the last call to `ansi-color-apply' ended
+with, currently a list of ansi codes, and FRAGMENT is a string
+starting with an escape sequence, possibly the start of a new
 escape sequence.")
 (make-variable-buffer-local 'ansi-color-context)
 
@@ -270,6 +271,20 @@
       (setq ansi-color-context (if fragment (list nil fragment))))
     result))
 
+(defun ansi-color--find-face (codes)
+  "Return the face corresponding to CODES."
+  (let (faces)
+    (while codes
+      (let ((face (ansi-color-get-face-1 (pop codes))))
+	;; In the (default underline) face, say, the value of the
+	;; "underline" attribute of the `default' face wins.
+	(unless (eq face 'default)
+	  (push face faces))))
+    ;; Avoid some long-lived conses in the common case.
+    (if (cdr faces)
+	(nreverse faces)
+      (car faces))))
+
 (defun ansi-color-apply (string)
   "Translates SGR control sequences into text properties.
 Delete all other control sequences without processing them.
@@ -280,12 +295,12 @@
 See function `ansi-color-apply-sequence' for details.
 
 Every call to this function will set and use the buffer-local variable
-`ansi-color-context' to save partial escape sequences and current face.
+`ansi-color-context' to save partial escape sequences and current ansi codes.
 This information will be used for the next call to `ansi-color-apply'.
 Set `ansi-color-context' to nil if you don't want this.
 
 This function can be added to `comint-preoutput-filter-functions'."
-  (let ((face (car ansi-color-context))
+  (let ((codes (car ansi-color-context))
 	(start 0) end escape-sequence result
 	colorized-substring)
     ;; If context was saved and is a string, prepend it.
@@ -296,8 +311,8 @@
     (while (setq end (string-match ansi-color-regexp string start))
       (setq escape-sequence (match-string 1 string))
       ;; Colorize the old block from start to end using old face.
-      (when face
-	(put-text-property start end 'font-lock-face face string))
+      (when codes
+	(put-text-property start end 'font-lock-face (ansi-color--find-face codes) string))
       (setq colorized-substring (substring string start end)
 	    start (match-end 0))
       ;; Eliminate unrecognized ANSI sequences.
@@ -306,10 +321,10 @@
 	      (replace-match "" nil nil colorized-substring)))
       (push colorized-substring result)
       ;; Create new face, by applying escape sequence parameters.
-      (setq face (ansi-color-apply-sequence escape-sequence face)))
+      (setq codes (ansi-color-apply-sequence escape-sequence codes)))
     ;; if the rest of the string should have a face, put it there
-    (when face
-      (put-text-property start (length string) 'font-lock-face face string))
+    (when codes
+      (put-text-property start (length string) 'font-lock-face (ansi-color--find-face codes) string))
     ;; save context, add the remainder of the string to the result
     (let (fragment)
       (if (string-match "\033" string start)
@@ -317,17 +332,18 @@
 	    (setq fragment (substring string pos))
 	    (push (substring string start pos) result))
 	(push (substring string start) result))
-      (setq ansi-color-context (if (or face fragment) (list face fragment))))
+      (setq ansi-color-context (if (or codes fragment) (list codes fragment))))
     (apply 'concat (nreverse result))))
 
 ;; Working with regions
 
 (defvar ansi-color-context-region nil
   "Context saved between two calls to `ansi-color-apply-on-region'.
-This is a list of the form (FACES MARKER) or nil.  FACES is a list of
-faces the last call to `ansi-color-apply-on-region' ended with, and
-MARKER is a buffer position within an escape sequence or the last
-position processed.")
+This is a list of the form (CODES MARKER) or nil.  CODES
+represents the state the last call to `ansi-color-apply-on-region'
+ended with, currently a list of ansi codes, and MARKER is a
+buffer position within an escape sequence or the last position
+processed.")
 (make-variable-buffer-local 'ansi-color-context-region)
 
 (defun ansi-color-filter-region (begin end)
@@ -365,13 +381,14 @@
 in `ansi-color-faces-vector' and `ansi-color-names-vector'.  See
 `ansi-color-apply-sequence' for details.
 
-Every call to this function will set and use the buffer-local variable
-`ansi-color-context-region' to save position and current face.  This
-information will be used for the next call to
-`ansi-color-apply-on-region'.  Specifically, it will override BEGIN, the
-start of the region and set the face with which to start.  Set
-`ansi-color-context-region' to nil if you don't want this."
-  (let ((face (car ansi-color-context-region))
+Every call to this function will set and use the buffer-local
+variable `ansi-color-context-region' to save position and current
+ansi codes.  This information will be used for the next call to
+`ansi-color-apply-on-region'.  Specifically, it will override
+BEGIN, the start of the region and set the face with which to
+start.  Set `ansi-color-context-region' to nil if you don't want
+this."
+  (let ((codes (car ansi-color-context-region))
 	(start-marker (or (cadr ansi-color-context-region)
 			  (copy-marker begin)))
 	(end-marker (copy-marker end))
@@ -388,28 +405,27 @@
 	;; Colorize the old block from start to end using old face.
 	(funcall ansi-color-apply-face-function
 		 start-marker (match-beginning 0)
-		 face)
+		 (ansi-color--find-face codes))
         ;; store escape sequence and new start position
         (setq escape-sequence (match-string 1)
 	      start-marker (copy-marker (match-end 0)))
 	;; delete the escape sequence
 	(replace-match "")
-	;; create new face by applying all the parameters in the escape
-	;; sequence
-	(setq face (ansi-color-apply-sequence escape-sequence face)))
+	;; Update the list of ansi codes.
+	(setq codes (ansi-color-apply-sequence escape-sequence codes)))
       ;; search for the possible start of a new escape sequence
       (if (re-search-forward "\033" end-marker t)
 	  (progn
 	    ;; if the rest of the region should have a face, put it there
 	    (funcall ansi-color-apply-face-function
-		     start-marker (point) face)
-	    ;; save face and point
+		     start-marker (point) (ansi-color--find-face codes))
+	    ;; save codes and point
 	    (setq ansi-color-context-region
-		  (list face (copy-marker (match-beginning 0)))))
+		  (list codes (copy-marker (match-beginning 0)))))
 	;; if the rest of the region should have a face, put it there
 	(funcall ansi-color-apply-face-function
-		 start-marker end-marker face)
-	(setq ansi-color-context-region (if face (list face)))))))
+		 start-marker end-marker (ansi-color--find-face codes))
+	(setq ansi-color-context-region (if codes (list codes)))))))
 
 (defun ansi-color-apply-overlay-face (beg end face)
   "Make an overlay from BEG to END, and apply face FACE.
@@ -497,32 +513,56 @@
 
 ;; Helper functions
 
-(defun ansi-color-apply-sequence (escape-sequence faces)
-  "Apply ESCAPE-SEQ to FACES and return the new list of faces.
-
-ESCAPE-SEQ is an escape sequences parsed by `ansi-color-get-face'.
-
-If the new faces start with the symbol `default', then the new
-faces are returned.  If the faces start with something else,
-they are appended to the front of the FACES list, and the new
-list of faces is returned.
-
-If `ansi-color-get-face' returns nil, then we either got a
-null-sequence, or we stumbled upon some garbage.  In either
-case we return nil."
-  (let ((new-faces (ansi-color-get-face escape-sequence)))
-    (cond ((null new-faces)
-	   nil)
-	  ((eq (car new-faces) 'default)
-	   (cdr new-faces))
-	  (t
-	   ;; Like (append NEW-FACES FACES)
-	   ;; but delete duplicates in FACES.
-	   (let ((modified-faces (copy-sequence faces)))
-	     (dolist (face (nreverse new-faces))
-	       (setq modified-faces (delete face modified-faces))
-	       (push face modified-faces))
-	     modified-faces)))))
+(defsubst ansi-color-parse-sequence (escape-seq)
+  "Return the list of all the parameters in ESCAPE-SEQ.
+
+ESCAPE-SEQ is a SGR control sequences such as \\033[34m.  The parameter
+34 is used by `ansi-color-get-face-1' to return a face definition.
+
+Returns nil only if there's no match for `ansi-color-parameter-regexp'."
+  (let ((i 0)
+	codes val)
+    (while (string-match ansi-color-parameter-regexp escape-seq i)
+      (setq i (match-end 0)
+	    val (string-to-number (match-string 1 escape-seq) 10))
+      ;; It so happens that (string-to-number "") => 0.
+      (push val codes))
+    (nreverse codes)))
+
+(defun ansi-color-apply-sequence (escape-sequence codes)
+  "Apply ESCAPE-SEQ to CODES and return the new list of codes.
+
+ESCAPE-SEQ is an escape sequence parsed by `ansi-color-parse-sequence'.
+
+If the new codes resulting from ESCAPE-SEQ start with 0, then the
+old codes are discarded and the remaining new codes are
+processed.  Otherwise, for each new code: if it is 21-25 or 27-29
+delete appropriate parameters from the list of codes; any other
+code that makes sense is added to the list of codes.  Finally,
+the so changed list of codes is returned."
+  (let ((new-codes (ansi-color-parse-sequence escape-sequence)))
+    (while new-codes
+      (setq codes
+	    (let ((new (pop new-codes)))
+	      (cond ((zerop new)
+		     nil)
+		    ((or (<= new 20)
+			 (>= new 30))
+		     (if (memq new codes)
+			 codes
+		       (cons new codes)))
+		    ;; The standard says `21 doubly underlined' while
+		    ;; http://en.wikipedia.org/wiki/ANSI_escape_code claims
+		    ;; `21 Bright/Bold: off or Underline: Double'.
+		    ((/= new 26)
+		     (remq (- new 20)
+			   (cond ((= new 22)
+				  (remq 1 codes))
+				 ((= new 25)
+				  (remq 6 codes))
+				 (t codes))))
+		    (t codes)))))
+    codes))
 
 (defun ansi-color-make-color-map ()
   "Creates a vector of face definitions and returns it.
@@ -588,28 +628,6 @@
       (aref ansi-color-map ansi-code)
     (args-out-of-range nil)))
 
-(defun ansi-color-get-face (escape-seq)
-  "Create a new face by applying all the parameters in ESCAPE-SEQ.
-
-Should any of the parameters result in the default face (usually this is
-the parameter 0), then the effect of all previous parameters is canceled.
-
-ESCAPE-SEQ is a SGR control sequences such as \\033[34m.  The parameter
-34 is used by `ansi-color-get-face-1' to return a face definition."
-  (let ((i 0)
-        f val)
-    (while (string-match ansi-color-parameter-regexp escape-seq i)
-      (setq i (match-end 0)
-	    val (ansi-color-get-face-1
-		 (string-to-number (match-string 1 escape-seq) 10)))
-      (cond ((not val))
-	    ((eq val 'default)
-	     (setq f (list val)))
-	    (t
-	     (unless (member val f)
-	       (push val f)))))
-    f))
-
 (provide 'ansi-color)
 
 ;;; ansi-color.el ends here

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

From: Stefan Monnier <monnier <at> iro.umontreal.ca>
To: Wolfgang Jenkner <wjenkner <at> inode.at>
Cc: Alex Schroeder <alex <at> gnu.org>, 12146-done <at> debbugs.gnu.org
Subject: Re: bug#12146: 24.1.50;
	[PATCH] ANSI SGR parameters 22-27 for ansi-color
Date: Tue, 14 Aug 2012 23:34:20 -0400

Thanks, installed,


        Stefan


>>>>> "Wolfgang" == Wolfgang Jenkner <wjenkner <at> inode.at> writes:

> This patch implements ANSI SGR parameters which turn off "graphic
> rendition aspects" in the 1-7 range.  Part of the motivation for this
> change is using ansi-color to render man pages, see the "ansi-color for
> man" bug report (and patch) for more details.

> The patch introduces an incompatible change (more or less behind the
> scenes): Previously, the car of the ansi-color-context and
> ansi-color-context-region variables contained a list of faces while it
> now contains a list of ANSI SGR parameters instead (referred to in the
> source as "codes"); this also affects the second argument passed to
> ansi-color-apply-sequence.  This is because different parameters could
> be mapped to the same face.  If they are both mapped to `default' this
> already triggers a bug in the current version of ansi-color: In
> a shell-mode buffer type

> printf '\033[4mfoo\033[2mbar\033[m\n'

> and note that "bar" is not underlined in the output (SGR parameter
> 2 "faint" is mapped to the `default' face and is therefore treated in
> the same way as parameter 0).

> I've run a simple test to check that the new code doesn't slow down
> ansi-color, viz.

> ./emacs/src/emacs --batch -Q -l ./ansi-color-test.el

> where ansi-color-test.el contains the form

> (progn
>   (require 'ansi-color)
>   (garbage-collect)
>   (let ((ansi-color-apply-face-function
> 	 (lambda (beg end face)
> 	   (when face
> 	     (put-text-property beg end 'face face))))
> 	(file "/tmp/ansi-color-test"))
>     (with-temp-file file
>       (shell-command "PAGER=cat MANPAGER=cat MAN_KEEP_FORMATTING=1 man bash"
> 		     (current-buffer)))
>     (let ((time (current-time)))
>       (dotimes (i 100)
> 	(with-temp-buffer
> 	  (insert-file file)
> 	  (ansi-color-apply-on-region (point-min) (point-max))))
>       (message "%s" (time-subtract (current-time) time)))))


> 2012-08-02  Wolfgang Jenkner  <wjenkner <at> inode.at>

>         Implement ANSI SGR parameters 22-27.
>         * ansi-color.el (ansi-colors): Doc fix.
>         (ansi-color-context, ansi-color-context-region): Doc fix.
>         (ansi-color--find-face): New function.
>         (ansi-color-apply, ansi-color-apply-on-region): Use it.  Rename
>         the local variable `face' to `codes' since it is now a list of
>         ansi codes.  Doc fix.
>         (ansi-color-get-face): Remove.
>         (ansi-color-parse-sequence): New function, derived from
>         ansi-color-get-face.
>         (ansi-color-apply-sequence): Use it.  Rewrite, and support ansi
>         codes 22-27.


> 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/ansi-color.el'
> --- lisp/ansi-color.el	2012-06-23 09:28:10 +0000
> +++ lisp/ansi-color.el	2012-08-05 13:24:19 +0000
> @@ -83,7 +83,7 @@
>    "Translating SGR control sequences to faces.
>  This translation effectively colorizes strings and regions based upon
>  SGR control sequences embedded in the text.  SGR (Select Graphic
> -Rendition) control sequences are defined in section 3.8.117 of the
> +Rendition) control sequences are defined in section 8.3.117 of the
>  ECMA-48 standard \(identical to ISO/IEC 6429), which is freely available
>  as a PDF file <URL:http://www.ecma.ch/ecma1/STAND/ECMA-048.HTM>."
>    :version "21.1"
> @@ -236,9 +236,10 @@
>  ;; Working with strings
>  (defvar ansi-color-context nil
>    "Context saved between two calls to `ansi-color-apply'.
> -This is a list of the form (FACES FRAGMENT) or nil.  FACES is a list of
> -faces the last call to `ansi-color-apply' ended with, and FRAGMENT is a
> -string starting with an escape sequence, possibly the start of a new
> +This is a list of the form (CODES FRAGMENT) or nil.  CODES
> +represents the state the last call to `ansi-color-apply' ended
> +with, currently a list of ansi codes, and FRAGMENT is a string
> +starting with an escape sequence, possibly the start of a new
>  escape sequence.")
>  (make-variable-buffer-local 'ansi-color-context)
 
> @@ -270,6 +271,20 @@
>        (setq ansi-color-context (if fragment (list nil fragment))))
>      result))
 
> +(defun ansi-color--find-face (codes)
> +  "Return the face corresponding to CODES."
> +  (let (faces)
> +    (while codes
> +      (let ((face (ansi-color-get-face-1 (pop codes))))
> +	;; In the (default underline) face, say, the value of the
> +	;; "underline" attribute of the `default' face wins.
> +	(unless (eq face 'default)
> +	  (push face faces))))
> +    ;; Avoid some long-lived conses in the common case.
> +    (if (cdr faces)
> +	(nreverse faces)
> +      (car faces))))
> +
>  (defun ansi-color-apply (string)
>    "Translates SGR control sequences into text properties.
>  Delete all other control sequences without processing them.
> @@ -280,12 +295,12 @@
>  See function `ansi-color-apply-sequence' for details.
 
>  Every call to this function will set and use the buffer-local variable
> -`ansi-color-context' to save partial escape sequences and current face.
> +`ansi-color-context' to save partial escape sequences and current ansi codes.
>  This information will be used for the next call to `ansi-color-apply'.
>  Set `ansi-color-context' to nil if you don't want this.
 
>  This function can be added to `comint-preoutput-filter-functions'."
> -  (let ((face (car ansi-color-context))
> +  (let ((codes (car ansi-color-context))
>  	(start 0) end escape-sequence result
>  	colorized-substring)
>      ;; If context was saved and is a string, prepend it.
> @@ -296,8 +311,8 @@
>      (while (setq end (string-match ansi-color-regexp string start))
>        (setq escape-sequence (match-string 1 string))
>        ;; Colorize the old block from start to end using old face.
> -      (when face
> -	(put-text-property start end 'font-lock-face face string))
> +      (when codes
> +	(put-text-property start end 'font-lock-face (ansi-color--find-face codes) string))
>        (setq colorized-substring (substring string start end)
>  	    start (match-end 0))
>        ;; Eliminate unrecognized ANSI sequences.
> @@ -306,10 +321,10 @@
>  	      (replace-match "" nil nil colorized-substring)))
>        (push colorized-substring result)
>        ;; Create new face, by applying escape sequence parameters.
> -      (setq face (ansi-color-apply-sequence escape-sequence face)))
> +      (setq codes (ansi-color-apply-sequence escape-sequence codes)))
>      ;; if the rest of the string should have a face, put it there
> -    (when face
> -      (put-text-property start (length string) 'font-lock-face face string))
> +    (when codes
> +      (put-text-property start (length string) 'font-lock-face (ansi-color--find-face codes) string))
>      ;; save context, add the remainder of the string to the result
>      (let (fragment)
>        (if (string-match "\033" string start)
> @@ -317,17 +332,18 @@
>  	    (setq fragment (substring string pos))
>  	    (push (substring string start pos) result))
>  	(push (substring string start) result))
> -      (setq ansi-color-context (if (or face fragment) (list face fragment))))
> +      (setq ansi-color-context (if (or codes fragment) (list codes fragment))))
>      (apply 'concat (nreverse result))))
 
>  ;; Working with regions
 
>  (defvar ansi-color-context-region nil
>    "Context saved between two calls to `ansi-color-apply-on-region'.
> -This is a list of the form (FACES MARKER) or nil.  FACES is a list of
> -faces the last call to `ansi-color-apply-on-region' ended with, and
> -MARKER is a buffer position within an escape sequence or the last
> -position processed.")
> +This is a list of the form (CODES MARKER) or nil.  CODES
> +represents the state the last call to `ansi-color-apply-on-region'
> +ended with, currently a list of ansi codes, and MARKER is a
> +buffer position within an escape sequence or the last position
> +processed.")
>  (make-variable-buffer-local 'ansi-color-context-region)
 
>  (defun ansi-color-filter-region (begin end)
> @@ -365,13 +381,14 @@
>  in `ansi-color-faces-vector' and `ansi-color-names-vector'.  See
>  `ansi-color-apply-sequence' for details.
 
> -Every call to this function will set and use the buffer-local variable
> -`ansi-color-context-region' to save position and current face.  This
> -information will be used for the next call to
> -`ansi-color-apply-on-region'.  Specifically, it will override BEGIN, the
> -start of the region and set the face with which to start.  Set
> -`ansi-color-context-region' to nil if you don't want this."
> -  (let ((face (car ansi-color-context-region))
> +Every call to this function will set and use the buffer-local
> +variable `ansi-color-context-region' to save position and current
> +ansi codes.  This information will be used for the next call to
> +`ansi-color-apply-on-region'.  Specifically, it will override
> +BEGIN, the start of the region and set the face with which to
> +start.  Set `ansi-color-context-region' to nil if you don't want
> +this."
> +  (let ((codes (car ansi-color-context-region))
>  	(start-marker (or (cadr ansi-color-context-region)
>  			  (copy-marker begin)))
>  	(end-marker (copy-marker end))
> @@ -388,28 +405,27 @@
>  	;; Colorize the old block from start to end using old face.
>  	(funcall ansi-color-apply-face-function
>  		 start-marker (match-beginning 0)
> -		 face)
> +		 (ansi-color--find-face codes))
>          ;; store escape sequence and new start position
>          (setq escape-sequence (match-string 1)
>  	      start-marker (copy-marker (match-end 0)))
>  	;; delete the escape sequence
>  	(replace-match "")
> -	;; create new face by applying all the parameters in the escape
> -	;; sequence
> -	(setq face (ansi-color-apply-sequence escape-sequence face)))
> +	;; Update the list of ansi codes.
> +	(setq codes (ansi-color-apply-sequence escape-sequence codes)))
>        ;; search for the possible start of a new escape sequence
>        (if (re-search-forward "\033" end-marker t)
>  	  (progn
>  	    ;; if the rest of the region should have a face, put it there
>  	    (funcall ansi-color-apply-face-function
> -		     start-marker (point) face)
> -	    ;; save face and point
> +		     start-marker (point) (ansi-color--find-face codes))
> +	    ;; save codes and point
>  	    (setq ansi-color-context-region
> -		  (list face (copy-marker (match-beginning 0)))))
> +		  (list codes (copy-marker (match-beginning 0)))))
>  	;; if the rest of the region should have a face, put it there
>  	(funcall ansi-color-apply-face-function
> -		 start-marker end-marker face)
> -	(setq ansi-color-context-region (if face (list face)))))))
> +		 start-marker end-marker (ansi-color--find-face codes))
> +	(setq ansi-color-context-region (if codes (list codes)))))))
 
>  (defun ansi-color-apply-overlay-face (beg end face)
>    "Make an overlay from BEG to END, and apply face FACE.
> @@ -497,32 +513,56 @@
 
>  ;; Helper functions
 
> -(defun ansi-color-apply-sequence (escape-sequence faces)
> -  "Apply ESCAPE-SEQ to FACES and return the new list of faces.
> -
> -ESCAPE-SEQ is an escape sequences parsed by `ansi-color-get-face'.
> -
> -If the new faces start with the symbol `default', then the new
> -faces are returned.  If the faces start with something else,
> -they are appended to the front of the FACES list, and the new
> -list of faces is returned.
> -
> -If `ansi-color-get-face' returns nil, then we either got a
> -null-sequence, or we stumbled upon some garbage.  In either
> -case we return nil."
> -  (let ((new-faces (ansi-color-get-face escape-sequence)))
> -    (cond ((null new-faces)
> -	   nil)
> -	  ((eq (car new-faces) 'default)
> -	   (cdr new-faces))
> -	  (t
> -	   ;; Like (append NEW-FACES FACES)
> -	   ;; but delete duplicates in FACES.
> -	   (let ((modified-faces (copy-sequence faces)))
> -	     (dolist (face (nreverse new-faces))
> -	       (setq modified-faces (delete face modified-faces))
> -	       (push face modified-faces))
> -	     modified-faces)))))
> +(defsubst ansi-color-parse-sequence (escape-seq)
> +  "Return the list of all the parameters in ESCAPE-SEQ.
> +
> +ESCAPE-SEQ is a SGR control sequences such as \\033[34m.  The parameter
> +34 is used by `ansi-color-get-face-1' to return a face definition.
> +
> +Returns nil only if there's no match for `ansi-color-parameter-regexp'."
> +  (let ((i 0)
> +	codes val)
> +    (while (string-match ansi-color-parameter-regexp escape-seq i)
> +      (setq i (match-end 0)
> +	    val (string-to-number (match-string 1 escape-seq) 10))
> +      ;; It so happens that (string-to-number "") => 0.
> +      (push val codes))
> +    (nreverse codes)))
> +
> +(defun ansi-color-apply-sequence (escape-sequence codes)
> +  "Apply ESCAPE-SEQ to CODES and return the new list of codes.
> +
> +ESCAPE-SEQ is an escape sequence parsed by `ansi-color-parse-sequence'.
> +
> +If the new codes resulting from ESCAPE-SEQ start with 0, then the
> +old codes are discarded and the remaining new codes are
> +processed.  Otherwise, for each new code: if it is 21-25 or 27-29
> +delete appropriate parameters from the list of codes; any other
> +code that makes sense is added to the list of codes.  Finally,
> +the so changed list of codes is returned."
> +  (let ((new-codes (ansi-color-parse-sequence escape-sequence)))
> +    (while new-codes
> +      (setq codes
> +	    (let ((new (pop new-codes)))
> +	      (cond ((zerop new)
> +		     nil)
> +		    ((or (<= new 20)
> +			 (>= new 30))
> +		     (if (memq new codes)
> +			 codes
> +		       (cons new codes)))
> +		    ;; The standard says `21 doubly underlined' while
> +		    ;; http://en.wikipedia.org/wiki/ANSI_escape_code claims
> +		    ;; `21 Bright/Bold: off or Underline: Double'.
> +		    ((/= new 26)
> +		     (remq (- new 20)
> +			   (cond ((= new 22)
> +				  (remq 1 codes))
> +				 ((= new 25)
> +				  (remq 6 codes))
> +				 (t codes))))
> +		    (t codes)))))
> +    codes))
 
>  (defun ansi-color-make-color-map ()
>    "Creates a vector of face definitions and returns it.
> @@ -588,28 +628,6 @@
>        (aref ansi-color-map ansi-code)
>      (args-out-of-range nil)))
 
> -(defun ansi-color-get-face (escape-seq)
> -  "Create a new face by applying all the parameters in ESCAPE-SEQ.
> -
> -Should any of the parameters result in the default face (usually this is
> -the parameter 0), then the effect of all previous parameters is canceled.
> -
> -ESCAPE-SEQ is a SGR control sequences such as \\033[34m.  The parameter
> -34 is used by `ansi-color-get-face-1' to return a face definition."
> -  (let ((i 0)
> -        f val)
> -    (while (string-match ansi-color-parameter-regexp escape-seq i)
> -      (setq i (match-end 0)
> -	    val (ansi-color-get-face-1
> -		 (string-to-number (match-string 1 escape-seq) 10)))
> -      (cond ((not val))
> -	    ((eq val 'default)
> -	     (setq f (list val)))
> -	    (t
> -	     (unless (member val f)
> -	       (push val f)))))
> -    f))
> -
>  (provide 'ansi-color)
 
>  ;;; ansi-color.el ends here

Previous Next

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