Download
(defgroup env-print nil
"Print envelopes."
)
(defcustom env-lpr-buffer nil
"Set to nil if your `lpr-buffer' function gives odd results,
and you can call lpr directly from a shell.")
(defcustom env-normalpaper 11
"Height of normal paper."
:group 'env-print)
(defcustom env-ewidth 9.5
"Envelope width"
:group 'env-print)
(defcustom env-eheight 4.125
"Envelope height"
:group 'env-print)
(defcustom env-normalwidth 8.5
"Normal paper width."
:group 'env-print)
(setq env-topmargin (+ 0.30 (/ (- env-normalwidth env-eheight) 2)))
(defcustom env-leftmargin 0.25
"Left margin"
:group 'env-print)
(defcustom env-line1 '("Times-Roman" 12)
"Default font for first line of mailing address. You must use valid PostScript font names and sizes."
:group 'env-print)
(defcustom env-linex '("Times-Roman" 12)
"Default font for mailing address, lines two and greater. You must use valid PostScript font names and sizes."
:group 'env-print)
(defun env-print (address)
"Print an envelope."
(with-temp-buffer
(insert "%!\n% PS file from env-print.el\nnewpath\n")
(let* ((x-orig 0)
(y-orig (* 72 (- env-normalpaper env-ewidth)))
(var-i (floor (+ x-orig (* env-topmargin 72))))
(var-j (floor (+ y-orig (* env-leftmargin 72))))
(line1pointsize (car (cdr env-line1)))
(linexpointsize (car (cdr env-linex)))
(line1font (car env-line1))
(linexfont (car env-linex))
(x-pos (floor (* 0.40 72 env-ewidth)))
(y-pos (floor (* -0.40 72 env-eheight))))
(insert (format "%d %d translate\n90 rotate\n" var-i var-j))
(insert (format "/%s findfont %d scalefont setfont\n" line1font line1pointsize))
(insert (format "%d %d moveto\n" x-pos y-pos))
(insert (format "(%s) show\n" (car address)))
(setq y-pos (- y-pos line1pointsize))
(let ((mod-address (cdr address)))
(dolist (z mod-address)
(insert (format "/%s findfont %d scalefont setfont\n" linexfont linexpointsize))
(insert (format "%d %d moveto\n" x-pos y-pos))
(insert (format "(%s) show\n" z))
(setq y-pos (- y-pos linexpointsize)))))
(insert "showpage\n")
(if env-lpr-buffer
(lpr-buffer)
(shell-command-on-region (point-min) (point-max) "lpr"))))
(defun env-from-bbdb ()
(interactive)
(let* ((addr1 (bbdb-record-get-field-internal (bbdb-current-record) 'name))
(addr0 (bbdb-record-get-field-internal (bbdb-current-record) 'address))
(addr2 (car addr0))
(addr3 (aref addr2 1))
(city (aref addr2 2))
(state (aref addr2 3))
(zip (aref addr2 4))
(addr-last (list (concat city " " state " " zip))))
(env-print (cons addr1 (append addr3 addr-last)))))
(provide 'env-print)