X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/ac1a0ce1c6ba60a3faddc64463cb7a697b9d8fd2..bdda4855c635ecf4135e23321bdba023e9ae65c9:/lisp/ansi-color.el diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el index d677f70670..788a7bde4c 100644 --- a/lisp/ansi-color.el +++ b/lisp/ansi-color.el @@ -1,6 +1,6 @@ -;;; ansi-color.el --- translate ANSI escape sequences into faces +;;; ansi-color.el --- translate ANSI escape sequences into faces -*- lexical-binding: t -*- -;; Copyright (C) 1999-2012 Free Software Foundation, Inc. +;; Copyright (C) 1999-2016 Free Software Foundation, Inc. ;; Author: Alex Schroeder ;; Maintainer: Alex Schroeder @@ -40,11 +40,11 @@ ;; ;; SGR control sequences are defined in section 3.8.117 of the ECMA-48 ;; standard (identical to ISO/IEC 6429), which is freely available as a -;; PDF file . The -;; "Graphic Rendition Combination Mode (GRCM)" implemented is -;; "cumulative mode" as defined in section 7.2.8. Cumulative mode means -;; that whenever possible, SGR control sequences are combined (ie. blue -;; and bold). +;; PDF file . +;; The "Graphic Rendition Combination Mode (GRCM)" implemented is +;; "cumulative mode" as defined in section 7.2.8. Cumulative mode +;; means that whenever possible, SGR control sequences are combined +;; (ie. blue and bold). ;; The basic functions are: ;; @@ -83,9 +83,10 @@ "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 -ECMA-48 standard \(identical to ISO/IEC 6429), which is freely available -as a PDF file ." +Rendition) control sequences are defined in section 8.3.117 of the +ECMA-48 standard (identical to ISO/IEC 6429), which is freely available +at +as a PDF file." :version "21.1" :group 'processes) @@ -116,10 +117,10 @@ map. This color map is stored in the variable `ansi-color-map'." :group 'ansi-colors) (defcustom ansi-color-names-vector - ["black" "red" "green" "yellow" "blue" "magenta" "cyan" "white"] + ["black" "red3" "green3" "yellow3" "blue2" "magenta3" "cyan3" "gray90"] "Colors used for SGR control sequences determining a color. This vector holds the colors used for SGR control sequences parameters -30 to 37 \(foreground colors) and 40 to 47 (background colors). +30 to 37 (foreground colors) and 40 to 47 (background colors). Parameter Color 30 40 black @@ -146,13 +147,14 @@ foreground and background colors, respectively." (choice color (cons color color))) :set 'ansi-color-map-update :initialize 'custom-initialize-default + :version "24.4" ; default colors copied from `xterm-standard-colors' :group 'ansi-colors) (defconst ansi-color-regexp "\033\\[\\([0-9;]*m\\)" "Regexp that matches SGR control sequences.") (defconst ansi-color-drop-regexp - "\033\\[\\([ABCDsuK]\\|2J\\|=[0-9]+[hI]\\|[0-9;]*[Hf]\\)" + "\033\\[\\([ABCDsuK]\\|[12][JK]\\|=[0-9]+[hI]\\|[0-9;]*[Hf]\\|\\?[0-9]+[hl]\\)" "Regexp that matches ANSI control sequences to silently drop.") (defconst ansi-color-parameter-regexp "\\([0-9]*\\)[m;]" @@ -230,17 +232,17 @@ This is a good function to put in `comint-output-filter-functions'." (t (ansi-color-apply-on-region start-marker end-marker))))) -(defalias 'ansi-color-unfontify-region 'font-lock-default-unfontify-region) -(make-obsolete 'ansi-color-unfontify-region "not needed any more" "24.1") +(define-obsolete-function-alias 'ansi-color-unfontify-region + 'font-lock-default-unfontify-region "24.1") ;; Working with strings -(defvar ansi-color-context nil +(defvar-local 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) (defun ansi-color-filter-apply (string) "Filter out all ANSI control sequences from STRING. @@ -259,7 +261,11 @@ This function can be added to `comint-preoutput-filter-functions'." ;; find the next escape sequence (while (setq end (string-match ansi-color-regexp string start)) (setq result (concat result (substring string start end)) - start (match-end 0))) + start (match-end 0))) + ;; eliminate unrecognized escape sequences + (while (string-match ansi-color-drop-regexp string) + (setq string + (replace-match "" nil nil string))) ;; save context, add the remainder of the string to the result (let (fragment) (if (string-match "\033" string start) @@ -270,6 +276,20 @@ This function can be added to `comint-preoutput-filter-functions'." (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 +300,12 @@ are given in `ansi-color-faces-vector' and `ansi-color-names-vector'. 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 +316,8 @@ This function can be added to `comint-preoutput-filter-functions'." (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 +326,15 @@ This function can be added to `comint-preoutput-filter-functions'." (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)) + ;; eliminate unrecognized escape sequences + (while (string-match ansi-color-drop-regexp string) + (setq string + (replace-match "" nil nil string))) ;; save context, add the remainder of the string to the result (let (fragment) (if (string-match "\033" string start) @@ -317,18 +342,18 @@ This function can be added to `comint-preoutput-filter-functions'." (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 +(defvar-local 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.") -(make-variable-buffer-local 'ansi-color-context-region) +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.") (defun ansi-color-filter-region (begin end) "Filter out all ANSI control sequences from region BEGIN to END. @@ -358,19 +383,21 @@ it will override BEGIN, the start of the region. Set "Translates SGR control sequences into overlays or extents. Delete all other control sequences without processing them. -SGR control sequences are applied by setting foreground and -background colors to the text between BEGIN and END using -overlays. The colors used are given 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)) +SGR control sequences are applied by calling the function +specified by `ansi-color-apply-face-function'. The default +function sets foreground and background colors to the text +between BEGIN and END, using overlays. The colors used are given +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 +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)) @@ -387,28 +414,27 @@ start of the region and set the face with which to start. Set ;; 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. @@ -444,7 +470,7 @@ If FACE is nil, do nothing." "Return a face with PROPERTY set to COLOR. PROPERTY can be either symbol `foreground' or symbol `background'. -For Emacs, we just return the cons cell \(PROPERTY . COLOR). +For Emacs, we just return the cons cell (PROPERTY . COLOR). For XEmacs, we create a temporary face and return it." (if (featurep 'xemacs) (let ((face (make-face (intern (concat color "-" (symbol-name property))) @@ -496,32 +522,62 @@ XEmacs uses `set-extent-face', Emacs uses `overlay-put'." ;; 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'. +(defsubst ansi-color-parse-sequence (escape-seq) + "Return the list of all the parameters in ESCAPE-SEQ. -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. +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. -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))))) +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-SEQUENCE to CODES and return the new list of codes. + +ESCAPE-SEQUENCE is an escape sequence parsed by +`ansi-color-parse-sequence'. + +For each new code, the following happens: if it is 1-7, add it to +the list of codes; if it is 21-25 or 27, delete appropriate +parameters from the list of codes; if it is 30-37 resp. 39, the +foreground color code is replaced or added resp. deleted; if it +is 40-47 resp. 49, the background color code is replaced or added +resp. deleted; any other code is discarded together with the old +codes. Finally, the so changed list of codes is returned." + (let ((new-codes (ansi-color-parse-sequence escape-sequence))) + (while new-codes + (let* ((new (pop new-codes)) + (q (/ new 10))) + (setq codes + (pcase q + (0 (unless (memq new '(0 8 9)) + (cons new (remq new codes)))) + (2 (unless (memq new '(20 26 28 29)) + ;; The standard says `21 doubly underlined' while + ;; http://en.wikipedia.org/wiki/ANSI_escape_code claims + ;; `21 Bright/Bold: off or Underline: Double'. + (remq (- new 20) (pcase new + (22 (remq 1 codes)) + (25 (remq 6 codes)) + (_ codes))))) + ((or 3 4) (let ((r (mod new 10))) + (unless (= r 8) + (let (beg) + (while (and codes (/= q (/ (car codes) 10))) + (push (pop codes) beg)) + (setq codes (nconc (nreverse beg) (cdr codes))) + (if (= r 9) + codes + (cons new codes)))))) + (_ nil))))) + codes)) (defun ansi-color-make-color-map () "Creates a vector of face definitions and returns it. @@ -531,19 +587,19 @@ The index into the vector is an ANSI code. See the documentation of The face definitions are based upon the variables `ansi-color-faces-vector' and `ansi-color-names-vector'." - (let ((ansi-color-map (make-vector 50 nil)) + (let ((map (make-vector 50 nil)) (index 0)) ;; miscellaneous attributes (mapc (function (lambda (e) - (aset ansi-color-map index e) + (aset map index e) (setq index (1+ index)) )) ansi-color-faces-vector) ;; foreground attributes (setq index 30) (mapc (function (lambda (e) - (aset ansi-color-map index + (aset map index (ansi-color-make-face 'foreground (if (consp e) (car e) e))) (setq index (1+ index)) )) @@ -552,12 +608,12 @@ The face definitions are based upon the variables (setq index 40) (mapc (function (lambda (e) - (aset ansi-color-map index + (aset map index (ansi-color-make-face 'background (if (consp e) (cdr e) e))) (setq index (1+ index)) )) ansi-color-names-vector) - ansi-color-map)) + map)) (defvar ansi-color-map (ansi-color-make-color-map) "A brand new color map suitable for `ansi-color-get-face'. @@ -567,9 +623,9 @@ The value of this variable is usually constructed by numbers included in an SGR control sequences point to the correct foreground or background colors. -Example: The sequence \033[34m specifies a blue foreground. Therefore: +Example: The sequence \\033[34m specifies a blue foreground. Therefore: (aref ansi-color-map 34) - => \(foreground-color . \"blue\")") + => (foreground-color . \"blue\")") (defun ansi-color-map-update (symbol value) "Update `ansi-color-map'. @@ -587,28 +643,6 @@ ANSI-CODE is used as an index into the vector." (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