Trailing whitepace deleted.

[bpt/emacs.git] / lisp / play / handwrite.el

;;; handwrite.el --- turns your emacs buffer into a handwritten document -*- coding: iso-latin-1; -*-

;; (C) Copyright 1996 Free Software Foundation, Inc.

;; Author: Danny Roozendaal (was: <danny@tvs.kun.nl>)
;; Created: October 21 1996
;; Keywords: wp, print, postscript, cursive writing

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; The function handwrite creates PostScript output containing a
;; handwritten version of the current buffer..
;; Other functions that may be useful are
;;
;;      handwrite-10pt: sets the font size to 10 and finds corresponding
;;                      values for the line spacing and the number of lines
;;                      on a page.
;;      handwrite-11pt: which is similar
;;      handwrite-12pt: which is also similar
;;      handwrite-13pt: which is similar, too
;;
;;      handwrite-set-pagenumber: set and unset page numbering
;;
;;
;; If you are not satisfied with the type page there are a number of
;; variables you may want to set.
;;
;;
;;  Installation
;;
;; type at your prompt "emacs -l handwrite.el" or put this file on your
;; Emacs-Lisp load path,  add the following into your ~/.emacs startup file
;;
;;                (require 'handwrite)
;;
;; "M-x handwrite"  or "Write by hand"  in the edit menu should work now.
;;
;;
;; I tried to make it `iso_8859_1'-friendly, but there are some exotic
;; characters missing.
;;
;;
;; Known bugs: -Page feeds do not do their work, but are ignored instead.
;;             -Tabs are not always properly displayed.
;;             -Handwrite may create corrupt PostScript if it encounters
;;              unknown characters.
;;
;; Thanks to anyone who emailed me suggestions!
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;; Code:


;; Variables

(defgroup handwrite nil
  "Turns your emacs buffer into a handwritten document."
  :prefix "handwrite-"
  :group 'games)

(defvar handwrite-psindex 0
  "The index of the PostScript buffer.")
(defvar menu-bar-handwrite-map (make-sparse-keymap "Handwrite functions."))
(fset 'menu-bar-handwrite-map (symbol-value 'menu-bar-handwrite-map))


;; User definable variables

(defcustom handwrite-numlines 60
  "*The number of lines on a page of the PostScript output from `handwrite'."
  :type 'integer
  :group 'handwrite)
(defcustom handwrite-fontsize 11
  "*The size of the font for the PostScript output from `handwrite'."
  :type 'integer
  :group 'handwrite)
(defcustom handwrite-linespace 12
  "*The spacing for the PostScript output from `handwrite'."
  :type 'integer
  :group 'handwrite)
(defcustom handwrite-xstart 30
  "*X-axis translation in the PostScript output from `handwrite'."
  :type 'integer
  :group 'handwrite)
(defcustom handwrite-ystart 810
  "*Y-axis translation in the PostScript output from `handwrite'."
  :type 'integer
  :group 'handwrite)
(defcustom handwrite-pagenumbering nil
  "*If non-nil, number each page of the PostScript output from `handwrite'."
  :type 'boolean
  :group 'handwrite)
(defcustom handwrite-10pt-numlines 65
  "*The number of lines on a page for the function `handwrite-10pt'."
  :type 'integer
  :group 'handwrite)
(defcustom handwrite-11pt-numlines 60
  "*The number of lines on a page for the function `handwrite-11pt'."
  :type 'integer
  :group 'handwrite)
(defcustom handwrite-12pt-numlines 55
  "*The number of lines on a page for the function `handwrite-12pt'."
  :type 'integer
  :group 'handwrite)
(defcustom handwrite-13pt-numlines 50
  "*The number of lines on a page for the function `handwrite-13pt'."
  :type 'integer
  :group 'handwrite)

;; Interactive functions

;;;###autoload
(defun handwrite ()
  "Turns the buffer into a \"handwritten\" document.
The functions `handwrite-10pt', `handwrite-11pt', `handwrite-12pt'
and `handwrite-13pt' set up for various sizes of output.

Variables: handwrite-linespace     (default 12)
           handwrite-fontsize      (default 11)
           handwrite-numlines      (default 60)
           handwrite-pagenumbering (default nil)"
  (interactive)
  (let
      ((pmin)				; thanks, Havard
       (lastp)
       (cur-buf (current-buffer))
       (tpoint (point))
       (ps-ypos 63)
       (lcount 0)
       (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)
    (switch-to-buffer ps-buf-name)
    (handwrite-insert-header buf-name)
    (insert "\n(\\nCreated by GNU Emacs' handwrite version "
	    emacs-version  "\\n\\n)=print flush\n")
    (handwrite-insert-preamble)
    (handwrite-insert-info)
    (handwrite-insert-font)
    (setq textp (point))
    (insert "%%Page: 1 1\n")
    (insert "Hwjst\n")
    (insert "/Hwsave save def\n")
    (if handwrite-pagenumbering (insert "20 30 m\nxym(page 1)a\n"))
    (insert "44 63 m\n")
    (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