emacs-bug-tracker
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[debbugs-tracker] bug#12146: closed (24.1.50; [PATCH] ANSI SGR parameter


From: GNU bug Tracking System
Subject: [debbugs-tracker] bug#12146: closed (24.1.50; [PATCH] ANSI SGR parameters 22-27 for ansi-color)
Date: Wed, 15 Aug 2012 03:44:02 +0000

Your message dated Tue, 14 Aug 2012 23:34:20 -0400
with message-id <address@hidden>
and subject line Re: bug#12146: 24.1.50; [PATCH] ANSI SGR parameters 22-27 for 
ansi-color
has caused the debbugs.gnu.org bug report #12146,
regarding 24.1.50; [PATCH] ANSI SGR parameters 22-27 for ansi-color
to be marked as done.

(If you believe you have received this mail in error, please contact
address@hidden)


-- 
12146: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=12146
GNU Bug Tracking System
Contact address@hidden with problems
--- Begin Message --- Subject: 24.1.50; [PATCH] ANSI SGR parameters 22-27 for ansi-color Date: Mon, 06 Aug 2012 15:43:51 +0200 User-agent: Gnus/5.130006 (Ma Gnus v0.6) Emacs/24.1.50 (berkeley-unix)
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  <address@hidden>

        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





--- End Message ---
--- Begin Message --- 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 User-agent: Gnus/5.13 (Gnus v5.13) Emacs/24.1.50 (gnu/linux)
Thanks, installed,


        Stefan


>>>>> "Wolfgang" == Wolfgang Jenkner <address@hidden> 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  <address@hidden>

>         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






--- End Message ---

reply via email to

[Prev in Thread] Current Thread [Next in Thread]