lisp/muse-book.el

   1 ;;; muse-book.el --- publish entries into a compilation
   2
   3 ;; Copyright (C) 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
   4
   5 ;; This file is part of Emacs Muse.  It is not part of GNU Emacs.
   6
   7 ;; Emacs Muse is free software; you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published
   9 ;; by the Free Software Foundation; either version 2, or (at your
  10 ;; option) any later version.
  11
  12 ;; Emacs Muse is distributed in the hope that it will be useful, but
  13 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 ;; General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with Emacs Muse; see the file COPYING.  If not, write to the
  19 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  20 ;; Boston, MA 02110-1301, USA.
  21
  22 ;;; Commentary:
  23
  24 ;;; Contributors:
  25
  26 ;;; Code:
  27
  28 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  29 ;;
  30 ;; Muse Book Publishing
  31 ;;
  32 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  33
  34 (require 'muse-publish)
  35 (require 'muse-project)
  36 (require 'muse-latex)
  37 (require 'muse-regexps)
  38
  39 (defgroup muse-book nil
  40   "Module for publishing a series of Muse pages as a complete book.
  41 Each page will become a separate chapter in the book, unless the
  42 style keyword :nochapters is used, in which case they are all run
  43 together as if one giant chapter."
  44   :group 'muse-publish)
  45
  46 (defcustom muse-book-before-publish-hook nil
  47   "A hook run in the book buffer before it is marked up."
  48   :type 'hook
  49   :group 'muse-book)
  50
  51 (defcustom muse-book-after-publish-hook nil
  52   "A hook run in the book buffer after it is marked up."
  53   :type 'hook
  54   :group 'muse-book)
  55
  56 (defcustom muse-book-latex-header
  57   "\\documentclass{book}
  58
  59 \\usepackage[english]{babel}
  60 \\usepackage[latin1]{inputenc}
  61 \\usepackage[T1]{fontenc}
  62
  63 \\begin{document}
  64
  65 \\title{<lisp>(muse-publishing-directive \"title\")</lisp>}
  66 \\author{<lisp>(muse-publishing-directive \"author\")</lisp>}
  67 \\date{<lisp>(muse-publishing-directive \"date\")</lisp>}
  68
  69 \\maketitle
  70
  71 \\tableofcontents\n"
  72   "Header used for publishing books to LaTeX.  This may be text or a filename."
  73   :type 'string
  74   :group 'muse-book)
  75
  76 (defcustom muse-book-latex-footer
  77   "<lisp>(muse-latex-bibliography)</lisp>
  78 \\end{document}"
  79   "Footer used for publishing books to LaTeX.  This may be text or a filename."
  80   :type 'string
  81   :group 'muse-book)
  82
  83 (defun muse-book-publish-chapter (title entry style &optional nochapters)
  84   "Publish the chapter TITLE for the file ENTRY using STYLE.
  85 TITLE is a string, ENTRY is a cons of the form (PAGE-NAME .
  86 FILE), and STYLE is a Muse style list.
  87
  88 This routine does the same basic work as `muse-publish-markup-buffer',
  89 but treating the page as if it were a single chapter within a book."
  90   (let ((muse-publishing-directives (list (cons "title" title)))
  91         (muse-publishing-current-file (cdr entry))
  92         (beg (point)) end)
  93     (insert-file-contents (cdr entry))
  94     (setq end (copy-marker (point-max) t))
  95     (muse-publish-markup-region beg end (car entry) style)
  96     (goto-char beg)
  97     (unless (or nochapters
  98                 (muse-style-element :nochapters style))
  99       (insert "\n")
 100       (muse-insert-markup (muse-markup-text 'chapter))
 101       (insert (let ((chap (muse-publishing-directive "title")))
 102                 (if (string= chap title)
 103                     (car entry)
 104                   chap)))
 105       (muse-insert-markup (muse-markup-text 'chapter-end))
 106       (insert "\n\n"))
 107     (save-restriction
 108       (narrow-to-region beg end)
 109       (muse-publish-markup (or title "")
 110                            '((100 "<\\(lisp\\)>" 0
 111                               muse-publish-markup-tag)))
 112       (muse-style-run-hooks :after style))
 113     (goto-char end)))
 114
 115 (defun muse-book-publish-p (project target)
 116   "Determine whether the book in PROJECT is out-of-date."
 117   (let ((pats (cadr project)))
 118     (catch 'publish
 119       (while pats
 120         (if (symbolp (car pats))
 121             (if (eq :book-end (car pats))
 122                 (throw 'publish nil)
 123               ;; skip past symbol-value pair
 124               (setq pats (cddr pats)))
 125           (dolist (entry (muse-project-file-entries (car pats)))
 126             (when (and (not (muse-project-private-p (cdr entry)))
 127                        (file-newer-than-file-p (cdr entry) target))
 128               (throw 'publish t)))
 129           (setq pats (cdr pats)))))))
 130
 131 (defun muse-book-get-directives (file)
 132   "Interpret any publishing directives contained in FILE.
 133 This is meant to be called in a temp buffer that will later be
 134 used for publishing."
 135   (save-restriction
 136     (narrow-to-region (point) (point))
 137     (unwind-protect
 138         (progn
 139           (insert-file-contents file)
 140           (muse-publish-markup
 141            "attributes"
 142            `(;; Remove leading and trailing whitespace from the file
 143              (100 "\\(\\`\n+\\|\n+\\'\\)" 0 "")
 144              ;; Remove trailing whitespace from all lines
 145              (200 ,(concat "[" muse-regexp-blank "]+$") 0 "")
 146              ;; Handle any leading #directives
 147              (300 "\\`#\\([a-zA-Z-]+\\)\\s-+\\(.+\\)\n+"
 148                   0 muse-publish-markup-directive))))
 149       (delete-region (point-min) (point-max)))))
 150
 151 (defun muse-book-publish-project
 152   (project book title style &optional output-dir force)
 153   "Publish PROJECT under the name BOOK with the given TITLE and STYLE.
 154 BOOK should be a page name, i.e., letting the style determine the
 155 prefix and/or suffix.  The book is published to OUTPUT-DIR.  If FORCE
 156 is nil, the book is only published if at least one of its component
 157 pages has changed since it was last published."
 158   (interactive
 159    (let ((project (muse-read-project "Publish project as book: " nil t)))
 160      (append (list project
 161                    (read-string "Basename of book (without extension): ")
 162                    (read-string "Title of book: "))
 163              (muse-publish-get-info))))
 164   (setq project (muse-project project))
 165   (let ((muse-current-project project))
 166     ;; See if any of the project's files need saving first
 167     (muse-project-save-buffers project)
 168     ;; Publish the book
 169     (muse-book-publish book style output-dir force title)))
 170
 171 (defun muse-book-publish (file style &optional output-dir force title)
 172   "Publish FILE as a book with the given TITLE and STYLE.
 173 The book is published to OUTPUT-DIR.  If FORCE is nil, the book
 174 is only published if at least one of its component pages has
 175 changed since it was last published."
 176   ;; Cleanup some of the arguments
 177   (let ((style-name style))
 178     (setq style (muse-style style))
 179     (unless style
 180       (error "There is no style '%s' defined" style-name)))
 181   ;; Publish each page in the project as a chapter in one large book
 182   (let* ((output-path (muse-publish-output-file file output-dir style))
 183          (output-suffix (muse-style-element :osuffix style))
 184          (target output-path)
 185          (project muse-current-project)
 186          (published nil))
 187     (when output-suffix
 188       (setq target (concat (muse-path-sans-extension target)
 189                            output-suffix)))
 190     ;; Unless force is non-nil, determine if the book needs publishing
 191     (if (and (not force)
 192              (not (muse-book-publish-p project target)))
 193         (message "The book \"%s\" is up-to-date." file)
 194       ;; Create the book from all its component parts
 195       (muse-with-temp-buffer
 196         (let ((style-final  (muse-style-element :final  style t))
 197               (style-header (muse-style-element :header style))
 198               (style-footer (muse-style-element :footer style))
 199               (muse-publishing-current-style style)
 200               (muse-publishing-directives
 201                (list (cons "title" (or title (muse-page-name file)))
 202                      (cons "date" (format-time-string "%B %e, %Y"))))
 203               (muse-publishing-p t)
 204               (muse-current-project project)
 205               (pats (cadr project))
 206               (nochapters nil))
 207           (run-hooks 'muse-before-book-publish-hook)
 208           (let ((style-final style-final)
 209                 (style-header style-header)
 210                 (style-footer style-footer))
 211             (unless title
 212               (muse-book-get-directives file)
 213               (setq title (muse-publishing-directive "title")))
 214             (while pats
 215               (if (symbolp (car pats))
 216                   (cond
 217                    ((eq :book-part (car pats))
 218                     (insert "\n")
 219                     (muse-insert-markup (muse-markup-text 'part))
 220                     (insert (cadr pats))
 221                     (muse-insert-markup (muse-markup-text 'part-end))
 222                     (insert "\n")
 223                     (setq pats (cddr pats)))
 224                    ((eq :book-chapter (car pats))
 225                     (insert "\n")
 226                     (muse-insert-markup (muse-markup-text 'chapter))
 227                     (insert (cadr pats))
 228                     (muse-insert-markup (muse-markup-text 'chapter-end))
 229                     (insert "\n")
 230                     (setq pats (cddr pats)))
 231                    ((eq :nochapters (car pats))
 232                     (setq nochapters t
 233                           pats (cddr pats)))
 234                    ((eq :book-style (car pats))
 235                     (setq style (muse-style (cadr pats)))
 236                     (setq style-final  (muse-style-element :final  style t)
 237                           style-header (muse-style-element :header style)
 238                           style-footer (muse-style-element :footer style)
 239                           muse-publishing-current-style style)
 240                     (setq pats (cddr pats)))
 241                    ((eq :book-funcall (car pats))
 242                     (funcall (cadr pats))
 243                     (setq pats (cddr pats)))
 244                    ((eq :book-end (car pats))
 245                     (setq pats nil))
 246                    (t
 247                     (setq pats (cddr pats))))
 248                 (let ((entries (muse-project-file-entries (car pats))))
 249                   (while (and entries (car entries) (caar entries))
 250                     (unless (muse-project-private-p (cdar entries))
 251                       (muse-book-publish-chapter title (car entries)
 252                                                  style nochapters)
 253                       (setq published t))
 254                     (setq entries (cdr entries))))
 255                 (setq pats (cdr pats)))))
 256           (goto-char (point-min))
 257           (if style-header (muse-insert-file-or-string style-header file))
 258           (goto-char (point-max))
 259           (if style-footer (muse-insert-file-or-string style-footer file))
 260           (run-hooks 'muse-after-book-publish-hook)
 261           (let ((backup-inhibited t))
 262             (write-file output-path))
 263           (if style-final
 264               (funcall style-final file output-path target)))))
 265     (if published
 266         (message "The book \"%s\" has been published." file))
 267     published))
 268
 269 ;;; Register the Muse BOOK Publishers
 270
 271 (muse-derive-style "book-latex" "latex"
 272                    :header 'muse-book-latex-header
 273                    :footer 'muse-book-latex-footer
 274                    :publish 'muse-book-publish)
 275
 276 (muse-derive-style "book-pdf" "pdf"
 277                    :header 'muse-book-latex-header
 278                    :footer 'muse-book-latex-footer
 279                    :publish 'muse-book-publish)
 280
 281 (provide 'muse-book)
 282
 283 ;;; muse-book.el ends here