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

emacs-pdf.el (16442B)
      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 nil
     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 It controls what actually gets printed and may be set to nil in which case
    104 the end of the file ends the printable region."
    105   :type '(choice (const :tag "No Delimiter" nil)
    106 		 (regexp :tag "Delimiter Regexp"))
    107   :group 'pdf)
    108 
    109 ;; for eldoc
    110 (defun pdf (&rest rest) `(pdf ,@rest))
    111 (defun pdf-xref (&rest kv) `(pdf-xref ,@kv))
    112 (defun pdf-stream (dic &rest rest) `(pdf-stream ,dic ,@rest))
    113 (defun pdf-obj (num ver one) `(pdf-obj ,num ,ver ,one))
    114 (defun pdf-dic (&rest kv) `(pdf-dic ,@kv))
    115 (defun pdf-vec (&rest rest) `(pdf-vec ,@rest))
    116 (defun pdf-ref (num ver) `(pdf-ref ,num ,ver))
    117 
    118 (defun insert-pdf (x)
    119   "Serialize cons tree x as PDF octets into the current buffer."
    120   (let (objs xrefpos)
    121     (cl-labels ((rec (x)
    122                      (cl-etypecase x
    123                        (integer
    124                         (insert (format "\n%d" x)))
    125                        (symbol
    126                         (insert (format "\n%s" x)))
    127                        (string
    128                         (insert "\n(")
    129                         (cl-loop
    130                          for c across x
    131                          do (cl-case c
    132                               (?\\ (insert "\\\\"))
    133                               (?\( (insert "\\("))
    134                               (?\) (insert "\\)"))
    135                               (t (insert c))))
    136                         (insert ")"))
    137                        (real
    138                         (insert (format "\n%f" x)))
    139                        (cons
    140                         (cl-ecase (car x)
    141                           (pdf
    142                            (insert "%PDF-1.4")
    143                            (insert
    144                             (format "\n%%%c%c%c%c%c%c%c%c"
    145                                     150 151 152 153 255 254 253 252))
    146                            (mapc #'rec (cdr x))
    147                            (insert "\nstartxref")
    148                            (insert (format "\n%d" xrefpos))
    149                            (insert "\n%%EOF\n"))
    150                           (pdf-xref
    151                            (setq xrefpos (point))
    152                            (insert "\nxref")
    153                            (insert (format "\n%d %d" 0 (1+ (length objs))))
    154                            (insert "\n0000000000 65535 f\r")
    155                            (dolist (obj (setq objs (nreverse objs)))
    156                              (cl-destructuring-bind (a b pos &rest c) obj
    157                                (ignore a)
    158                                (insert (format "\n%010d %05d n\r" pos b))))
    159                            (insert "\ntrailer")
    160                            (rec
    161                             `(pdf-dic /Size ,(1+ (length objs)) ,@(cdr x))))
    162                           (pdf-stream
    163                            (cl-destructuring-bind (a &rest b) (cdr x)
    164                              (let ((x (with-temp-buffer
    165                                         (set-buffer-multibyte nil)
    166                                         (mapc #'rec b)
    167                                         (buffer-string))))
    168                                (rec (if a
    169                                         `(/Length ,(length x) ,@a)
    170                                       `(pdf-dic /Length ,(length x))))
    171                                (insert "\nstream")
    172                                (insert x)
    173                                (insert "\nendstream"))))
    174                           (pdf-obj
    175                            (cl-destructuring-bind (a b &rest c) (cdr x)
    176                              (push `(,a ,b ,(point)) objs)
    177                              (insert (format "\n%d %d obj" a b))
    178                              (mapc #'rec c)
    179                              (insert "\nendobj")))
    180                           (pdf-dic
    181                            (insert "\n<<")
    182                            (mapc #'rec (cdr x))
    183                            (insert "\n>>"))
    184                           (pdf-vec
    185                            (insert "\n[")
    186                            (mapc #'rec (cdr x))
    187                            (insert "\n]"))
    188                           (pdf-ref
    189                            (cl-destructuring-bind (a b) (cdr x)
    190                              (insert (format "\n%d %d R" a b)))))))))
    191       (set-buffer-multibyte nil)
    192       (rec x))))
    193 
    194 (defun pdf-brook-collect (brook)
    195   "Collect all values pulled from brook."
    196   (cl-loop
    197    with z = nil
    198    while (setq z (funcall brook))
    199    collect z))
    200 
    201 (defun pdf-brook-appending (brook)
    202   "Append all values pulled from brook."
    203   (cl-loop
    204    with z = nil
    205    while (setq z (funcall brook))
    206    appending z))
    207 
    208 (defun pdf-brook-count (brook)
    209   "Count all values in brook."
    210   (cl-loop
    211    with z = nil
    212    while (setq z (funcall brook))
    213    count z))
    214 
    215 (defun pdf-brook (x)
    216   "Make new brook from x."
    217   (cl-etypecase x
    218     (list
    219      (lambda ()
    220        (pop x)))))
    221 
    222 ;;(pdf-brook-collect (pdf-brook '(1 2 3 4)))
    223 ;;(pdf-brook-count (pdf-brook '(1 2 3 4)))
    224 
    225 (defun pdf-flat-brook (&rest brooks)
    226   "Compose brooks left to right, depth-first."
    227   (lambda ()
    228     (cl-block loop
    229       (while brooks
    230         (let ((z (funcall (car brooks))))
    231           (cond
    232            ((functionp z) (push z brooks))
    233            (z (cl-return-from loop z))
    234            (t (pop brooks))))))))
    235 
    236 ;;(pdf-brook-collect (pdf-flat-brook (pdf-brook '(1 2 3)) (pdf-brook '(4 5 6))))
    237 
    238 (defun pdf-source-line-brook (string)
    239   "Make brook from string.  Elements are string per line or 'pagebreak."
    240   (pdf-flat-brook
    241    (let ((pages (pdf-brook (split-string string ""))))
    242      (lambda ()
    243        (let ((page (funcall pages)))
    244          (when page
    245            (pdf-brook (list (pdf-brook (split-string page "\n"))
    246                             (pdf-brook '(pagebreak))))))))))
    247 
    248 ;;(pdf-brook-collect (pdf-source-line-brook "1\n23\n4\n5"))
    249 
    250 (defun pdf-source-page-brook (brook)
    251   "Make brook for single page from brook."
    252   (lambda ()
    253     (let ((z (funcall brook)))
    254       (when z
    255         (unless (eq 'pagebreak z)
    256           z)))))
    257 
    258 ;;(pdf-brook-collect (pdf-source-page-brook (pdf-source-line-brook "1\n23\n4\n5")))
    259 
    260 (defvar *pdf-page-number*)
    261 (defun pdf-page-number ()
    262   "Return current page number as string.  Useful in document
    263 header or footer."
    264   (format "%s" *pdf-page-number*))
    265 
    266 (defvar *pdf-number-of-pages*)
    267 (defun pdf-number-of-pages ()
    268   "Return number of pages as string.  Useful in document header
    269 or footer."
    270   (format "%s" *pdf-number-of-pages*))
    271 
    272 (defvar *pdf-file-name*)
    273 (defun pdf-dirpart ()
    274   "Return directory part as string.  Useful in document header or
    275 footer."
    276   (and *pdf-file-name* (file-name-directory *pdf-file-name*)))
    277 (defun pdf-nondirpart ()
    278   "Return non-directory part as string.  Useful in document header or
    279 footer."
    280   (and *pdf-file-name* (file-name-nondirectory *pdf-file-name*)))
    281 
    282 (defun pdf-iso8601-date ()
    283   "Return current data as ISO8601 string.  Useful in document
    284 header or footer."
    285   (format-time-string "%Y-%m-%d"))
    286 
    287 (defun pdf-header-or-footer-text (i n file-name list)
    288   "Insert document header or footer specified in list."
    289   (with-temp-buffer
    290     (let ((*pdf-page-number* i)
    291           (*pdf-number-of-pages* n)
    292           (*pdf-file-name* file-name))
    293       (dolist (x list)
    294         (when x
    295           (insert
    296            (cl-etypecase x
    297              (function (or (funcall x) ""))
    298              (symbol (or (symbol-value x) ""))
    299              (string x))))))
    300     (buffer-string)))
    301 
    302 (defun pdf-header-text (i n file-name)
    303   "Insert document header."
    304   (pdf-header-or-footer-text i n file-name pdf-header))
    305 
    306 (defun pdf-footer-text (i n file-name)
    307   "Insert document footer."
    308   (pdf-header-or-footer-text i n file-name pdf-footer))
    309 
    310 (defun pdf-line (x y line)
    311   "Represent PDF line as list of PDF drawing primitives."
    312   `(1 0 0 1 ,x ,y Tm ,line Tj))
    313 
    314 (defun pdf-page-text (lines x0 y0 line-height header footer)
    315   "Represent PDF page as list of PDF drawing primitives."
    316   (pdf-brook-appending
    317    (let* ((page (pdf-source-page-brook lines))
    318           (bottom-margin (+ ps-bottom-margin
    319                             (if footer (+ line-height ps-footer-offset) 0)))
    320           (y y0))
    321      (lambda ()
    322        (when (<= bottom-margin (cl-decf y line-height))
    323          (let ((line (funcall page)))
    324            (when line
    325              `(,@(when header
    326                    (prog1 (pdf-line x0 y header)
    327                      (setq header nil)
    328                      (cl-decf y (+ line-height ps-header-offset))))
    329                ,@(when footer
    330                    (prog1 (pdf-line x0 ps-bottom-margin footer)
    331                      (setq footer nil)))
    332                ,@(pdf-line x0 y line)))))))))
    333 
    334 (defun pdf-page-dimensions ()
    335   "Return values of page width and height depending on
    336 ps-paper-type and ps-landscape-mode."
    337   (let ((x (cdr (assq ps-paper-type ps-page-dimensions-database))))
    338     (if ps-landscape-mode
    339         (values (cadr x) (car x))
    340       (values (car x) (cadr x)))))
    341 
    342 ;;(pdf-page-dimensions)
    343 
    344 (defun pdf-pages-brook (substring x0 y0 line-height font-size
    345                                   npages file-name parent oid !ref)
    346   "Make brook of PDF objects per page."
    347   (let ((lines (pdf-source-line-brook substring))
    348         (i 0))
    349     (lambda ()
    350       (cl-incf i)
    351       (let ((text (pdf-page-text lines x0 y0 line-height
    352                                  (when ps-print-header
    353                                    (pdf-header-text i npages file-name))
    354                                  (when ps-print-footer
    355                                    (pdf-footer-text i npages file-name)))))
    356         (when text
    357           (let ((oid1 (funcall oid))
    358                 (oid2 (funcall oid)))
    359             (funcall !ref `(pdf-ref ,oid2 0))
    360             `((pdf-obj ,oid1
    361                        0
    362                        (pdf-stream nil
    363                                    BT
    364                                    /F1 ,font-size Tf
    365                                    1 0 0 1 ,x0 ,y0 Tm
    366                                    ,@text
    367                                    ET))
    368               (pdf-obj ,oid2
    369                        0
    370                        (pdf-dic /Type /Page
    371                                 /Parent ,parent
    372                                 /Resources (pdf-ref 2 0)
    373                                 /Contents (pdf-ref ,oid1 0))))))))))
    374 
    375 (defun pdf-npages (substring x0 y0 line-height font-size file-name)
    376   "Count number of pages in the document."
    377   (pdf-brook-count
    378    (pdf-pages-brook substring x0 y0 line-height font-size 0 file-name nil
    379                     (lambda () 0)
    380                     (lambda (x) (ignore x)))))
    381 
    382 (defun pdf-region (from to &optional file-name)
    383   "Save region to PDF file."
    384   (interactive "r")
    385   (cl-multiple-value-bind (page-width page-height) (pdf-page-dimensions)
    386     (let* ((coding-system-for-write 'raw-text-unix)
    387            (source-file-name (or file-name
    388                                  (buffer-file-name)
    389                                  (buffer-name)))
    390            (file-name (concat source-file-name ".pdf"))
    391            (x0 ps-left-margin)
    392            (y0 (- page-height ps-top-margin))
    393            (font-size (cl-etypecase ps-font-size
    394                         (number ps-font-size)
    395                         (cons (if ps-landscape-mode
    396                                   (car ps-font-size)
    397                                 (cdr ps-font-size)))))
    398            (line-height (* pdf-line-height-factor font-size))
    399            (substring (buffer-substring-no-properties
    400 		       from
    401 		       (or (when pdf-end-regexp
    402 			     (save-excursion
    403 			       (goto-char (point-min))
    404 			       (when (re-search-forward pdf-end-regexp to 'noerror)
    405 				 (min to (match-beginning 0)))))
    406 			   to)))
    407            (npages (when (or (when ps-print-header
    408                                (member 'pdf-number-of-pages pdf-header))
    409                              (when ps-print-footer
    410                                (member 'pdf-number-of-pages pdf-footer)))
    411                      (pdf-npages substring x0 y0 line-height font-size
    412                                  source-file-name))))
    413       (with-temp-buffer
    414         (insert-pdf
    415          (let ((oid 0)
    416                %pages
    417                (%parent `(pdf-ref -1 0)))
    418            `(pdf
    419              (pdf-obj ,(cl-incf oid)
    420                       0
    421                       (pdf-dic /Type /Font
    422                                /Subtype /Type1
    423                                /Name /F1
    424                                /BaseFont ,pdf-base-font))
    425              (pdf-obj ,(cl-incf oid)
    426                       0
    427                       (pdf-dic /ProcSet (pdf-vec /PDF /Text)
    428                                /Font (pdf-dic /F1 (pdf-ref ,(1- oid) 0))))
    429              ,@(pdf-brook-appending
    430                 (pdf-pages-brook substring x0 y0 line-height font-size npages
    431                                  source-file-name
    432                                  %parent
    433                                  (lambda () (cl-incf oid))
    434                                  (lambda (x) (push x %pages))))
    435              (pdf-obj ,(setf (cadr %parent) (cl-incf oid))
    436                       0
    437                       (pdf-dic /Type /Pages
    438                                /Count ,(length %pages)
    439                                /Kids (pdf-vec ,@(nreverse %pages))
    440                                /MediaBox (pdf-vec 0 0 ,page-width ,page-height)))
    441              (pdf-obj ,(cl-incf oid)
    442                       0
    443                       (pdf-dic /Type /Catalog
    444                                /Pages (pdf-ref ,(1- oid) 0)))
    445              (pdf-xref /Root (pdf-ref ,oid 0)))))
    446         (write-region (point-min) (point-max) file-name)))))
    447 
    448 (defun pdf-buffer (&optional file-name)
    449   "Save buffer to PDF file."
    450   (interactive)
    451   (pdf-region (point-min) (point-max) file-name))
    452 
    453 (provide 'emacs-pdf)
	emacs-pdf Emacs library to print buffer to PDF file.
	Log \| Files \| Refs \| README