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

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