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