[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
env-print.el
From: |
Hans Halvorson |
Subject: |
env-print.el |
Date: |
Tue, 24 Apr 2007 10:44:57 -0400 |
User-agent: |
Wanderlust/2.15.5 (Almost Unreal) SEMI/1.14.6 (Maruoka) FLIM/1.14.8 (Shijō) APEL/10.7 Emacs/22.0.98 (i686-pc-linux-gnu) MULE/5.0 (SAKAKI) |
Print Envelopes ...
;;; env-print.el -- print an envelope
;;; Version: 0.1
;;; Author: Hans Halvorson (www.princeton.edu/~hhalvors)
;;; Time-stamp: <2007-04-24 09:38:55 hhalvors>
;;;
;;; This is free software -- you may redistribute it under the GNU
;;; General Public License, but it comes with ABSOLUTELY NO WARRANTY.
;;;
;;; Acknowledgment: Some parts based on Gregory Spath's "envelope" Perl script
;;; (http://freefall.homeip.net/code/)
;;; Usage:
;;;
;;; The function `env-print' takes a list of strings and prints a
;;; postscript envelope through lpr-buffer. It is likely that you will
;;; have to tune the custom variables for your printer.
;;;
;;; The interactive function `env-from-bbdb' prints an envelope from
;;; the bbdb record at the point. It currently defaults to the first
;;; address in the record, and it has only been tested for US
;;; addresses.
;;; Code:
(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)
; (defcustom env-topmargin 0.30
; "Top margin")
(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)
; usage: (env-print '("Grandy Halvorson" "2817 High Ridge Rd" "Charlotte NC
28226"))
; the ADDRESS should be a list of strings, where each string
; corresponds to a line in the printed representation
"Print an envelope."
(with-temp-buffer
;; create the PostScript 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))))
; set coordinate system
(insert (format "%d %d translate\n90 rotate\n" var-i var-j))
; PS code for the first line of the address
(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)))
; move y-pos down the dimension of line1pointsize
(setq y-pos (- y-pos line1pointsize))
; PS code for subsequent lines of the address
(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)))))
; PS postamble
(insert "showpage\n")
;; send the buffer to the printer
;; most natural to use `lpr-buffer', but that gives strange results on my
machine
(if env-lpr-buffer
(lpr-buffer)
(shell-command-on-region (point-min) (point-max) "lpr"))))
;;+ Print from bbdb record
;; right now this function picks off the first address element -- see `car' in
defn of addr2
;; TO DO: give choice of which address to print
(defun env-from-bbdb ()
(interactive)
(let* ((addr1 (bbdb-record-get-field-internal (bbdb-current-record) 'name)) ;
string
(addr0 (bbdb-record-get-field-internal (bbdb-current-record)
'address)) ; list of vectors
(addr2 (car addr0)) ; vector
(addr3 (aref addr2 1)) ; list of address strings
(city (aref addr2 2)) ; string
(state (aref addr2 3)) ; string
(zip (aref addr2 4)) ; string
(addr-last (list (concat city " " state " " zip)))) ;; list
(env-print (cons addr1 (append addr3 addr-last)))))
;; TO DO:
;; 1. pipe in from a text buffer
;; 2. pipe in from region
;; 3. return address
;; 4. defcustom orientation
(provide 'env-print)
;;; end of file env-print.el
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- env-print.el,
Hans Halvorson <=