Commit 456e62c2 authored by Wolfgang Jenkner's avatar Wolfgang Jenkner Committed by Stefan Monnier
Browse files

* lisp/man.el (Man-overstrike-face, Man-underline-face)

(Man-reverse-face): Remove variables.
(Man-overstrike, Man-underline, Man-reverse): New faces.
(Man-fontify-manpage): Use them instead of the variables.
(Man-cleanup-manpage): Comment change.
(Man-ansi-color-map): New variable.
(Man-fontify-manpage): Use it.
Call ansi-color-apply-on-region to replace ad hoc code.

Fixes: debbugs:12147
parent 2f29c200
2012-08-15 Wolfgang Jenkner <wjenkner@inode.at> 2012-08-15 Wolfgang Jenkner <wjenkner@inode.at>
* man.el (Man-overstrike-face, Man-underline-face)
(Man-reverse-face): Remove variables.
(Man-overstrike, Man-underline, Man-reverse): New faces.
(Man-fontify-manpage): Use them instead of the variables.
(Man-cleanup-manpage): Comment change.
(Man-ansi-color-map): New variable.
(Man-fontify-manpage): Use it.
Call ansi-color-apply-on-region to replace ad hoc code (bug#12147).
Implement ANSI SGR parameters 22-27 (bug#12146). Implement ANSI SGR parameters 22-27 (bug#12146).
* ansi-color.el (ansi-colors): Doc fix. * ansi-color.el (ansi-colors): Doc fix.
(ansi-color-context, ansi-color-context-region): Doc fix. (ansi-color-context, ansi-color-context-region): Doc fix.
......
...@@ -88,6 +88,7 @@ ...@@ -88,6 +88,7 @@
;;; Code: ;;; Code:
(require 'ansi-color)
(require 'button) (require 'button)
(defgroup man nil (defgroup man nil
...@@ -124,20 +125,29 @@ the manpage buffer." ...@@ -124,20 +125,29 @@ the manpage buffer."
:type 'boolean :type 'boolean
:group 'man) :group 'man)
(defcustom Man-overstrike-face 'bold (defface Man-overstrike
'((t (:inherit bold)))
"Face to use when fontifying overstrike." "Face to use when fontifying overstrike."
:type 'face :group 'man
:group 'man) :version "24.2")
(defcustom Man-underline-face 'underline (defface Man-underline
'((t (:inherit underline)))
"Face to use when fontifying underlining." "Face to use when fontifying underlining."
:type 'face :group 'man
:group 'man) :version "24.2")
(defcustom Man-reverse-face 'highlight (defface Man-reverse
'((t (:inherit highlight)))
"Face to use when fontifying reverse video." "Face to use when fontifying reverse video."
:type 'face :group 'man
:group 'man) :version "24.2")
(defvar Man-ansi-color-map (let ((ansi-color-faces-vector
[ default Man-overstrike default Man-underline
Man-underline default default Man-reverse ]))
(ansi-color-make-color-map))
"The value used here for `ansi-color-map'.")
;; Use the value of the obsolete user option Man-notify, if set. ;; Use the value of the obsolete user option Man-notify, if set.
(defcustom Man-notify-method (if (boundp 'Man-notify) Man-notify 'friendly) (defcustom Man-notify-method (if (boundp 'Man-notify) Man-notify 'friendly)
...@@ -962,7 +972,6 @@ Return the buffer in which the manpage will appear." ...@@ -962,7 +972,6 @@ Return the buffer in which the manpage will appear."
Man-width) Man-width)
(Man-width (frame-width)) (Man-width (frame-width))
((window-width)))))) ((window-width))))))
(setenv "GROFF_NO_SGR" "1")
;; Since man-db 2.4.3-1, man writes plain text with no escape ;; Since man-db 2.4.3-1, man writes plain text with no escape
;; sequences when stdout is not a tty. In 2.5.0, the following ;; sequences when stdout is not a tty. In 2.5.0, the following
;; env-var was added to allow control of this (see Debian Bug#340673). ;; env-var was added to allow control of this (see Debian Bug#340673).
...@@ -1050,38 +1059,12 @@ Same for the ANSI bold and normal escape sequences." ...@@ -1050,38 +1059,12 @@ Same for the ANSI bold and normal escape sequences."
(message "Please wait: formatting the %s man page..." Man-arguments) (message "Please wait: formatting the %s man page..." Man-arguments)
(goto-char (point-min)) (goto-char (point-min))
;; Fontify ANSI escapes. ;; Fontify ANSI escapes.
(let ((faces nil) (let ((ansi-color-apply-face-function
(buffer-undo-list t) (lambda (beg end face)
(start (point))) (when face
;; http://www.isthe.com/chongo/tech/comp/ansi_escapes.html (put-text-property beg end 'face face))))
;; suggests many codes, but we only handle: (ansi-color-map Man-ansi-color-map))
;; ESC [ 00 m reset to normal display (ansi-color-apply-on-region (point-min) (point-max)))
;; 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 (pcase (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 (pcase (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. ;; Other highlighting.
(let ((buffer-undo-list t)) (let ((buffer-undo-list t))
(if (< (buffer-size) (position-bytes (point-max))) (if (< (buffer-size) (position-bytes (point-max)))
...@@ -1090,23 +1073,23 @@ Same for the ANSI bold and normal escape sequences." ...@@ -1090,23 +1073,23 @@ Same for the ANSI bold and normal escape sequences."
(goto-char (point-min)) (goto-char (point-min))
(while (search-forward "__\b\b" nil t) (while (search-forward "__\b\b" nil t)
(backward-delete-char 4) (backward-delete-char 4)
(put-text-property (point) (1+ (point)) 'face Man-underline-face)) (put-text-property (point) (1+ (point)) 'face 'Man-underline))
(goto-char (point-min)) (goto-char (point-min))
(while (search-forward "\b\b__" nil t) (while (search-forward "\b\b__" nil t)
(backward-delete-char 4) (backward-delete-char 4)
(put-text-property (1- (point)) (point) 'face Man-underline-face)))) (put-text-property (1- (point)) (point) 'face 'Man-underline))))
(goto-char (point-min)) (goto-char (point-min))
(while (search-forward "_\b" nil t) (while (search-forward "_\b" nil t)
(backward-delete-char 2) (backward-delete-char 2)
(put-text-property (point) (1+ (point)) 'face Man-underline-face)) (put-text-property (point) (1+ (point)) 'face 'Man-underline))
(goto-char (point-min)) (goto-char (point-min))
(while (search-forward "\b_" nil t) (while (search-forward "\b_" nil t)
(backward-delete-char 2) (backward-delete-char 2)
(put-text-property (1- (point)) (point) 'face Man-underline-face)) (put-text-property (1- (point)) (point) 'face 'Man-underline))
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward "\\(.\\)\\(\b+\\1\\)+" nil t) (while (re-search-forward "\\(.\\)\\(\b+\\1\\)+" nil t)
(replace-match "\\1") (replace-match "\\1")
(put-text-property (1- (point)) (point) 'face Man-overstrike-face)) (put-text-property (1- (point)) (point) 'face 'Man-overstrike))
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward "o\b\\+\\|\\+\bo" nil t) (while (re-search-forward "o\b\\+\\|\\+\bo" nil t)
(replace-match "o") (replace-match "o")
...@@ -1117,7 +1100,7 @@ Same for the ANSI bold and normal escape sequences." ...@@ -1117,7 +1100,7 @@ Same for the ANSI bold and normal escape sequences."
(put-text-property (1- (point)) (point) 'face 'bold)) (put-text-property (1- (point)) (point) 'face 'bold))
;; When the header is longer than the manpage name, groff tries to ;; When the header is longer than the manpage name, groff tries to
;; condense it to a shorter line interspersed with ^H. Remove ^H with ;; condense it to a shorter line interspersed with ^H. Remove ^H with
;; their preceding chars (but don't put Man-overstrike-face). (Bug#5566) ;; their preceding chars (but don't put Man-overstrike). (Bug#5566)
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward ".\b" nil t) (backward-delete-char 2)) (while (re-search-forward ".\b" nil t) (backward-delete-char 2))
(goto-char (point-min)) (goto-char (point-min))
...@@ -1128,7 +1111,7 @@ Same for the ANSI bold and normal escape sequences." ...@@ -1128,7 +1111,7 @@ Same for the ANSI bold and normal escape sequences."
(while (re-search-forward Man-heading-regexp nil t) (while (re-search-forward Man-heading-regexp nil t)
(put-text-property (match-beginning 0) (put-text-property (match-beginning 0)
(match-end 0) (match-end 0)
'face Man-overstrike-face))) 'face 'Man-overstrike)))
(message "%s man page formatted" (Man-page-from-arguments Man-arguments))) (message "%s man page formatted" (Man-page-from-arguments Man-arguments)))
(defun Man-highlight-references (&optional xref-man-type) (defun Man-highlight-references (&optional xref-man-type)
...@@ -1211,7 +1194,7 @@ script would have done them." ...@@ -1211,7 +1194,7 @@ script would have done them."
(while (re-search-forward "[-|]\\(\b[-|]\\)+" nil t) (replace-match "+")) (while (re-search-forward "[-|]\\(\b[-|]\\)+" nil t) (replace-match "+"))
;; When the header is longer than the manpage name, groff tries to ;; When the header is longer than the manpage name, groff tries to
;; condense it to a shorter line interspersed with ^H. Remove ^H with ;; condense it to a shorter line interspersed with ^H. Remove ^H with
;; their preceding chars (but don't put Man-overstrike-face). (Bug#5566) ;; their preceding chars (but don't put Man-overstrike). (Bug#5566)
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward ".\b" nil t) (backward-delete-char 2)) (while (re-search-forward ".\b" nil t) (backward-delete-char 2))
(Man-softhyphen-to-minus) (Man-softhyphen-to-minus)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment