comparison lisp/play/handwrite.el @ 73939:99f3f0fdefd0

(handwrite): Also process lines not ending with newline. Replace some position-fiddling with different logic. Improve performance.

73938:7ee3eb5213bb

       (ipage 1)
       (nlan next-line-add-newlines)	;remember the old value
       (buf-name (buffer-name) )
       (textp)
       (ps-buf-name)			;name of the PostScript buffer
       )
    (goto-char (point-min))		;start at beginning
    (setq handwrite-psindex (1+ handwrite-psindex))
    (setq ps-buf-name
	  (format "*handwritten%d.ps*" handwrite-psindex))
    (setq next-line-add-newlines t)

    (insert "xym( )a")
    (backward-char 3)
    (switch-to-buffer cur-buf)
    (goto-char (point-min))		;start at beginning
    (save-excursion
      ;;as long as we see a newline the document is not ended.
      (while (re-search-forward "\n" nil t)
	(previous-line 1)
	(beginning-of-line)
	(setq pmin (point))
	(search-forward "\n" nil t)
	(backward-char 1)
	(copy-region-as-kill (point) pmin)
	(forward-char 1)
	(switch-to-buffer ps-buf-name)
	(yank)
	(message "write write write...")
	(search-forward ")a" nil t)
	(backward-char 2)
	(setq lastp (point))
	(beginning-of-line)
	(search-forward "(" nil t)
	(while (re-search-forward "[()\\]" lastp t)
	  (save-excursion
	    (setq lastp (+ lastp 1))
	    (forward-char -1)
	    (insert "\\")))
	(setq ps-ypos (+ ps-ypos handwrite-linespace))
	(end-of-line)
	(insert "\n")
	(setq lcount (+ lcount 1))
	(cond ( (eq lcount handwrite-numlines)
		(setq ipage (+ ipage 1))
		(insert "0 0  m\n")
		(insert "showpage exec Hwsave restore\n")
		(insert "%%Page: " (number-to-string ipage) " "
			(number-to-string ipage) "\n")
		(insert "Hwjst\n")
		(insert "/Hwsave save def\n")
		(if handwrite-pagenumbering
		    (insert "20 30 m\nxym(page "
			    (number-to-string ipage) ")a\n"))
		(setq ps-ypos 63)
		(setq lcount 0)
		))
	(insert "44 "(number-to-string ps-ypos) " m\n")
	(insert "xym( )a")
	(backward-char 3)
	(switch-to-buffer cur-buf)
	))
    (switch-to-buffer ps-buf-name)
    (next-line 1)
    (insert "showpage exec Hwsave restore\n\n")
    (insert "%%Pages " (number-to-string ipage) " 0\n")
    (insert "%%EOF\n")
    (goto-char textp)			;start where the inserted text begins
    (while (search-forward "ÿ" nil t)
      (replace-match "\\" nil t) (insert "264"))
    (goto-char textp)
    (while (search-forward "á" nil t)
      (replace-match "\\" nil t) (insert "207"))
    (goto-char textp)
    (while (search-forward "à" nil t)
      (replace-match "\\" nil t) (insert "210"))
    (goto-char textp)
    (while (search-forward "â" nil t)
      (replace-match "\\" nil t) (insert "211"))
    (goto-char textp)
    (while (search-forward "ä" nil t)
      (replace-match "\\" nil t) (insert "212"))
    (goto-char textp)
    (while (search-forward "ã" nil t)
      (replace-match "\\" nil t) (insert "213"))
    (goto-char textp)
    (while (search-forward "å" nil t)
      (replace-match "\\" nil t) (insert "214"))
    (goto-char textp)
    (while (search-forward "é" nil t)
      (replace-match "\\" nil t) (insert "216"))
    (goto-char textp)
    (while (search-forward "è" nil t)
      (replace-match "\\" nil t) (insert "217"))
    (goto-char textp)
    (while (search-forward "ê" nil t)
      (replace-match "\\" nil t) (insert "220"))
    (goto-char textp)
    (while (search-forward "ë" nil t)
      (replace-match "\\" nil t) (insert "221"))
    (goto-char textp)
    (while (search-forward "í" nil t)
      (replace-match "\\" nil t) (insert "222"))
    (goto-char textp)
    (while (search-forward "ì" nil t)
      (replace-match "\\" nil t) (insert "223"))
    (goto-char textp)
    (while (search-forward "î" nil t)
      (replace-match "\\" nil t) (insert "224"))
    (goto-char textp)
    (while (search-forward "ï" nil t)
      (replace-match "\\" nil t) (insert "225"))
    (goto-char textp)
    (while (search-forward "ó" nil t)
      (replace-match "\\" nil t) (insert "227"))
    (goto-char textp)
    (while (search-forward "ò" nil t)
      (replace-match "\\" nil t) (insert "230"))
    (goto-char textp)
    (while (search-forward "ô" nil t)
      (replace-match "\\" nil t) (insert "231"))
    (goto-char textp)
    (while (search-forward "ö" nil t)
      (replace-match "\\" nil t) (insert "232"))
    (goto-char textp)
    (while (search-forward "õ" nil t)
      (replace-match "\\" nil t) (insert "233"))
    (goto-char textp)
    (while (search-forward "ú" nil t)
      (replace-match "\\" nil t) (insert "234"))
    (goto-char textp)
    (while (search-forward "ù" nil t)
      (replace-match "\\" nil t) (insert "235"))
    (goto-char textp)
    (while (search-forward "û" nil t)
      (replace-match "\\" nil t) (insert "236"))
    (goto-char textp)
    (while (search-forward "ü" nil t)
      (replace-match "\\" nil t) (insert "237"))
    (goto-char textp)
    (while (search-forward "ß" nil t)
      (replace-match "\\" nil t) (insert "247"))
    (goto-char textp)
    (while (search-forward "°" nil t)
      (replace-match "\\" nil t) (insert "241"))
    (goto-char textp)
    (while (search-forward "®" nil t)
      (replace-match "\\" nil t) (insert "250"))
    (goto-char textp)
    (while (search-forward "©" nil t)
      (replace-match "\\" nil t) (insert "251"))
    (goto-char textp)
    (while (search-forward "ij" nil t)
      (replace-match "\\" nil t) (insert "264"))
    (goto-char textp)
    (while (search-forward "ç" nil t)
      (replace-match "\\" nil t) (insert "215"))
    (goto-char textp)
    (while (search-forward "§" nil t)
      (replace-match "\\" nil t) (insert "244"))
    (goto-char textp)
    (while (search-forward "ñ" nil t)
      (replace-match "\\" nil t) (insert "226"))
    (goto-char textp)
    (while (search-forward "£" nil t)
      (replace-match "\\" nil t) (insert "243"))
    ;;To avoid cumbersome code we simply ignore pagefeeds
    (goto-char textp)
    (while (search-forward "\f" nil t)
      (replace-match "" nil t) )
    (untabify textp (point-max))	; this may result in strange tabs

				      (and (boundp 'printer-name)
					   printer-name)))
		 (ps-lpr-switches
		  (if (stringp ps-printer-name)
		      (list (concat "-P" ps-printer-name)))))
	    (apply (or ps-print-region-function 'call-process-region)
		   (point-min) (point-max) ps-lpr-command nil nil nil))))
    (message "")
    (bury-buffer ())
    (switch-to-buffer cur-buf)
    (goto-char tpoint)

73939:99f3f0fdefd0

       (ipage 1)
       (nlan next-line-add-newlines)	;remember the old value
       (buf-name (buffer-name) )
       (textp)
       (ps-buf-name)			;name of the PostScript buffer
       (trans-table
	'(("ÿ" . "264") ("á" . "207") ("à" . "210") ("â" . "211")
	  ("ä" . "212") ("ã" . "213") ("å" . "214") ("é" . "216")
	  ("è" . "217") ("ê" . "220") ("ë" . "221") ("í" . "222")
	  ("ì" . "223") ("î" . "224") ("ï" . "225") ("ó" . "227")
	  ("ò" . "230") ("ô" . "231") ("ö" . "232") ("õ" . "233")
	  ("ú" . "234") ("ù" . "235") ("û" . "236") ("ü" . "237")
	  ("ß" . "247") ("°" . "241") ("®" . "250") ("©" . "251")
	  ("ij" . "264") ("ç" . "215") ("§" . "244") ("ñ" . "226")
	  ("£" . "243")))
       (escape-table '("\\\\" "(" ")")) ; \\ comes first to not work
					; on inserted backslashes
       line)
    (goto-char (point-min))		;start at beginning
    (setq handwrite-psindex (1+ handwrite-psindex))
    (setq ps-buf-name
	  (format "*handwritten%d.ps*" handwrite-psindex))
    (setq next-line-add-newlines t)

    (insert "xym( )a")
    (backward-char 3)
    (switch-to-buffer cur-buf)
    (goto-char (point-min))		;start at beginning
    (save-excursion
      (while (not (eobp))
	(setq line (thing-at-point 'line))
	(dolist (escape escape-table)
	  (setq line (replace-regexp-in-string escape
					       (concat "\\\\" escape) line)))
	(dolist (trans trans-table)
	  (setq line (replace-regexp-in-string (car trans)
					       (concat "\\\\" (cdr trans))
					       line)))
	(switch-to-buffer ps-buf-name)
	(insert (replace-regexp-in-string "\n" "" line))
	(message "write write write...")
	(setq ps-ypos (+ ps-ypos handwrite-linespace))
	(end-of-line)
	(insert "\n")
	(setq lcount (+ lcount 1))
	(when (= lcount handwrite-numlines)
	  (setq ipage (+ ipage 1))
	  (insert "0 0  m\n")
	  (insert "showpage exec Hwsave restore\n")
	  (insert "%%Page: " (number-to-string ipage) " "
		  (number-to-string ipage) "\n")
	  (insert "Hwjst\n")
	  (insert "/Hwsave save def\n")
	  (if handwrite-pagenumbering
	      (insert "20 30 m\nxym(page "
		      (number-to-string ipage) ")a\n"))
	  (setq ps-ypos 63)
	  (setq lcount 0))
	(insert "44 " (number-to-string ps-ypos) " m\n")
	(insert "xym( )a")
	(backward-char 3)
	(switch-to-buffer cur-buf)
	(forward-line 1)
	))
    (switch-to-buffer ps-buf-name)
    (next-line 1)
    (insert "showpage exec Hwsave restore\n\n")
    (insert "%%Pages " (number-to-string ipage) " 0\n")
    (insert "%%EOF\n")
    ;;To avoid cumbersome code we simply ignore pagefeeds
    (goto-char textp)
    (while (search-forward "\f" nil t)
      (replace-match "" nil t) )
    (untabify textp (point-max))	; this may result in strange tabs

				      (and (boundp 'printer-name)
					   printer-name)))
		 (ps-lpr-switches
		  (if (stringp ps-printer-name)
		      (list (concat "-P" ps-printer-name)))))
	    (apply (or (and (boundp 'ps-print-region-function)
			    ps-print-region-function)
		       'call-process-region)
		   (point-min) (point-max) ps-lpr-command nil nil nil))))
    (message "")
    (bury-buffer ())
    (switch-to-buffer cur-buf)
    (goto-char tpoint)