; Emacs, this is yours. Edit it in -*- emacs-lisp -*- mode ; Join the collection of PostScript files in the buffer to make a single file. ; Set crop marks. All values in points. (defun cropmarks (xorigin ; new origin of page yorigin height ; height of paper width ; of paper &optional istex ; set if it's TeX output xorig ; x origin yorig ; and y cropoffset ; offset from corner of paper to crop mark insert-pos ) ; regexp to find insert position (let ((croplength 25) ; length of crop mark (linewidth .4) ; width of crop mark (pageno 1) ) ; running page number (if (null cropoffset) (setq cropoffset 36) ) ; default to 1/2" offset (if (null insert-pos) (setq insert-pos "^%%EndPageSetup$") ) (if (null xorig) (setq xorig 23) ) ; original x (if (null yorig) (setq yorig 2) ) ; and y offset of page (while (re-search-forward insert-pos nil t) ;;; put in crop marks and move the page down to accomodate them (insert " ") ; new line (insert (int-to-string linewidth) " LW ") ; set line width ; Get this right ; (insert (int-to-string (+ xorigin cropoffset)) " " ; insert identification at top of page ; (int-to-string (- yorigin cropoffset)) " moveto (" ; buffer-file-truename " " ; (current-time-string) " Page " ; (int-to-string pageno) ") ;" ) (setq pageno (+ 1 pageno)) ; increment page number ;;; top left marks (insert (int-to-string (- xorigin cropoffset croplength)) " " ; top left, horizontal (int-to-string (- yorigin cropoffset)) " " (int-to-string (- xorigin cropoffset)) " " (int-to-string (- yorigin cropoffset)) " DL ") (insert (int-to-string (- xorigin cropoffset)) " " ; top left, vertical (int-to-string (- yorigin cropoffset croplength)) " " (int-to-string (- xorigin cropoffset)) " " (int-to-string (- yorigin cropoffset)) " DL ") ;;; top right marks (insert (int-to-string (+ xorigin width cropoffset croplength)) " " ; horizontal (int-to-string (- yorigin cropoffset)) " " (int-to-string (+ xorigin width cropoffset)) " " (int-to-string (- yorigin cropoffset)) " DL ") (insert (int-to-string (+ xorigin width cropoffset)) " " ; vertical (int-to-string (- yorigin cropoffset croplength)) " " (int-to-string (+ xorigin width cropoffset)) " " (int-to-string (- yorigin cropoffset)) " DL ") ;;; bottom left marks (insert (int-to-string (- xorigin cropoffset croplength)) " " ; bottom left, horizontal (int-to-string (+ yorigin height cropoffset)) " " (int-to-string (- xorigin cropoffset)) " " (int-to-string (+ yorigin height cropoffset)) " DL ") (insert (int-to-string (- xorigin cropoffset)) " " ; bottom left, vertical (int-to-string (+ yorigin height cropoffset croplength)) " " (int-to-string (- xorigin cropoffset)) " " (int-to-string (+ yorigin height cropoffset)) " DL " ) ;;; bottom right marks (insert (int-to-string (+ xorigin width cropoffset croplength)) " " ; horizontal (int-to-string (+ yorigin height cropoffset)) " " (int-to-string (+ xorigin width cropoffset)) " " (int-to-string (+ yorigin height cropoffset)) " DL ") (insert (int-to-string (+ xorigin width cropoffset)) " " ; vertical (int-to-string (+ yorigin height cropoffset croplength)) " " (int-to-string (+ xorigin width cropoffset)) " " (int-to-string (+ yorigin height cropoffset)) " DL/F0 ") (insert "10/Times-Roman@0 SF() 465.6 588 Q " (int-to-string (- xorigin xorig)) " " (int-to-string (- yorigin yorig)) " translate") ) ) ) ; Draw a page frame around the text. All values in points. (defun pageframe (xorigin ; new origin of page yorigin height ; height of paper width ; of paper &optional cropoffset ; offset from corner of paper to crop mark insert-pos ) ; regexp to find insert position (let ((linewidth .4) ; width of crop mark (pageno 1) ) ; running page number (if (null cropoffset) (setq cropoffset 36) ) ; default to 1/2" offset (if (null insert-pos) (setq insert-pos "^%%EndPageSetup$") ) (goto-char 0) (message " Making page frames") (while (re-search-forward insert-pos nil t) ;;; put in crop marks and move the page down to accomodate them (insert " ") ; new line (insert (int-to-string linewidth) " LW ") ; set line width ; Get this right ; (insert (int-to-string (+ xorigin cropoffset)) " " ; insert identification at top of page ; (int-to-string (- yorigin cropoffset)) " moveto (" ; buffer-file-truename " " ; (current-time-string) " Page " ; (int-to-string pageno) ") ;" ) (setq pageno (+ 1 pageno)) ; increment page number ;;; top (insert (int-to-string xorigin) " " (int-to-string yorigin) " " (int-to-string (+ xorigin width)) " " (int-to-string yorigin) " DL ") ;;; right (insert (int-to-string (+ xorigin width)) " " ; horizontal (int-to-string yorigin) " " (int-to-string (+ xorigin width)) " " (int-to-string (+ yorigin height)) " DL ") ;;; left (insert (int-to-string xorigin) " " ; horizontal (int-to-string yorigin) " " (int-to-string xorigin) " " (int-to-string (+ yorigin height)) " DL ") ;;; bottom (insert (int-to-string xorigin ) " " (int-to-string (+ yorigin height)) " " (int-to-string (+ xorigin width)) " " (int-to-string (+ yorigin height)) " DL ") ) ) ) (defun renumber-pages () (message " Renumbering pages") (goto-char 0) (let ((pagenum 1)) (while (re-search-forward "^%%Page: [0-9]+ *" nil t) (kill-line) (insert (int-to-string pagenum)) (setq pagenum (1+ pagenum)) ) (message (concat " Document contains " (int-to-string pagenum) " pages")) (goto-char 0) ; now adjust page count (re-search-forward "^%%Pages: " nil t) (kill-line) (insert (int-to-string pagenum)) ) ) (defun massageps () (interactive) (let ((searching t) (start) ) (message " Merging files") (goto-char 0) (while (and searching (re-search-forward "^%%Trailer" nil t) ) (beginning-of-line) (setq start (point)) (if (setq searching (re-search-forward "^%%Page:" nil t)) (progn (beginning-of-line) (delete-region start (point)) ) ) ) ;; Now go back and sort out the page numbers (renumber-pages) ;; now set crop marks on all the pages, and move the origin a little ;; (message " Inserting crop marks") ;; (goto-char 0) ;; (cropmarks @XORIG@ @YORIG@ @HEIGHT@ @WIDTH@) ) ) (defun massageps2 () (interactive) (let ((searching t) (start) ) (message " Merging files") (goto-char 0) (while (and searching (re-search-forward "^%%Trailer" nil t) ) (beginning-of-line) (setq start (point)) (if (setq searching (re-search-forward "^%%Page:" nil t)) (progn (beginning-of-line) (delete-region start (point)) ) ) ) ;; Now go back and sort out the page numbers (renumber-pages) ;; now set crop marks on all the pages, and move the origin a little (message " Inserting crop marks") (goto-char 0) (setoffset) ) ) (defun cropit () (cropmarks @XORIG@ @YORIG@ @HEIGHT@ @WIDTH@) ) (defun exit () (save-buffers-kill-emacs t) ) (defun makeframe () (pageframe @XORIG@ @YORIG@ @HEIGHT@ @WIDTH@) ) (defun closeframe () (clean-up-gunge) (pageframe 72 41 586 418) ) ;and put in the frames (defun clean-up-gunge () (goto-char 0) ;first remove extraneous stuff (let ((searching t) (start) ) (message " Merging files") (goto-char 0) (while (and searching (re-search-forward "^%%Trailer" nil t) ) (beginning-of-line) (setq start (point)) (if (setq searching (re-search-forward "^%%Page:" nil t)) (progn (beginning-of-line) (delete-region start (point)) ) ) ) ) ) ; Reduce the images to half size and display 4 on a page (defun thumbnail () (clean-up-gunge) (message " Modifying page structure") (goto-char 0) ;then modify display macros (insert "%! statusdict begin 1 setpapertray " ) (if (re-search-forward "^/EP{" nil t) (progn (beginning-of-line) (insert "0.5 0.5 scale 0 590 translate /Quad 1 def " ) ) (error " Can't find /EP") ) (if (re-search-forward "^showpage" nil t) (progn (beginning-of-line) (kill-line) (insert "Quad 1 eq { 440 0 translate /Quad 2 def } { Quad 2 eq { -440 -590 translate /Quad 3 def } { Quad 3 eq { 440 0 translate /Quad 4 def } { 440 0 translate /Quad 1 def showpage 0.5 0.5 scale 0 590 translate } ifelse } ifelse } ifelse " ) ) (error " Can't find showpage") ) (renumber-pages) ;renumber the pages (closeframe) ) ;put in a close-fitting frame ; Remove duplicate headers and renumber (defun renumber () (clean-up-gunge) ;remove junk (renumber-pages) ) ;and renumber the pages (defun setoffset () (interactive) (while (re-search-forward "^%%EndPageSetup" nil t) (insert " 0 -25 translate") ) ) ;;;; copy region of current buffer to outfile (defun copy-to-outfile (start end) (copy-region-as-kill start end) (switch-to-buffer outfile) ;now erase the output buffers (yank) (switch-to-buffer all-pages) ) (defun multiply () (interactive) (let ((filename (buffer-file-name)) ;name of the base file (all-pages (current-buffer)) ;this is the source with all pages (outfile) ;store output here (mymark) ;marker for copying (page-start) (page-end) (list-end) ) (setq outfile (find-file-noselect (concat filename ".multi.mm"))) ;store output here (switch-to-buffer outfile) ;now erase the output buffers (erase-buffer) (switch-to-buffer all-pages) ;now to the input buffer (goto-char (point-min)) ;at the beginning (setq mymark (point)) ;first copy will start at the beginning of the buffer (while (re-search-forward "^\\.Ls" nil t) ;find a page with an Ls command. (setq page-start (re-search-backward "^\\.bp")) ;find the start of the page (copy-to-outfile mymark (point)) (forward-line 1) (re-search-forward "^\\.bp" nil 1) ;find the start of the next page (beginning-of-line) (setq page-end (point)) (setq listend (re-search-backward "^\\.Le" nil t)) ;find the end of the list (goto-char page-start) (re-search-forward "^\\.LI" nil t) ;; Now we have a number of points: ;; page-start is the beginning of the page ;; point is the location of the first .LI command ;; list-end is the location of the .Le command ;; page-end is the end of the page (while (re-search-forward "^\\.LI" page-end t) (beginning-of-line) (copy-to-outfile page-start (point)) ;top part (copy-to-outfile listend page-end) (forward-line 1) ) (goto-char page-start) ;; Now copy the entire page with an f after slide-title (re-search-forward "^\\.slide-title.*$" page-end) (copy-to-outfile page-start (point)) (switch-to-buffer outfile) ;now erase the output buffers (insert " f") (switch-to-buffer all-pages) (copy-to-outfile (point) page-end) (setq mymark page-end) (goto-char mymark) ) (end-of-buffer) (copy-to-outfile mymark (point)) (save-buffer outfile) ) )