emacs-pdf.el - emacs-pdf - Emacs library to print buffer to PDF file.

emacs-pdf.el (16900B)
      1 ;;; -*- lexical-binding: t -*-
      2 ;;;
      3 ;;; emacs-pdf.el
      4 ;;;
      5 ;;; Print buffer to PDF file.
      6 ;;;
      7 ;;; Copyright (C) 2020 Tomas Hlavaty <tom at logand dot com>
      8 ;;;
      9 ;;; License: GPLv3 or later
     10 ;;;
     11 ;;; Download: git clone https://logand.com/git/emacs-pdf.git
     12 ;;;
     13 ;;; Example configuration:
     14 ;;;
     15 ;;; (add-to-list 'load-path "~/git/emacs-pdf")
     16 ;;; (require 'emacs-pdf)
     17 ;;;
     18 ;;; Example usage:
     19 ;;;
     20 ;;; M-x pdf-buffer or pdf-region in example.txt will create
     21 ;;; example.txt.pdf file.
     22 ;;;
     23 ;;; Some variables can be customized in pdf and ps groups.
     24 
     25 (require 'cl-lib)
     26 (require 'printing)
     27 
     28 (defcustom pdf-line-height-factor 1.2
     29   "Specify the line height factor (line-height = factor * font-size)."
     30   :type 'number
     31   :group 'pdf)
     32 
     33 (defcustom pdf-base-font '/Courier
     34   "PDF base font."
     35   :type '(choice
     36           (const /Courier)
     37           (const /Courier-Bold)
     38           (const /Courier-Oblique)
     39           (const /Courier-BoldOblique)
     40           (const /Helvetica)
     41           (const /Helvetica-Bold)
     42           (const /Helvetica-Oblique)
     43           (const /Helvetica-BoldOblique)
     44           (const /Times-Roman)
     45           (const /Times-Bold)
     46           (const /Times-Italic)
     47           (const /Times-BoldItalic))
     48   :group 'pdf)
     49 
     50 (defcustom pdf-header
     51   (list 'pdf-page-number "/" 'pdf-number-of-pages " " 'pdf-nondirpart)
     52   "The items to display in the page header.
     53 
     54 The value should be a list of strings and symbols.  Strings are
     55 inserted unchanged.  For symbols with bound functions, the
     56 function is called and should return a string to be inserted.
     57 For symbols with bound values, the value should be a string to be
     58 inserted.  If symbols are unbounded, they are silently ignored.
     59 
     60 Useful functions:
     61 - pdf-dirpart
     62 - pdf-iso8601-date
     63 - pdf-nondirpart
     64 - pdf-number-of-pages
     65 - pdf-page-number
     66 "
     67   :type '(repeat (choice :menu-tag "Header"
     68 			 :tag "Header"
     69 			 string symbol))
     70   :group 'pdf)
     71 
     72 (defcustom pdf-footer
     73   (list 'pdf-iso8601-date " " 'pdf-dirpart)
     74   "The items to display in the page footer.
     75 
     76 The value should be a list of strings and symbols.  Strings are
     77 inserted unchanged.  For symbols with bound functions, the
     78 function is called and should return a string to be inserted.
     79 For symbols with bound values, the value should be a string to be
     80 inserted.  If symbols are unbounded, they are silently ignored.
     81 
     82 Useful functions:
     83 - pdf-dirpart
     84 - pdf-iso8601-date
     85 - pdf-nondirpart
     86 - pdf-number-of-pages
     87 - pdf-page-number
     88 "
     89   :type '(repeat (choice :menu-tag "Footer"
     90 			 :tag "Footer"
     91 			 string symbol))
     92   :group 'pdf)
     93 
     94 (defcustom pdf-end-regexp "^Local Variables:"
     95   "Specify regexp which ends the printable part of the file.
     96 
     97 As an example, it may be set to \"^Local Variables:\", in order to leave out
     98 some special printing instructions from the actual print.  Special printing
     99 instructions may be appended to the end of the file just like any other
    100 buffer-local variables.  See section \"Local Variables in Files\" on Emacs
    101 manual for more information:
    102 
    103    (info \"(emacs) File Variables\")
    104 
    105 It controls what actually gets printed and may be set to nil in which case
    106 the end of the file ends the printable region."
    107   :type '(choice (const :tag "No Delimiter" nil)
    108 		 (regexp :tag "Delimiter Regexp"))
    109   :group 'pdf)
    110 
    111 ;; for eldoc
    112 (defun pdf (&rest rest) `(pdf ,@rest))
    113 (defun pdf-xref (&rest kv) `(pdf-xref ,@kv))
    114 (defun pdf-stream (dic &rest rest) `(pdf-stream ,dic ,@rest))
    115 (defun pdf-obj (num ver one) `(pdf-obj ,num ,ver ,one))
    116 (defun pdf-dic (&rest kv) `(pdf-dic ,@kv))
    117 (defun pdf-vec (&rest rest) `(pdf-vec ,@rest))
    118 (defun pdf-ref (num ver) `(pdf-ref ,num ,ver))
    119 
    120 (defun insert-pdf (x)
    121   "Serialize cons tree x as PDF octets into the current buffer."
    122   (let (objs xrefpos)
    123     (cl-labels ((rec (x)
    124                      (cl-etypecase x
    125                        (integer
    126                         (insert (format "\n%d" x)))
    127                        (symbol
    128                         (insert (format "\n%s" x)))
    129                        (string
    130                         (insert "\n(")
    131                         (cl-loop
    132                          for c across x
    133                          do (cl-case c
    134                               (?\\ (insert "\\\\"))
    135                               (?\( (insert "\\("))
    136                               (?\) (insert "\\)"))
    137                               (t (insert c))))
    138                         (insert ")"))
    139                        (real
    140                         (insert (format "\n%f" x)))
    141                        (cons
    142                         (cl-ecase (car x)
    143                           (pdf
    144                            (insert "%PDF-1.4")
    145                            (insert
    146                             (format "\n%%%c%c%c%c%c%c%c%c"
    147                                     150 151 152 153 255 254 253 252))
    148                            (mapc #'rec (cdr x))
    149                            (insert "\nstartxref")
    150                            (insert (format "\n%d" xrefpos))
    151                            (insert "\n%%EOF\n"))
    152                           (pdf-xref
    153                            (setq xrefpos (point))
    154                            (insert "\nxref")
    155                            (insert (format "\n%d %d" 0 (1+ (length objs))))
    156                            (insert "\n0000000000 65535 f\r")
    157                            (dolist (obj (setq objs (nreverse objs)))
    158                              (cl-destructuring-bind (a b pos &rest c) obj
    159                                (ignore a)
    160                                (insert (format "\n%010d %05d n\r" pos b))))
    161                            (insert "\ntrailer")
    162                            (rec
    163                             `(pdf-dic /Size ,(1+ (length objs)) ,@(cdr x))))
    164                           (pdf-stream
    165                            (cl-destructuring-bind (a &rest b) (cdr x)
    166                              (let ((r (1+ (caar objs))))
    167                                (rec (if a
    168                                         (cl-ecase (car a)
    169                                           (pdf-dic `(pdf-dic /Length (pdf-ref ,r 0) ,@(cdr a))))
    170                                       `(pdf-dic /Length (pdf-ref ,r 0))))
    171                                (insert "\nstream")
    172                                (let ((start (point)))
    173                                  (mapc #'rec b)
    174                                  (let ((end (point)))
    175                                    (insert "\nendstream")
    176                                    (insert "\nendobj")
    177                                    (push `(,r 0 ,(point)) objs)
    178                                    (insert (format "\n%d %d obj" r 0))
    179                                    (rec (- end start)))))))
    180                           (pdf-obj
    181                            (cl-destructuring-bind (a b &rest c) (cdr x)
    182                              (push `(,a ,b ,(point)) objs)
    183                              (insert (format "\n%d %d obj" a b))
    184                              (mapc #'rec c)
    185                              (insert "\nendobj")))
    186                           (pdf-dic
    187                            (insert "\n<<")
    188                            (mapc #'rec (cdr x))
    189                            (insert "\n>>"))
    190                           (pdf-vec
    191                            (insert "\n[")
    192                            (mapc #'rec (cdr x))
    193                            (insert "\n]"))
    194                           (pdf-ref
    195                            (cl-destructuring-bind (a b) (cdr x)
    196                              (insert (format "\n%d %d R" a b)))))))))
    197       (set-buffer-multibyte nil)
    198       (rec x))))
    199 
    200 (defun pdf-brook-collect (brook)
    201   "Collect all values pulled from brook."
    202   (cl-loop
    203    with z = nil
    204    while (setq z (funcall brook))
    205    collect z))
    206 
    207 (defun pdf-brook-appending (brook)
    208   "Append all values pulled from brook."
    209   (cl-loop
    210    with z = nil
    211    while (setq z (funcall brook))
    212    appending z))
    213 
    214 (defun pdf-brook-count (brook)
    215   "Count all values in brook."
    216   (cl-loop
    217    with z = nil
    218    while (setq z (funcall brook))
    219    count z))
    220 
    221 (defun pdf-brook (x)
    222   "Make new brook from x."
    223   (cl-etypecase x
    224     (list
    225      (lambda ()
    226        (pop x)))))
    227 
    228 ;;(pdf-brook-collect (pdf-brook '(1 2 3 4)))
    229 ;;(pdf-brook-count (pdf-brook '(1 2 3 4)))
    230 
    231 (defun pdf-flat-brook (&rest brooks)
    232   "Compose brooks left to right, depth-first."
    233   (lambda ()
    234     (cl-block loop
    235       (while brooks
    236         (let ((z (funcall (car brooks))))
    237           (cond
    238            ((functionp z) (push z brooks))
    239            (z (cl-return-from loop z))
    240            (t (pop brooks))))))))
    241 
    242 ;;(pdf-brook-collect (pdf-flat-brook (pdf-brook '(1 2 3)) (pdf-brook '(4 5 6))))
    243 
    244 (defun pdf-source-line-brook (string)
    245   "Make brook from string.  Elements are string per line or \='pagebreak."
    246   (pdf-flat-brook
    247    (let ((pages (pdf-brook (split-string string ""))))
    248      (lambda ()
    249        (let ((page (funcall pages)))
    250          (when page
    251            (pdf-brook (list (pdf-brook (split-string page "\n"))
    252                             (pdf-brook '(pagebreak))))))))))
    253 
    254 ;;(pdf-brook-collect (pdf-source-line-brook "1\n23\n4\n5"))
    255 
    256 (defun pdf-source-page-brook (brook)
    257   "Make brook for single page from brook."
    258   (lambda ()
    259     (let ((z (funcall brook)))
    260       (when z
    261         (unless (eq 'pagebreak z)
    262           z)))))
    263 
    264 ;;(pdf-brook-collect (pdf-source-page-brook (pdf-source-line-brook "1\n23\n4\n5")))
    265 
    266 (defvar *pdf-page-number*)
    267 (defun pdf-page-number ()
    268   "Return current page number as string.  Useful in document
    269 header or footer."
    270   (format "%s" *pdf-page-number*))
    271 
    272 (defvar *pdf-number-of-pages*)
    273 (defun pdf-number-of-pages ()
    274   "Return number of pages as string.  Useful in document header
    275 or footer."
    276   (format "%s" *pdf-number-of-pages*))
    277 
    278 (defvar *pdf-file-name*)
    279 (defun pdf-dirpart ()
    280   "Return directory part as string.  Useful in document header or
    281 footer."
    282   (and *pdf-file-name* (file-name-directory *pdf-file-name*)))
    283 (defun pdf-nondirpart ()
    284   "Return non-directory part as string.  Useful in document header or
    285 footer."
    286   (and *pdf-file-name* (file-name-nondirectory *pdf-file-name*)))
    287 
    288 (defun pdf-iso8601-date ()
    289   "Return current data as ISO8601 string.  Useful in document
    290 header or footer."
    291   (format-time-string "%Y-%m-%d"))
    292 
    293 (defun pdf-header-or-footer-text (i n file-name list)
    294   "Insert document header or footer specified in list."
    295   (with-temp-buffer
    296     (let ((*pdf-page-number* i)
    297           (*pdf-number-of-pages* n)
    298           (*pdf-file-name* file-name))
    299       (dolist (x list)
    300         (when x
    301           (insert
    302            (cl-etypecase x
    303              (function (or (funcall x) ""))
    304              (symbol (or (symbol-value x) ""))
    305              (string x))))))
    306     (buffer-string)))
    307 
    308 (defun pdf-header-text (i n file-name)
    309   "Insert document header."
    310   (pdf-header-or-footer-text i n file-name pdf-header))
    311 
    312 (defun pdf-footer-text (i n file-name)
    313   "Insert document footer."
    314   (pdf-header-or-footer-text i n file-name pdf-footer))
    315 
    316 (defun pdf-line (x y line)
    317   "Represent PDF line as list of PDF drawing primitives."
    318   `(1 0 0 1 ,x ,y Tm ,line Tj))
    319 
    320 (defun pdf-page-text (lines x0 y0 line-height header footer)
    321   "Represent PDF page as list of PDF drawing primitives."
    322   (pdf-brook-appending
    323    (let* ((page (pdf-source-page-brook lines))
    324           (bottom-margin (+ ps-bottom-margin
    325                             (if footer (+ line-height ps-footer-offset) 0)))
    326           (y y0))
    327      (lambda ()
    328        (when (<= bottom-margin (cl-decf y line-height))
    329          (let ((line (funcall page)))
    330            (when line
    331              `(,@(when header
    332                    (prog1 (pdf-line x0 y header)
    333                      (setq header nil)
    334                      (cl-decf y (+ line-height ps-header-offset))))
    335                ,@(when footer
    336                    (prog1 (pdf-line x0 ps-bottom-margin footer)
    337                      (setq footer nil)))
    338                ,@(pdf-line x0 y line)))))))))
    339 
    340 (defun pdf-page-dimensions ()
    341   "Return values of page width and height depending on
    342 ps-paper-type and ps-landscape-mode."
    343   (let ((x (cdr (assq ps-paper-type ps-page-dimensions-database))))
    344     (if ps-landscape-mode
    345         (cl-values (cadr x) (car x))
    346       (cl-values (car x) (cadr x)))))
    347 
    348 ;;(pdf-page-dimensions)
    349 
    350 (defun pdf-pages-brook (substring x0 y0 line-height font-size
    351                                   npages file-name parent oid !ref)
    352   "Make brook of PDF objects per page."
    353   (let ((lines (pdf-source-line-brook substring))
    354         (i 0))
    355     (lambda ()
    356       (cl-incf i)
    357       (let ((text (pdf-page-text lines x0 y0 line-height
    358                                  (when ps-print-header
    359                                    (pdf-header-text i npages file-name))
    360                                  (when ps-print-footer
    361                                    (pdf-footer-text i npages file-name)))))
    362         (when text
    363           (let ((oid1 (funcall oid))
    364                 (_oid2 (funcall oid)) ;; pdf-stream uses 2 oids, 1st for the stream obj and 2nd for the length obj
    365                 (oid3 (funcall oid)))
    366             (funcall !ref `(pdf-ref ,oid3 0))
    367             `((pdf-obj ,oid1
    368                        0
    369                        (pdf-stream nil
    370                                    BT
    371                                    /F1 ,font-size Tf
    372                                    1 0 0 1 ,x0 ,y0 Tm
    373                                    ,@text
    374                                    ET))
    375               (pdf-obj ,oid3
    376                        0
    377                        (pdf-dic /Type /Page
    378                                 /Parent ,parent
    379                                 /Resources (pdf-ref 2 0)
    380                                 /Contents (pdf-ref ,oid1 0))))))))))
    381 
    382 (defun pdf-npages (substring x0 y0 line-height font-size file-name)
    383   "Count number of pages in the document."
    384   (pdf-brook-count
    385    (pdf-pages-brook substring x0 y0 line-height font-size 0 file-name nil
    386                     (lambda () 0)
    387                     (lambda (x) (ignore x)))))
    388 
    389 (defun pdf-region (from to &optional file-name)
    390   "Save region to PDF file."
    391   (interactive "r")
    392   (cl-multiple-value-bind (page-width page-height) (pdf-page-dimensions)
    393     (let* ((coding-system-for-write 'raw-text-unix)
    394            (source-file-name (or file-name
    395                                  (buffer-file-name)
    396                                  (buffer-name)))
    397            (file-name (concat source-file-name ".pdf"))
    398            (x0 ps-left-margin)
    399            (y0 (- page-height ps-top-margin))
    400            (font-size (cl-etypecase ps-font-size
    401                         (number ps-font-size)
    402                         (cons (if ps-landscape-mode
    403                                   (car ps-font-size)
    404                                 (cdr ps-font-size)))))
    405            (line-height (* pdf-line-height-factor font-size))
    406            (substring (buffer-substring-no-properties
    407 		       from
    408 		       (or (when pdf-end-regexp
    409 			     (save-excursion
    410 			       (goto-char (point-min))
    411 			       (when (re-search-forward pdf-end-regexp to 'noerror)
    412 				 (min to (match-beginning 0)))))
    413 			   to)))
    414            (npages (when (or (when ps-print-header
    415                                (member 'pdf-number-of-pages pdf-header))
    416                              (when ps-print-footer
    417                                (member 'pdf-number-of-pages pdf-footer)))
    418                      (pdf-npages substring x0 y0 line-height font-size
    419                                  source-file-name))))
    420       (with-temp-buffer
    421         (insert-pdf
    422          (let ((oid 0)
    423                %pages
    424                (%parent (list 'pdf-ref -1 0)))
    425            `(pdf
    426              (pdf-obj ,(cl-incf oid)
    427                       0
    428                       (pdf-dic /Type /Font
    429                                /Subtype /Type1
    430                                /Name /F1
    431                                /BaseFont ,pdf-base-font))
    432              (pdf-obj ,(cl-incf oid)
    433                       0
    434                       (pdf-dic /ProcSet (pdf-vec /PDF /Text)
    435                                /Font (pdf-dic /F1 (pdf-ref ,(1- oid) 0))))
    436              ,@(pdf-brook-appending
    437                 (pdf-pages-brook substring x0 y0 line-height font-size npages
    438                                  source-file-name
    439                                  %parent
    440                                  (lambda () (cl-incf oid))
    441                                  (lambda (x) (push x %pages))))
    442              (pdf-obj ,(setf (cadr %parent) (cl-incf oid))
    443                       0
    444                       (pdf-dic /Type /Pages
    445                                /Count ,(length %pages)
    446                                /Kids (pdf-vec ,@(nreverse %pages))
    447                                /MediaBox (pdf-vec 0 0 ,page-width ,page-height)))
    448              (pdf-obj ,(cl-incf oid)
    449                       0
    450                       (pdf-dic /Type /Catalog
    451                                /Pages (pdf-ref ,(1- oid) 0)))
    452              (pdf-xref /Root (pdf-ref ,oid 0)))))
    453         (write-region (point-min) (point-max) file-name)))))
    454 
    455 (defun pdf-buffer (&optional file-name)
    456   "Save buffer to PDF file."
    457   (interactive)
    458   (pdf-region (point-min) (point-max) file-name))
    459 
    460 (provide 'emacs-pdf)
	emacs-pdf Emacs library to print buffer to PDF file.
	Log \| Files \| Refs \| README