X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/c194970e15b6d6efa07697679a25dfab3aa76442..08974112ae68aefba658a8516c8faa3374edc924:/lisp/ansi-color.el diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el index 047b4b944b..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: ;; @@ -84,8 +84,9 @@ 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 8.3.117 of the -ECMA-48 standard \(identical to ISO/IEC 6429), which is freely available -as a PDF file ." +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;]" @@ -234,14 +236,13 @@ This is a good function to put in `comint-output-filter-functions'." '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 (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. @@ -260,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) @@ -324,7 +329,12 @@ This function can be added to `comint-preoutput-filter-functions'." (setq codes (ansi-color-apply-sequence escape-sequence codes))) ;; if the rest of the string should have a face, put it there (when codes - (put-text-property start (length string) 'font-lock-face (ansi-color--find-face codes) string)) + (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) @@ -337,14 +347,13 @@ This function can be added to `comint-preoutput-filter-functions'." ;; 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 (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) "Filter out all ANSI control sequences from region BEGIN to END. @@ -461,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))) @@ -530,38 +539,44 @@ Returns nil only if there's no match for `ansi-color-parameter-regexp'." (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." + "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 - (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))))) + (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 () @@ -572,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)) )) @@ -593,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'. @@ -608,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'.