[1290] in RedHat Linux List
[gnu.emacs.sources] ansi-display.el (1.0) - ANSI display escape sequence support
daemon@ATHENA.MIT.EDU (Alan Shutko)
Sun Oct 27 14:03:03 1996
To: redhat-list@redhat.com
From: Alan Shutko <ats@wydo125.wustl.edu>
Date: 27 Oct 1996 12:59:42 -0600
Resent-From: redhat-list@redhat.com
Reply-To: redhat-list@redhat.com
--Multipart_Sun_Oct_27_12:59:11_1996-1
Content-Type: text/plain; charset=US-ASCII
A mode to display ANSI colors in Emacs shell windows has been posted
to gnu.emacs.sources. Since the mode is ~7k, I'm posting it here
because of previous interest.
--Multipart_Sun_Oct_27_12:59:11_1996-1
Content-Type: message/rfc822
From: Daniel Quinlan <quinlan@bigsky.transmeta.com>
Newsgroups: gnu.emacs.sources
Subject: ansi-display.el (1.0) - ANSI display escape sequence support
Date: 25 Oct 1996 20:15:06 -0700
Organization: Transmeta Corporation, Santa Clara, CA, USA
Message-ID: <6yn2xato05.fsf@bigsky.transmeta.com>
This is the first release of an Emacs Lisp package to support
colorization in Emacs (like color xterm). It will work on any mode
that is a derivative of Comint mode. That includes shell-mode so
things like `ls --color' will work.
In addition to supporting colors, it also will strip those annoying
nulls (^@), Ctrl-Ms (^M), and backspaces (^H). The stripping behavior
can also be set with several variables (`ansi-display-strip-*').
It's still bit rough and does not support some things (nested colors,
changing both the background and foreground, it misses some escapes,
etc). Any improvements, patches, or Emacs Lisp implemention advice
are quite welcome. Suggestions to add anything that I know it's
missing will probably be ignored, but you're welcome to try.
;;; ansi-display.el --- ANSI display escapes in Comint mode derivatives
;; Copyright (C) 1996 Transmeta Corporation
;;
;; LCD Archive Entry:
;; ansi-display|Daniel Quinlan|quinlan@transmeta.com
;; Use some ANSI display escapes in Comint mode derivatives (mainly colors).|
;; 25-Oct-96|Revision: 1.0 |~/misc/ansi-display.el|
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
;;; Commentary:
;; This package supports some, but not all ANSI display escape sequences
;; of the form "ESC[#m" where # is a number. Compound sequences of the
;; form "ESC[#;#;....;#m" are not supported (patches to add this or
;; other features are welcome).
;; If you want to use this with the GNU fileutils version of `ls' that
;; supports colors, I suggest setting the LS_COLORS environment variable
;; to "bd=44:cd=44" to avoid using compound sequences.
;; To use this package, you need make sure this package is in your
;; `load-path' and then add something like this to your .emacs file.
;;(add-hook 'shell-mode-hook
;; '(lambda ()
;; (require 'ansi-display)
;; (setq comint-output-filter-functions
;; (append '(comint-ansi-display)
;; comint-output-filter-functions))))
;; Other modes are added similarly.
;;; User variables:
(defvar ansi-display-strip-null t
"Strip `^@' null characters from the current output group.")
(defvar ansi-display-strip-ctrl-m t
"Strip trailing `^M' characters from the current output group.
Note: this overlaps functionality with comint-strip-ctrl-m, check
that comint-strip-ctrl-m is not listed in comint-output-filter-functions
if you set this to t (or you will be unnecessarily slowing output).")
(defvar ansi-display-strip-backspace t
"Strip `^H' backspace characters from the current output group.")
;;; Code:
(make-face 'ansi-display-black)
(make-face 'ansi-display-red)
(make-face 'ansi-display-green)
(make-face 'ansi-display-yellow)
(make-face 'ansi-display-blue)
(make-face 'ansi-display-magenta)
(make-face 'ansi-display-cyan)
(make-face 'ansi-display-white)
(make-face 'ansi-display-black-bg)
(make-face 'ansi-display-red-bg)
(make-face 'ansi-display-green-bg)
(make-face 'ansi-display-yellow-bg)
(make-face 'ansi-display-blue-bg)
(make-face 'ansi-display-magenta-bg)
(make-face 'ansi-display-cyan-bg)
(make-face 'ansi-display-white-bg)
(make-face 'ansi-display-reverse-video)
(make-face 'ansi-display-invisible)
(set-face-foreground 'ansi-display-black "black")
(set-face-foreground 'ansi-display-red "red")
(set-face-foreground 'ansi-display-green "green")
(set-face-foreground 'ansi-display-yellow "yellow")
(set-face-foreground 'ansi-display-blue "blue")
(set-face-foreground 'ansi-display-magenta "magenta")
(set-face-foreground 'ansi-display-cyan "cyan")
(set-face-foreground 'ansi-display-white "white")
(set-face-background 'ansi-display-black-bg "black")
(set-face-background 'ansi-display-red-bg "red")
(set-face-background 'ansi-display-green-bg "green")
(set-face-background 'ansi-display-yellow-bg "yellow")
(set-face-background 'ansi-display-blue-bg "blue")
(set-face-background 'ansi-display-magenta-bg "magenta")
(set-face-background 'ansi-display-cyan-bg "cyan")
(set-face-background 'ansi-display-white-bg "white")
(invert-face 'ansi-display-reverse-video)
(set-face-foreground 'ansi-display-invisible
(cdr (assq 'background-color (frame-parameters))))
(defun get-ansi-face (color)
(cond ((string-equal color "0") 'default)
((string-equal color "1") 'bold)
((string-equal color "4") 'underline)
((string-equal color "5") 'bold) ; blink is unsupported in Emacs
((string-equal color "7") 'ansi-display-reverse-video)
((string-equal color "8") 'ansi-display-invisible)
((string-equal color "30") 'ansi-display-black)
((string-equal color "31") 'ansi-display-red)
((string-equal color "32") 'ansi-display-green)
((string-equal color "33") 'ansi-display-yellow)
((string-equal color "34") 'ansi-display-blue)
((string-equal color "35") 'ansi-display-magenta)
((string-equal color "36") 'ansi-display-cyan)
((string-equal color "37") 'ansi-display-white)
((string-equal color "40") 'ansi-display-black-bg)
((string-equal color "41") 'ansi-display-red-bg)
((string-equal color "42") 'ansi-display-green-bg)
((string-equal color "43") 'ansi-display-yellow-bg)
((string-equal color "44") 'ansi-display-blue-bg)
((string-equal color "45") 'ansi-display-magenta-bg)
((string-equal color "46") 'ansi-display-cyan-bg)
((string-equal color "47") 'ansi-display-white-bg)
(t 'default)))
(defun comint-ansi-display (text)
(let ((pmark (process-mark (get-buffer-process (current-buffer))))
(start (if (interactive-p)
comint-last-input-end comint-last-output-start)))
(save-excursion
;; ANSI display
(goto-char start)
(while (re-search-forward
"\\([\033]\\[\\([014578]\\|3[0-7]\\|4[0-7]\\)m\\)[^\033]+"
pmark t)
(let ((snippet (buffer-substring (match-beginning 2) (match-end 2))))
(put-text-property (match-beginning 0) (match-end 0) 'face
(get-ansi-face snippet))
(put-text-property (match-beginning 1)
(match-end 1) 'invisible t)))
;; strip null
(if ansi-display-strip-null
(prog2
(goto-char start)
(while (re-search-forward "[\000]" pmark t)
(replace-match "" t t))))
;; strip ctrl-m
(if ansi-display-strip-ctrl-m
(prog2
(goto-char start)
(while (re-search-forward "\r+$" pmark t)
(replace-match "" t t))))
;; strip backspace
(if ansi-display-strip-backspace
(prog2
(goto-char start)
(while (re-search-forward "\b" pmark t)
(delete-char -2)))))))
(provide 'ansi-display)
;;; ansi-display.el ends here
--
Daniel Quinlan (at work) Daniel Quinlan (at home)
quinlan@transmeta.com http://www.pathname.com/~quinlan/
--Multipart_Sun_Oct_27_12:59:11_1996-1--
--
Alan Shutko <ats@hubert.wustl.edu> - The Few, the Proud, the Remaining.
A dog may bark, but his legs will never grow longer.
--
PLEASE read the Red Hat FAQ, Tips, Errata and the MAILING LIST ARCHIVES!
________________________________________________________________________
http://www.redhat.com/RedHat-FAQ http://www.redhat.com/RedHat-Errata
http://www.redhat.com/RedHat-Tips http://www.redhat.com/mailing-lists
------------------------------------------------------------------------
To unsubscribe: mail -s unsubscribe redhat-list-request@redhat.com < /dev/null
