Package: emacs;
Reported by: Wolfgang Jenkner <wjenkner <at> inode.at>
Date: Mon, 6 Aug 2012 15:17: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.
View this message in rfc822 format
From: help-debbugs <at> gnu.org (GNU bug Tracking System) To: Stefan Monnier <monnier <at> iro.umontreal.ca> Cc: tracker <at> debbugs.gnu.org Subject: bug#12146: closed (24.1.50; [PATCH] ANSI SGR parameters 22-27 for ansi-color) Date: Wed, 15 Aug 2012 03:44:02 +0000
[Message part 1 (text/plain, inline)]
Your message dated Tue, 14 Aug 2012 23:34:20 -0400 with message-id <jwv628ksuag.fsf-monnier+emacs <at> gnu.org> 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 help-debbugs <at> gnu.org.) -- 12146: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=12146 GNU Bug Tracking System Contact help-debbugs <at> gnu.org with problems
[Message part 2 (message/rfc822, inline)]
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 +0200This 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 part 3 (message/rfc822, inline)]
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 -0400Thanks, 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
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.