comparison lisp/woman.el @ 63199:6d9a2cf91f62

Revision: [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-370 Remove "-face" suffix from woman faces 2005-06-10 Miles Bader <[e-mail]> * lisp/woman.el (woman-italic, woman-bold, woman-unknown) (woman-addition, woman-symbol-face): Remove "-face" suffix from face names. (woman-italic-face, woman-bold-face, woman-unknown-face) (woman-addition-face): New backward-compatibility aliases for renamed faces. (woman-default-faces, woman-monochrome-faces, woman-man-buffer) (woman-decode-region, woman-replace-match) (woman-display-extended-fonts, woman-special-characters) (woman-font-alist, woman-change-fonts, woman2-TH, woman2-SH): Use renamed woman faces.

63198:f855a20b356c

  :group 'woman-faces)

;; This is overkill!  Troff uses just italic; Nroff uses just underline.
;; You should probably select either italic or underline as you prefer, but
;; not both, although italic and underline work together perfectly well!
(defface woman-italic-face
  `((((min-colors 88) (background light)) 
     (:slant italic :underline t :foreground "red1"))
    (((background light)) (:slant italic :underline t :foreground "red"))
    (((background dark)) (:slant italic :underline t)))
  "Face for italic font in man pages."
  :group 'woman-faces)

(defface woman-bold-face
  '((((min-colors 88) (background light)) (:weight bold :foreground "blue1"))
    (((background light)) (:weight bold :foreground "blue"))
    (((background dark)) (:weight bold :foreground "green2")))
  "Face for bold font in man pages."
  :group 'woman-faces)

;; Brown is a good compromise: it is distinguishable from the default
;; but not enough so to make font errors look terrible.  (Files that use
;; non-standard fonts seem to do so badly or in idiosyncratic ways!)
(defface woman-unknown-face
  '((((background light)) (:foreground "brown"))
    (((min-colors 88) (background dark)) (:foreground "cyan1"))
    (((background dark)) (:foreground "cyan")))
  "Face for all unknown fonts in man pages."
  :group 'woman-faces)

(defface woman-addition-face
  '((t (:foreground "orange")))
  "Face for all WoMan additions to man pages."
  :group 'woman-faces)

(defun woman-default-faces ()
  "Set foreground colours of italic and bold faces to their default values."
  (interactive)
  (face-spec-set 'woman-italic-face
		 (face-user-default-spec 'woman-italic-face))
  (face-spec-set 'woman-bold-face (face-user-default-spec 'woman-bold-face)))

(defun woman-monochrome-faces ()
  "Set foreground colours of italic and bold faces to that of the default face.
This is usually either black or white."
  (interactive)
  (set-face-foreground 'woman-italic-face 'unspecified)
  (set-face-foreground 'woman-bold-face 'unspecified))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Experimental font support, initially only for MS-Windows.
(defconst woman-font-support
  (eq window-system 'w32)		; Support X later!

	   (setq symbol-fonts (cons (car fonts) symbol-fonts)))
      (setq fonts (cdr fonts)))
    symbol-fonts))

(when woman-font-support
  (make-face 'woman-symbol-face)

  ;; Set the symbol font only if `woman-use-symbol-font' is true, to
  ;; avoid unnecessarily upsetting the line spacing in NTEmacs 20.5!

  (defcustom woman-use-extended-font t

      ;; Multibyte characters exist.
      (progn
	(goto-char (point-min))
	(while (search-forward "__\b\b" nil t)
	  (backward-delete-char 4)
	  (woman-set-face (point) (1+ (point)) 'woman-italic-face))
	(goto-char (point-min))
	(while (search-forward "\b\b__" nil t)
	  (backward-delete-char 4)
	  (woman-set-face (1- (point)) (point) 'woman-italic-face))))

  ;; Interpret overprinting to indicate bold face:
  (goto-char (point-min))
  (while (re-search-forward "\\(.\\)\\(\\(+\\1\\)+\\)" nil t)
    (woman-delete-match 2)
    (woman-set-face (1- (point)) (point) 'woman-bold-face))

  ;; Interpret underlining to indicate italic face:
  ;; (Must be AFTER emboldening to interpret bold _ correctly!)
  (goto-char (point-min))
  (while (search-forward "_" nil t)
    (delete-char -2)
    (woman-set-face (point) (1+ (point)) 'woman-italic-face))

  ;; Leave any other uninterpreted ^H's in the buffer for now!  (They
  ;; might indicate composite special characters, which could be
  ;; interpreted if I knew what to expect.)

  (cond
   (woman-bold-headings
    (goto-char (point-min))
    (forward-line)
    (while (re-search-forward "^\\(   \\)?\\([A-Z].*\\)" nil t)
      (woman-set-face (match-beginning 2) (match-end 2) 'woman-bold-face))))
  )

(defun woman-insert-file-contents (filename compressed)
  "Insert file FILENAME into the current buffer.
If COMPRESSED is t, or is non-nil and the filename implies compression,

    (setq woman-if-conditions-true
	  (cons (string-to-char (symbol-name woman-emulation)) '(?e ?o)))

    ;; Prepare non-underlined versions of underlined faces:
    (woman-non-underline-faces)
    ;; Set font of `woman-symbol-face' to `woman-symbol-font' if
    ;; `woman-symbol-font' is well defined.
    (and woman-use-symbol-font
	 (stringp woman-symbol-font)
	 (set-face-font 'woman-symbol-face woman-symbol-font
			(and (frame-live-p woman-frame) woman-frame)))

    ;; Set syntax and display tables:
    (set-syntax-table woman-syntax-table)
    (woman-set-buffer-display-table)

	       (repl (if (or (= (aref esc 0) ?u)
			     (and (>= (length esc) 2) (= (aref esc 2) ?-)))
			 "^" "_")))
	  (cond (first
		 (replace-match repl nil t)
		 (put-text-property (1- (point)) (point)
				    'face 'woman-addition-face)
		 (WoMan-warn
		  "Initial vertical motion escape \\%s simulated" esc)
		 (WoMan-log
		  "      by TeX `%s' in woman-addition-face!" repl))
		(t

(defsubst woman-replace-match (newtext &optional face)
  "Replace text matched by last search with NEWTEXT and return t.
Set NEWTEXT in face FACE if specified."
  (woman-delete-match 0)
  (insert-before-markers newtext)
  (if face (put-text-property (1- (point)) (point)
			      'face 'woman-symbol-face))
  t)

(defun woman-special-characters (to)
  "Process special character escapes \\(xx, \\[xxx] up to buffer position TO.
\(This must be done AFTER translation, which may use special characters.)"

	   (cond ((and (cddr replacement)
		       (if (nthcdr 3 replacement)
			   ;; Need symbol font:
			   (if woman-use-symbol-font
			       (woman-replace-match (nth 2 replacement)
						    'woman-symbol-face))
			 ;; Need extended font:
			 (if woman-use-extended-font
			     (woman-replace-match (nth 2 replacement))))))
		 ((cadr replacement)	; Use ASCII simulation
		  (woman-replace-match (cadr replacement)))))

      (set-buffer standard-output)
      (let ((i 32))
	(while (< i 256)
	  (insert (format "\\%03o " i) (string i) " " (string i))
	  (put-text-property (1- (point)) (point)
			     'face 'woman-symbol-face)
	  (insert "   ")
	  (setq i (1+ i))
	  (when (= i 128) (setq i 160) (insert "\n"))
	  (if (zerop (% i 8)) (insert "\n")))
	))


;;; Direct font selection:

(defconst woman-font-alist
  '(("R" . default)
    ("I" . woman-italic-face)
    ("B" . woman-bold-face)
    ("P" . previous)
    ("1" . default)
    ("2" . woman-italic-face)
    ("3" . woman-bold-face)		; used in bash.1
    )
  "Alist of ?roff font indicators and woman font variables and names.")

(defun woman-change-fonts ()
  "Process font changes."

		      font (if font
			       (cdr font)
			     (WoMan-warn "Unknown font %s." fontstring)
			     ;; Output this message once only per call ...
			     (setq font-alist
				   (cons (cons fontstring 'woman-unknown-face)
					 font-alist))
			     'woman-unknown-face)
		      )))
	  ;; Delete font control line or escape sequence:
	  (cond (beg (delete-region beg (point))
		     (if (eq font 'previous) (setq font previous-font))))
	  (woman-set-face previous-pos (point) current-font)

			(buffer-substring start here))
	  (delete-region here (point)))
      ))
  ;; Embolden heading (point is at end of heading):
  (woman-set-face
   (save-excursion (beginning-of-line) (point)) (point) 'woman-bold-face)
  (forward-line)
  (delete-blank-lines)
  (setq woman-left-margin woman-default-indent)
  (setq woman-prevailing-indent woman-default-indent)
  (woman2-format-paragraphs to woman-left-margin))

  (woman-leave-blank-lines woman-interparagraph-distance)
  (setq woman-leave-blank-lines nil)
  ;; Optionally embolden heading (point is at beginning of heading):
  (if woman-bold-headings
      (woman-set-face
       (point) (save-excursion (end-of-line) (point)) 'woman-bold-face))
  (forward-line)
  (setq woman-left-margin woman-default-indent
	woman-nofill nil)		; fill output lines
  (setq woman-prevailing-indent woman-default-indent)
  (woman2-format-paragraphs to woman-left-margin))

63199:6d9a2cf91f62

  :group 'woman-faces)

;; This is overkill!  Troff uses just italic; Nroff uses just underline.
;; You should probably select either italic or underline as you prefer, but
;; not both, although italic and underline work together perfectly well!
(defface woman-italic
  `((((min-colors 88) (background light)) 
     (:slant italic :underline t :foreground "red1"))
    (((background light)) (:slant italic :underline t :foreground "red"))
    (((background dark)) (:slant italic :underline t)))
  "Face for italic font in man pages."
  :group 'woman-faces)
;; backward-compatibility alias
(put 'woman-italic-face 'face-alias 'woman-italic)

(defface woman-bold
  '((((min-colors 88) (background light)) (:weight bold :foreground "blue1"))
    (((background light)) (:weight bold :foreground "blue"))
    (((background dark)) (:weight bold :foreground "green2")))
  "Face for bold font in man pages."
  :group 'woman-faces)
;; backward-compatibility alias
(put 'woman-bold-face 'face-alias 'woman-bold)

;; Brown is a good compromise: it is distinguishable from the default
;; but not enough so to make font errors look terrible.  (Files that use
;; non-standard fonts seem to do so badly or in idiosyncratic ways!)
(defface woman-unknown
  '((((background light)) (:foreground "brown"))
    (((min-colors 88) (background dark)) (:foreground "cyan1"))
    (((background dark)) (:foreground "cyan")))
  "Face for all unknown fonts in man pages."
  :group 'woman-faces)
;; backward-compatibility alias
(put 'woman-unknown-face 'face-alias 'woman-unknown)

(defface woman-addition
  '((t (:foreground "orange")))
  "Face for all WoMan additions to man pages."
  :group 'woman-faces)
;; backward-compatibility alias
(put 'woman-addition-face 'face-alias 'woman-addition)

(defun woman-default-faces ()
  "Set foreground colours of italic and bold faces to their default values."
  (interactive)
  (face-spec-set 'woman-italic (face-user-default-spec 'woman-italic))
  (face-spec-set 'woman-bold (face-user-default-spec 'woman-bold)))

(defun woman-monochrome-faces ()
  "Set foreground colours of italic and bold faces to that of the default face.
This is usually either black or white."
  (interactive)
  (set-face-foreground 'woman-italic 'unspecified)
  (set-face-foreground 'woman-bold 'unspecified))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Experimental font support, initially only for MS-Windows.
(defconst woman-font-support
  (eq window-system 'w32)		; Support X later!

	   (setq symbol-fonts (cons (car fonts) symbol-fonts)))
      (setq fonts (cdr fonts)))
    symbol-fonts))

(when woman-font-support
  (make-face 'woman-symbol)

  ;; Set the symbol font only if `woman-use-symbol-font' is true, to
  ;; avoid unnecessarily upsetting the line spacing in NTEmacs 20.5!

  (defcustom woman-use-extended-font t

      ;; Multibyte characters exist.
      (progn
	(goto-char (point-min))
	(while (search-forward "__\b\b" nil t)
	  (backward-delete-char 4)
	  (woman-set-face (point) (1+ (point)) 'woman-italic))
	(goto-char (point-min))
	(while (search-forward "\b\b__" nil t)
	  (backward-delete-char 4)
	  (woman-set-face (1- (point)) (point) 'woman-italic))))

  ;; Interpret overprinting to indicate bold face:
  (goto-char (point-min))
  (while (re-search-forward "\\(.\\)\\(\\(+\\1\\)+\\)" nil t)
    (woman-delete-match 2)
    (woman-set-face (1- (point)) (point) 'woman-bold))

  ;; Interpret underlining to indicate italic face:
  ;; (Must be AFTER emboldening to interpret bold _ correctly!)
  (goto-char (point-min))
  (while (search-forward "_" nil t)
    (delete-char -2)
    (woman-set-face (point) (1+ (point)) 'woman-italic))

  ;; Leave any other uninterpreted ^H's in the buffer for now!  (They
  ;; might indicate composite special characters, which could be
  ;; interpreted if I knew what to expect.)

  (cond
   (woman-bold-headings
    (goto-char (point-min))
    (forward-line)
    (while (re-search-forward "^\\(   \\)?\\([A-Z].*\\)" nil t)
      (woman-set-face (match-beginning 2) (match-end 2) 'woman-bold))))
  )

(defun woman-insert-file-contents (filename compressed)
  "Insert file FILENAME into the current buffer.
If COMPRESSED is t, or is non-nil and the filename implies compression,

    (setq woman-if-conditions-true
	  (cons (string-to-char (symbol-name woman-emulation)) '(?e ?o)))

    ;; Prepare non-underlined versions of underlined faces:
    (woman-non-underline-faces)
    ;; Set font of `woman-symbol' face to `woman-symbol-font' if
    ;; `woman-symbol-font' is well defined.
    (and woman-use-symbol-font
	 (stringp woman-symbol-font)
	 (set-face-font 'woman-symbol woman-symbol-font
			(and (frame-live-p woman-frame) woman-frame)))

    ;; Set syntax and display tables:
    (set-syntax-table woman-syntax-table)
    (woman-set-buffer-display-table)

	       (repl (if (or (= (aref esc 0) ?u)
			     (and (>= (length esc) 2) (= (aref esc 2) ?-)))
			 "^" "_")))
	  (cond (first
		 (replace-match repl nil t)
		 (put-text-property (1- (point)) (point) 'face 'woman-addition)
		 (WoMan-warn
		  "Initial vertical motion escape \\%s simulated" esc)
		 (WoMan-log
		  "      by TeX `%s' in woman-addition-face!" repl))
		(t

(defsubst woman-replace-match (newtext &optional face)
  "Replace text matched by last search with NEWTEXT and return t.
Set NEWTEXT in face FACE if specified."
  (woman-delete-match 0)
  (insert-before-markers newtext)
  (if face (put-text-property (1- (point)) (point) 'face 'woman-symbol))
  t)

(defun woman-special-characters (to)
  "Process special character escapes \\(xx, \\[xxx] up to buffer position TO.
\(This must be done AFTER translation, which may use special characters.)"

	   (cond ((and (cddr replacement)
		       (if (nthcdr 3 replacement)
			   ;; Need symbol font:
			   (if woman-use-symbol-font
			       (woman-replace-match (nth 2 replacement)
						    'woman-symbol))
			 ;; Need extended font:
			 (if woman-use-extended-font
			     (woman-replace-match (nth 2 replacement))))))
		 ((cadr replacement)	; Use ASCII simulation
		  (woman-replace-match (cadr replacement)))))

      (set-buffer standard-output)
      (let ((i 32))
	(while (< i 256)
	  (insert (format "\\%03o " i) (string i) " " (string i))
	  (put-text-property (1- (point)) (point)
			     'face 'woman-symbol)
	  (insert "   ")
	  (setq i (1+ i))
	  (when (= i 128) (setq i 160) (insert "\n"))
	  (if (zerop (% i 8)) (insert "\n")))
	))


;;; Direct font selection:

(defconst woman-font-alist
  '(("R" . default)
    ("I" . woman-italic)
    ("B" . woman-bold)
    ("P" . previous)
    ("1" . default)
    ("2" . woman-italic)
    ("3" . woman-bold)			; used in bash.1
    )
  "Alist of ?roff font indicators and woman font variables and names.")

(defun woman-change-fonts ()
  "Process font changes."

		      font (if font
			       (cdr font)
			     (WoMan-warn "Unknown font %s." fontstring)
			     ;; Output this message once only per call ...
			     (setq font-alist
				   (cons (cons fontstring 'woman-unknown)
					 font-alist))
			     'woman-unknown)
		      )))
	  ;; Delete font control line or escape sequence:
	  (cond (beg (delete-region beg (point))
		     (if (eq font 'previous) (setq font previous-font))))
	  (woman-set-face previous-pos (point) current-font)

			(buffer-substring start here))
	  (delete-region here (point)))
      ))
  ;; Embolden heading (point is at end of heading):
  (woman-set-face
   (save-excursion (beginning-of-line) (point)) (point) 'woman-bold)
  (forward-line)
  (delete-blank-lines)
  (setq woman-left-margin woman-default-indent)
  (setq woman-prevailing-indent woman-default-indent)
  (woman2-format-paragraphs to woman-left-margin))

  (woman-leave-blank-lines woman-interparagraph-distance)
  (setq woman-leave-blank-lines nil)
  ;; Optionally embolden heading (point is at beginning of heading):
  (if woman-bold-headings
      (woman-set-face
       (point) (save-excursion (end-of-line) (point)) 'woman-bold))
  (forward-line)
  (setq woman-left-margin woman-default-indent
	woman-nofill nil)		; fill output lines
  (setq woman-prevailing-indent woman-default-indent)
  (woman2-format-paragraphs to woman-left-margin))