comparison lisp/woman.el @ 111407:672ffe880560

Quiet, woman. (Sorry...). * lisp/woman.el (woman0-roff-buffer, woman1-roff-buffer) (woman2-roff-buffer): Give local variable `request' a prefix. (woman0-macro): Rename argument `request' in the same way. (woman-request): New name for `request' dynamic variable. (woman-unquote, woman-forward-arg): Update for above name change. (woman1-roff-buffer): Give local variable `unquote' a prefix. (woman1-unquote): New name for `unquote' dynamic variable. (woman1-B-or-I, woman1-alt-fonts): Update for above name change. (woman-translations): Rename from `translations'. No longer global. (woman2-tr, woman-translate): Update for above name change. (woman-translate): Check for bound variable. (woman2-roff-buffer): Give local variable `translations' a prefix.

111406:86b26e5fe3fc

(defun woman0-roff-buffer (from)
  "Process conditional-type requests and user-defined macros.
Start at FROM and re-scan new text as appropriate."
  (goto-char from)
  (let ((woman0-if-to (make-marker))
	request woman0-macro-alist
	(woman0-search-regex-start woman0-search-regex-start)
	(woman0-search-regex
	 (concat woman0-search-regex-start woman0-search-regex-end))
	woman0-rename-alist)
    (set-marker-insertion-type woman0-if-to t)
    (while (re-search-forward woman0-search-regex nil t)
      (setq request (match-string 1))
      (cond ((string= request "ig") (woman0-ig))
	    ((string= request "if") (woman0-if "if"))
	    ((string= request "ie") (woman0-if "ie"))
	    ((string= request "el") (woman0-el))
	    ((string= request "so") (woman0-so))
	    ((string= request "rn") (woman0-rn))
	    ((string= request "de") (woman0-de))
	    ((string= request "am") (woman0-de 'append))
	    (t                      (woman0-macro request))))
    (set-marker woman0-if-to nil)
    (woman0-rename)
    ;; Should now re-run `woman0-roff-buffer' if any renaming was
    ;; done, but let's just hope this is not necessary for now!
    ))

  (while (re-search-forward "\\\\f\\(\\[[^]]+\\]\\|(..\\|.\\)" to t)
    (woman-delete-match 0))
  (goto-char from)			; necessary!
  (woman2-process-escapes to 'numeric))

(defun woman0-if (request)
  ".if/ie c anything -- Discard unless c evaluates to true.
Remember condition for use by a subsequent `.el'.
REQUEST is the invoking directive without the leading dot."
  ;; c evaluates to a one-character built-in condition name or

      (goto-char from)))
    (if (eq c 0)
	(woman-if-ignore woman0-if-to request) ; ERROR!
      (woman-if-body request woman0-if-to (eq c negated)))))

(defun woman-if-body (request to delete) ; should be reversed as `accept'?
  "Process if-body, including \\{ ... \\}.
REQUEST is the invoking directive without the leading dot.
If TO is non-nil then delete the if-body.
If DELETE is non-nil then delete from point."

	 ;; This does not work too well, but it's only for debugging!
	 (skip-chars-forward "^ \t")
	 (if (looking-at "[ \t]*\\{") (search-forward "\\}"))
	 (forward-line 1))))

(defun woman-if-ignore (to request)
  "Ignore but warn about an if request ending at TO, named REQUEST."
  (WoMan-warn-ignored request "ignored -- condition not handled!")
  (if woman-ignore
      (woman-if-body request to t)

      (delete-region from (point))
      (backward-char)))			; return to end of .de/am line
  (beginning-of-line)			; delete .de/am line
  (woman-delete-line 1))

(defun woman0-macro (request)
  "Process the macro call named REQUEST."
  ;; Leaves point at start of new text.
  (let ((macro (assoc request woman0-macro-alist)))
    (if macro
	(woman-interpolate-macro (cdr macro))
      ;; SHOULD DELETE THE UNINTERPRETED REQUEST!!!!!
      ;; Output this message once only per call (cf. strings)?
      (WoMan-warn "Undefined macro %s not interpolated!" request))))

(defun woman-interpolate-macro (macro)
  "Interpolate (.de) or append (.am) expansion of MACRO into the buffer."
  ;; Could make this more efficient by checking which arguments are
  ;; actually used in the expansion!

    (help-print-return-message)))


;;; Formatting macros that do not cause a break:

(defvar request)  ; Bound locally by woman1-roff-buffer
(defvar unquote)  ; Bound locally by woman1-roff-buffer

(defun woman-unquote (to)
  "Delete any double-quote characters between point and TO.
Leave point at TO (which should be a marker)."
  (let (in-quote)

	(if (or in-quote (looking-at ".*\"")) ; paired
	    (delete-char -1))
	(setq in-quote (not in-quote))
	))
    (if in-quote
	(WoMan-warn "Unpaired \" in .%s arguments." request))))

(defsubst woman-unquote-args ()
  "Delete any double-quote characters up to the end of the line."
  (woman-unquote (save-excursion (end-of-line) (point-marker))))

(defun woman1-roff-buffer ()
  "Process non-breaking requests."
  (let ((case-fold-search t)
	request fn unquote)
    (while
	;; Find next control line:
	(re-search-forward woman-request-regexp nil t)
      (cond
       ;; Construct woman function to call:
       ((setq fn (intern-soft
		  (concat "woman1-"
			  (setq request (match-string 1)))))
	(if (get fn 'notfont)		; not a font-change request
	    (funcall fn)
	  ;; Delete request or macro name:
	  (woman-delete-match 0)
	  ;; If no args then apply to next line else unquote args
	  ;; (unquote is used by called function):
	  (setq unquote (not (eolp)))
	  (if (eolp) (delete-char 1))
;	    ;; Hide leading control character in unquoted argument:
;	    (cond ((memq (following-char) '(?. ?'))
;		   (insert "\\&")
;		   (beginning-of-line)))
	  ;; Call the appropriate function:
	  (funcall fn)
	  ;; Hide leading control character in quoted argument (only):
	  (if (and unquote (memq (following-char) '(?. ?')))
	      (insert "\\&"))))))))

;;; Font-changing macros:

(defun woman1-B ()

  (woman1-B-or-I ".ft B\n"))

(defun woman1-I ()
  ".I -- Set words of current line in italic font."
  (woman1-B-or-I ".ft I\n"))

(defun woman1-B-or-I (B-or-I)
  ".B/I -- Set words of current line in bold/italic font.
B-OR-I is the appropriate complete control line."
  ;; Should NOT concatenate the arguments!
  (insert B-or-I) ; because it might be a control line
  ;; Return to bol to process .SM/.B, .B/.if etc.
  ;; or start of first arg to hide leading control char.
  (save-excursion
    (if unquote
	(woman-unquote-args)
      (while (looking-at "^[.']") (forward-line))
      (end-of-line)
      (delete-horizontal-space))
    (insert "\\fR")))

  (nconc fonts fonts)			; circular list!
  (insert (car fonts))
  ;; Return to start of first arg to hide leading control char:
  (save-excursion
    (setq fonts (cdr fonts))
    (woman-forward-arg unquote 'concat)	; unquote is bound above
    (while (not (eolp))
      (insert (car fonts))
      (setq fonts (cdr fonts))
      (woman-forward-arg unquote 'concat)) ; unquote is bound above
    (insert "\\fR")))

(defun woman-forward-arg (&optional unquote concat)
  "Move forward over one ?roff argument, optionally unquoting and/or joining.
If optional arg UNQUOTE is non-nil then delete any argument quotes.

	(while (eq (following-char) ?\") ; paired
	  (if unquote (delete-char 1) (forward-char))
	  (re-search-forward "\"\\|$"))
	(if (eq (preceding-char) ?\")
	    (if unquote (delete-char -1))
	  (WoMan-warn "Unpaired \" in .%s arguments." request)))
    ;; (re-search-forward "[^\\\n] \\|$")	; inconsistent
    (skip-syntax-forward "^ "))
  (cond ((null concat) (skip-chars-forward " \t")) ; don't skip eol!
	((eq concat 'noskip))  ; do not skip following whitespace
	(t (woman-delete-following-space))))

	(put-text-property from to 'face face))))


;;; Output translation:

(defvar translations nil)  ; Also bound locally by woman2-roff-buffer
;; A list of the form (\"[ace]\" (a . b) (c . d) (e . ?\ )) or nil.

(defun woman-get-next-char ()
  "Return and delete next char in buffer, including special chars."
  (if ;;(looking-at "\\\\(\\(..\\)")

Format paragraphs upto TO.  Supports special chars.
\(Breaks, but should not.)"
  ;; This should be an update, but consing onto the front of the alist
  ;; has the same effect and match duplicates should not matter.
  ;; Initialize translation data structures:
  (let ((matches (car translations))
	(alist (cdr translations))
	a b)
    ;; `matches' must be a string:
    (setq matches
	  (concat (if matches (substring matches 1 -1)) "]"))
    ;; Process .tr arguments:

    ;; Rebuild translations list:
    (setq matches
	  (if (= (string-to-char matches) ?\])
	      (substring matches 3)
	    (concat "[" matches))
	  translations (cons matches alist))
    ;; Format any following text:
    (woman2-format-paragraphs to)))

(defsubst woman-translate (to)
  "Translate up to marker TO.  Do this last of all transformations."
  (if translations
      (let ((matches (car translations))
	    (alist (cdr translations))
	    ;; Translations are case-sensitive, eg ".tr ab" does not
	    ;; affect "A" (bug#6849).
	    (case-fold-search nil))
	(while (re-search-forward matches to t)
	  ;; Done like this to retain text properties and

	(canonically-space-region
	 (symbol-function 'canonically-space-region))
	(insert-and-inherit (symbol-function 'insert-and-inherit))
	(set-text-properties (symbol-function 'set-text-properties))
	(woman-registers woman-registers)
	fn request translations
	tab-stop-list)
    (set-marker-insertion-type to t)
    ;; ?roff does not squeeze multiple spaces, but does fill, so...
    (fset 'canonically-space-region 'ignore)
    ;; Try to avoid spaces inheriting underlines from preceding text!

            (re-search-forward woman-request-regexp nil t)
          (cond
           ;; Construct woman function to call:
           ((setq fn (intern-soft
                      (concat "woman2-"
                              (setq request (match-string 1)))))
            ;; Delete request or macro name:
            (woman-delete-match 0))
           ;; Unrecognised request:
           ((prog1 nil
              ;; (WoMan-warn ".%s request ignored!" request)
              (WoMan-warn-ignored request "ignored!")
              ;; (setq fn 'woman2-LP)
              ;; AVOID LEAVING A BLANK LINE!
              ;; (setq fn 'woman2-format-paragraphs)
              ))
           ;; .LP assumes it is at eol and leaves a (blank) line,

(defun WoMan-warn (format &rest args)
  "Log a warning message out of FORMAT control string and optional ARGS."
  (setq format (apply 'format format args))
  (WoMan-log-1 (concat "**  " format)))

(defun WoMan-warn-ignored (request ignored)
  "Log a warning message about ignored directive REQUEST.
IGNORED is a string appended to the log message."
  (let ((tail
	 (buffer-substring (point)

    (bookmark-default-handler
     `("" (buffer . ,buf) . ,(bookmark-get-bookmark-record bookmark)))))

(provide 'woman)

;; arch-tag: eea35e90-552f-4712-a94b-d9ffd3db7651
;;; woman.el ends here

111407:672ffe880560

(defun woman0-roff-buffer (from)
  "Process conditional-type requests and user-defined macros.
Start at FROM and re-scan new text as appropriate."
  (goto-char from)
  (let ((woman0-if-to (make-marker))
	woman-request woman0-macro-alist
	(woman0-search-regex-start woman0-search-regex-start)
	(woman0-search-regex
	 (concat woman0-search-regex-start woman0-search-regex-end))
	woman0-rename-alist)
    (set-marker-insertion-type woman0-if-to t)
    (while (re-search-forward woman0-search-regex nil t)
      (setq woman-request (match-string 1))
      (cond ((string= woman-request "ig") (woman0-ig))
	    ((string= woman-request "if") (woman0-if "if"))
	    ((string= woman-request "ie") (woman0-if "ie"))
	    ((string= woman-request "el") (woman0-el))
	    ((string= woman-request "so") (woman0-so))
	    ((string= woman-request "rn") (woman0-rn))
	    ((string= woman-request "de") (woman0-de))
	    ((string= woman-request "am") (woman0-de 'append))
	    (t                      (woman0-macro woman-request))))
    (set-marker woman0-if-to nil)
    (woman0-rename)
    ;; Should now re-run `woman0-roff-buffer' if any renaming was
    ;; done, but let's just hope this is not necessary for now!
    ))

  (while (re-search-forward "\\\\f\\(\\[[^]]+\\]\\|(..\\|.\\)" to t)
    (woman-delete-match 0))
  (goto-char from)			; necessary!
  (woman2-process-escapes to 'numeric))

;; request does not appear to be used dynamically by any callees.
(defun woman0-if (request)
  ".if/ie c anything -- Discard unless c evaluates to true.
Remember condition for use by a subsequent `.el'.
REQUEST is the invoking directive without the leading dot."
  ;; c evaluates to a one-character built-in condition name or

      (goto-char from)))
    (if (eq c 0)
	(woman-if-ignore woman0-if-to request) ; ERROR!
      (woman-if-body request woman0-if-to (eq c negated)))))

;; request is not used dynamically by any callees.
(defun woman-if-body (request to delete) ; should be reversed as `accept'?
  "Process if-body, including \\{ ... \\}.
REQUEST is the invoking directive without the leading dot.
If TO is non-nil then delete the if-body.
If DELETE is non-nil then delete from point."

	 ;; This does not work too well, but it's only for debugging!
	 (skip-chars-forward "^ \t")
	 (if (looking-at "[ \t]*\\{") (search-forward "\\}"))
	 (forward-line 1))))

;; request is not used dynamically by any callees.
(defun woman-if-ignore (to request)
  "Ignore but warn about an if request ending at TO, named REQUEST."
  (WoMan-warn-ignored request "ignored -- condition not handled!")
  (if woman-ignore
      (woman-if-body request to t)

      (delete-region from (point))
      (backward-char)))			; return to end of .de/am line
  (beginning-of-line)			; delete .de/am line
  (woman-delete-line 1))

;; request may be used dynamically (woman-interpolate-macro calls
;; woman-forward-arg).
(defun woman0-macro (woman-request)
  "Process the macro call named WOMAN-REQUEST."
  ;; Leaves point at start of new text.
  (let ((macro (assoc woman-request woman0-macro-alist)))
    (if macro
	(woman-interpolate-macro (cdr macro))
      ;; SHOULD DELETE THE UNINTERPRETED REQUEST!!!!!
      ;; Output this message once only per call (cf. strings)?
      (WoMan-warn "Undefined macro %s not interpolated!" woman-request))))

(defun woman-interpolate-macro (macro)
  "Interpolate (.de) or append (.am) expansion of MACRO into the buffer."
  ;; Could make this more efficient by checking which arguments are
  ;; actually used in the expansion!

    (help-print-return-message)))


;;; Formatting macros that do not cause a break:

;; Bound locally by woman[012]-roff-buffer, and also, annoyingly and
;; confusingly, as a function argument.  Use dynamically in
;; woman-unquote and woman-forward-arg.
(defvar woman-request)

(defun woman-unquote (to)
  "Delete any double-quote characters between point and TO.
Leave point at TO (which should be a marker)."
  (let (in-quote)

	(if (or in-quote (looking-at ".*\"")) ; paired
	    (delete-char -1))
	(setq in-quote (not in-quote))
	))
    (if in-quote
	(WoMan-warn "Unpaired \" in .%s arguments." woman-request))))

(defsubst woman-unquote-args ()
  "Delete any double-quote characters up to the end of the line."
  (woman-unquote (save-excursion (end-of-line) (point-marker))))

(defun woman1-roff-buffer ()
  "Process non-breaking requests."
  (let ((case-fold-search t)
	woman-request fn woman1-unquote)
    (while
	;; Find next control line:
	(re-search-forward woman-request-regexp nil t)
      (cond
       ;; Construct woman function to call:
       ((setq fn (intern-soft
		  (concat "woman1-"
			  (setq woman-request (match-string 1)))))
	(if (get fn 'notfont)		; not a font-change request
	    (funcall fn)
	  ;; Delete request or macro name:
	  (woman-delete-match 0)
	  ;; If no args then apply to next line else unquote args
	  ;; (woman1-unquote is used by called function):
	  (setq woman1-unquote (not (eolp)))
	  (if (eolp) (delete-char 1))
;	    ;; Hide leading control character in unquoted argument:
;	    (cond ((memq (following-char) '(?. ?'))
;		   (insert "\\&")
;		   (beginning-of-line)))
	  ;; Call the appropriate function:
	  (funcall fn)
	  ;; Hide leading control character in quoted argument (only):
	  (if (and woman1-unquote (memq (following-char) '(?. ?')))
	      (insert "\\&"))))))))

;;; Font-changing macros:

(defun woman1-B ()

  (woman1-B-or-I ".ft B\n"))

(defun woman1-I ()
  ".I -- Set words of current line in italic font."
  (woman1-B-or-I ".ft I\n"))

(defvar woman1-unquote)          ; bound locally by woman1-roff-buffer

(defun woman1-B-or-I (B-or-I)
  ".B/I -- Set words of current line in bold/italic font.
B-OR-I is the appropriate complete control line."
  ;; Should NOT concatenate the arguments!
  (insert B-or-I) ; because it might be a control line
  ;; Return to bol to process .SM/.B, .B/.if etc.
  ;; or start of first arg to hide leading control char.
  (save-excursion
    (if woman1-unquote
	(woman-unquote-args)
      (while (looking-at "^[.']") (forward-line))
      (end-of-line)
      (delete-horizontal-space))
    (insert "\\fR")))

  (nconc fonts fonts)			; circular list!
  (insert (car fonts))
  ;; Return to start of first arg to hide leading control char:
  (save-excursion
    (setq fonts (cdr fonts))
    ;; woman1-unquote is bound in woman1-roff-buffer.
    (woman-forward-arg woman1-unquote 'concat)
    (while (not (eolp))
      (insert (car fonts))
      (setq fonts (cdr fonts))
      (woman-forward-arg woman1-unquote 'concat))
    (insert "\\fR")))

(defun woman-forward-arg (&optional unquote concat)
  "Move forward over one ?roff argument, optionally unquoting and/or joining.
If optional arg UNQUOTE is non-nil then delete any argument quotes.

	(while (eq (following-char) ?\") ; paired
	  (if unquote (delete-char 1) (forward-char))
	  (re-search-forward "\"\\|$"))
	(if (eq (preceding-char) ?\")
	    (if unquote (delete-char -1))
	  (WoMan-warn "Unpaired \" in .%s arguments." woman-request)))
    ;; (re-search-forward "[^\\\n] \\|$")	; inconsistent
    (skip-syntax-forward "^ "))
  (cond ((null concat) (skip-chars-forward " \t")) ; don't skip eol!
	((eq concat 'noskip))  ; do not skip following whitespace
	(t (woman-delete-following-space))))

	(put-text-property from to 'face face))))


;;; Output translation:

;; This is only set by woman2-tr.  It is bound locally in woman2-roff-buffer.
;; It is also used by woman-translate.  woman-translate may be called
;; outside the scope of woman2-roff-buffer (by experiment).  Therefore
;; this used to be globally bound to nil, to avoid an error.  Instead
;; we can use bound-and-true-p in woman-translate.
(defvar woman-translations)
;; A list of the form (\"[ace]\" (a . b) (c . d) (e . ?\ )) or nil.

(defun woman-get-next-char ()
  "Return and delete next char in buffer, including special chars."
  (if ;;(looking-at "\\\\(\\(..\\)")

Format paragraphs upto TO.  Supports special chars.
\(Breaks, but should not.)"
  ;; This should be an update, but consing onto the front of the alist
  ;; has the same effect and match duplicates should not matter.
  ;; Initialize translation data structures:
  (let ((matches (car woman-translations))
	(alist (cdr woman-translations))
	a b)
    ;; `matches' must be a string:
    (setq matches
	  (concat (if matches (substring matches 1 -1)) "]"))
    ;; Process .tr arguments:

    ;; Rebuild translations list:
    (setq matches
	  (if (= (string-to-char matches) ?\])
	      (substring matches 3)
	    (concat "[" matches))
	  woman-translations (cons matches alist))
    ;; Format any following text:
    (woman2-format-paragraphs to)))

(defsubst woman-translate (to)
  "Translate up to marker TO.  Do this last of all transformations."
  (if (bound-and-true-p woman-translations)
      (let ((matches (car woman-translations))
	    (alist (cdr woman-translations))
	    ;; Translations are case-sensitive, eg ".tr ab" does not
	    ;; affect "A" (bug#6849).
	    (case-fold-search nil))
	(while (re-search-forward matches to t)
	  ;; Done like this to retain text properties and

	(canonically-space-region
	 (symbol-function 'canonically-space-region))
	(insert-and-inherit (symbol-function 'insert-and-inherit))
	(set-text-properties (symbol-function 'set-text-properties))
	(woman-registers woman-registers)
	fn woman-request woman-translations
	tab-stop-list)
    (set-marker-insertion-type to t)
    ;; ?roff does not squeeze multiple spaces, but does fill, so...
    (fset 'canonically-space-region 'ignore)
    ;; Try to avoid spaces inheriting underlines from preceding text!

            (re-search-forward woman-request-regexp nil t)
          (cond
           ;; Construct woman function to call:
           ((setq fn (intern-soft
                      (concat "woman2-"
                              (setq woman-request (match-string 1)))))
            ;; Delete request or macro name:
            (woman-delete-match 0))
           ;; Unrecognised request:
           ((prog1 nil
              ;; (WoMan-warn ".%s request ignored!" woman-request)
              (WoMan-warn-ignored woman-request "ignored!")
              ;; (setq fn 'woman2-LP)
              ;; AVOID LEAVING A BLANK LINE!
              ;; (setq fn 'woman2-format-paragraphs)
              ))
           ;; .LP assumes it is at eol and leaves a (blank) line,

(defun WoMan-warn (format &rest args)
  "Log a warning message out of FORMAT control string and optional ARGS."
  (setq format (apply 'format format args))
  (WoMan-log-1 (concat "**  " format)))

;; request is not used dynamically by any callees.
(defun WoMan-warn-ignored (request ignored)
  "Log a warning message about ignored directive REQUEST.
IGNORED is a string appended to the log message."
  (let ((tail
	 (buffer-substring (point)

    (bookmark-default-handler
     `("" (buffer . ,buf) . ,(bookmark-get-bookmark-record bookmark)))))

(provide 'woman)

;;; woman.el ends here