Mercurial > emacs
changeset 58690:98e0ecc13fc5
(Man-fontify-manpage): Improve handling of ANSI escapes.
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Tue, 30 Nov 2004 22:26:26 +0000 |
parents | 9e0cdd7232b7 |
children | e5f1fb888f0b |
files | lisp/man.el |
diffstat | 1 files changed, 42 insertions(+), 9 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/man.el Tue Nov 30 22:08:29 2004 +0000 +++ b/lisp/man.el Tue Nov 30 22:26:26 2004 +0000 @@ -1,6 +1,7 @@ ;;; man.el --- browse UNIX manual pages -*- coding: iso-8859-1 -*- -;; Copyright (C) 1993, 1994, 1996, 1997, 2001, 2003, 2004 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1994, 1996, 1997, 2001, 2003, 2004 +;; Free Software Foundation, Inc. ;; Author: Barry A. Warsaw <bwarsaw@cen.com> ;; Maintainer: FSF @@ -94,6 +95,7 @@ ;;; Code: +(eval-when-compile (require 'cl)) (require 'assoc) (require 'button) @@ -153,6 +155,11 @@ :type 'face :group 'man) +(defcustom Man-reverse-face 'secondary-selection + "*Face to use when fontifying reverse video." + :type 'face + :group 'man) + ;; Use the value of the obsolete user option Man-notify, if set. (defcustom Man-notify-method (if (boundp 'Man-notify) Man-notify 'friendly) "*Selects the behavior when manpage is ready. @@ -813,13 +820,39 @@ (interactive) (message "Please wait: formatting the %s man page..." Man-arguments) (goto-char (point-min)) - (while (search-forward "\e[1m" nil t) - (delete-backward-char 4) - (put-text-property (point) - (progn (if (search-forward "\e[0m" nil 'move) - (delete-backward-char 4)) - (point)) - 'face Man-overstrike-face)) + ;; Fontify ANSI escapes. + (let ((faces nil) + (start (point))) + ;; http://www.isthe.com/chongo/tech/comp/ansi_escapes.html + ;; suggests many codes, but we only handle: + ;; ESC [ 00 m reset to normal display + ;; ESC [ 01 m bold + ;; ESC [ 04 m underline + ;; ESC [ 07 m reverse-video + ;; ESC [ 22 m no-bold + ;; ESC [ 24 m no-underline + ;; ESC [ 27 m no-reverse-video + (while (re-search-forward "\e\\[0?\\([1470]\\|2\\([247]\\)\\)m" nil t) + (if faces (put-text-property start (match-beginning 0) 'face + (if (cdr faces) faces (car faces)))) + (setq faces + (cond + ((match-beginning 2) + (delq (case (char-after (match-beginning 2)) + (?2 Man-overstrike-face) + (?4 Man-underline-face) + (?7 Man-reverse-face)) + faces)) + ((eq (char-after (match-beginning 1)) ?0) nil) + (t + (cons (case (char-after (match-beginning 1)) + (?1 Man-overstrike-face) + (?4 Man-underline-face) + (?7 Man-reverse-face)) + faces)))) + (delete-region (match-beginning 0) (match-end 0)) + (setq start (point)))) + ;; Other highlighting. (if (< (buffer-size) (position-bytes (point-max))) ;; Multibyte characters exist. (progn @@ -1372,5 +1405,5 @@ (provide 'man) -;;; arch-tag: 587cda76-8e23-4594-b1f3-89b6b09a0d47 +;; arch-tag: 587cda76-8e23-4594-b1f3-89b6b09a0d47 ;;; man.el ends here