~ubuntu-branches/ubuntu/oneiric/muse-el/oneiric

« back to all changes in this revision

Viewing changes to lisp/muse-book.el

  • Committer: Bazaar Package Importer
  • Author(s): Michael W. Olson (GNU address)
  • Date: 2007-06-25 08:17:44 UTC
  • mto: This revision was merged to the branch mainline in revision 5.
  • Revision ID: james.westby@ubuntu.com-20070625081744-h7ajew6icqoiltfp
Tags: upstream-3.03
ImportĀ upstreamĀ versionĀ 3.03

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
1
;;; muse-book.el --- publish entries into a compilation
2
2
 
3
 
;; Copyright (C) 2004, 2005 Free Software Foundation, Inc.
 
3
;; Copyright (C) 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
4
4
 
5
5
;; This file is part of Emacs Muse.  It is not part of GNU Emacs.
6
6
 
34
34
(require 'muse-publish)
35
35
(require 'muse-project)
36
36
(require 'muse-latex)
 
37
(require 'muse-regexps)
37
38
 
38
39
(defgroup muse-book nil
39
40
  "Module for publishing a series of Muse pages as a complete book.
93
94
    (goto-char beg)
94
95
    (unless (or nochapters
95
96
                (muse-style-element :nochapters style))
96
 
      (insert "\n" (muse-markup-text 'chapter)
97
 
              (let ((chap (muse-publishing-directive "title")))
 
97
      (insert "\n")
 
98
      (muse-insert-markup (muse-markup-text 'chapter))
 
99
      (insert (let ((chap (muse-publishing-directive "title")))
98
100
                (if (string= chap title)
99
101
                    (car entry)
100
 
                  chap))
101
 
              (muse-markup-text 'chapter-end) "\n\n"))
 
102
                  chap)))
 
103
      (muse-insert-markup (muse-markup-text 'chapter-end))
 
104
      (insert "\n\n"))
102
105
    (save-restriction
103
106
      (narrow-to-region beg end)
104
107
      (muse-publish-markup (or title "")
107
110
      (muse-style-run-hooks :after style))
108
111
    (goto-char end)))
109
112
 
 
113
(defun muse-book-publish-p (project target)
 
114
  "Determine whether the book in PROJECT is out-of-date."
 
115
  (let ((pats (cadr project)))
 
116
    (catch 'publish
 
117
      (while pats
 
118
        (if (symbolp (car pats))
 
119
            (if (eq :book-end (car pats))
 
120
                (throw 'publish nil)
 
121
              ;; skip past symbol-value pair
 
122
              (setq pats (cddr pats)))
 
123
          (dolist (entry (muse-project-file-entries (car pats)))
 
124
            (when (and (not (muse-project-private-p (cdr entry)))
 
125
                       (file-newer-than-file-p (cdr entry) target))
 
126
              (throw 'publish t)))
 
127
          (setq pats (cdr pats)))))))
 
128
 
 
129
(defun muse-book-get-directives (file)
 
130
  "Interpret any publishing directives contained in FILE.
 
131
This is meant to be called in a temp buffer that will later be
 
132
used for publishing."
 
133
  (save-restriction
 
134
    (narrow-to-region (point) (point))
 
135
    (unwind-protect
 
136
        (progn
 
137
          (insert-file-contents file)
 
138
          (muse-publish-markup
 
139
           "attributes"
 
140
           `(;; Remove leading and trailing whitespace from the file
 
141
             (100 "\\(\\`\n+\\|\n+\\'\\)" 0 "")
 
142
             ;; Remove trailing whitespace from all lines
 
143
             (200 ,(concat "[" muse-regexp-blank "]+$") 0 "")
 
144
             ;; Handle any leading #directives
 
145
             (300 "\\`#\\([a-zA-Z-]+\\)\\s-+\\(.+\\)\n+"
 
146
                  0 muse-publish-markup-directive))))
 
147
      (delete-region (point-min) (point-max)))))
 
148
 
110
149
(defun muse-book-publish-project
111
150
  (project book title style &optional output-dir force)
112
151
  "Publish PROJECT under the name BOOK with the given TITLE and STYLE.
120
159
                   (read-string "Basename of book (without extension): ")
121
160
                   (read-string "Title of book: "))
122
161
             (muse-publish-get-info))))
 
162
  (setq project (muse-project project))
 
163
  (let ((muse-current-project project))
 
164
    ;; See if any of the project's files need saving first
 
165
    (muse-project-save-buffers project)
 
166
    ;; Publish the book
 
167
    (muse-book-publish book style output-dir force title)))
 
168
 
 
169
(defun muse-book-publish (file style &optional output-dir force title)
 
170
  "Publish FILE as a book with the given TITLE and STYLE.
 
171
The book is published to OUTPUT-DIR.  If FORCE is nil, the book
 
172
is only published if at least one of its component pages has
 
173
changed since it was last published."
123
174
  ;; Cleanup some of the arguments
124
 
  (setq project (muse-project project)
125
 
        style (muse-style style))
126
 
  ;; See if any of the project's files need saving first
127
 
  (muse-project-save-buffers project)
 
175
  (let ((style-name style))
 
176
    (setq style (muse-style style))
 
177
    (unless style
 
178
      (error "There is no style '%s' defined" style-name)))
128
179
  ;; Publish each page in the project as a chapter in one large book
129
 
  (let* ((output-path (muse-publish-output-file book output-dir style))
 
180
  (let* ((output-path (muse-publish-output-file file output-dir style))
130
181
         (output-suffix (muse-style-element :osuffix style))
131
182
         (target output-path)
132
 
         (pats (cadr project))
133
 
         (publish force) published)
 
183
         (project muse-current-project)
 
184
         (published nil))
134
185
    (when output-suffix
135
 
      (setq target (concat (file-name-sans-extension target)
 
186
      (setq target (concat (muse-path-sans-extension target)
136
187
                           output-suffix)))
137
188
    ;; Unless force is non-nil, determine if the book needs publishing
138
 
    (unless force
139
 
      (while pats
140
 
        (if (symbolp (car pats))
141
 
            (if (eq :book-end (car pats))
142
 
                (setq pats nil)
143
 
              (setq pats (cddr pats)))
144
 
          (let ((entries (muse-project-file-entries (car pats))))
145
 
            (while entries
146
 
              (if (and (not (muse-project-private-p (cdar entries)))
147
 
                       (file-newer-than-file-p (cdar entries) target))
148
 
                  (setq publish t entries nil)
149
 
                (setq entries (cdr entries)))))
150
 
          (setq pats (cdr pats)))))
151
 
    ;; Create the book from all its component parts
152
 
    (if (not publish)
153
 
        (message "The book \"%s\" is up-to-date." book)
 
189
    (if (and (not force)
 
190
             (not (muse-book-publish-p project target)))
 
191
        (message "The book \"%s\" is up-to-date." file)
 
192
      ;; Create the book from all its component parts
154
193
      (muse-with-temp-buffer
155
194
        (let ((style-final  (muse-style-element :final  style t))
156
195
              (style-header (muse-style-element :header style))
157
196
              (style-footer (muse-style-element :footer style))
158
197
              (muse-publishing-current-style style)
159
198
              (muse-publishing-directives
160
 
               (list (cons "title" title)
 
199
               (list (cons "title" (or title (muse-page-name file)))
161
200
                     (cons "date" (format-time-string "%B %e, %Y"))))
162
201
              (muse-publishing-p t)
163
202
              (muse-current-project project)
164
 
              nochapters)
 
203
              (pats (cadr project))
 
204
              (nochapters nil))
165
205
          (run-hooks 'muse-before-book-publish-hook)
166
 
          (setq pats (cadr project))
167
206
          (let ((style-final style-final)
168
207
                (style-header style-header)
169
208
                (style-footer style-footer))
 
209
            (unless title
 
210
              (muse-book-get-directives file)
 
211
              (setq title (muse-publishing-directive "title")))
170
212
            (while pats
171
213
              (if (symbolp (car pats))
172
214
                  (cond
173
215
                   ((eq :book-part (car pats))
174
 
                    (insert "\n" (muse-markup-text 'part) (cadr pats)
175
 
                            (muse-markup-text 'part-end) "\n")
 
216
                    (insert "\n")
 
217
                    (muse-insert-markup (muse-markup-text 'part))
 
218
                    (insert (cadr pats))
 
219
                    (muse-insert-markup (muse-markup-text 'part-end))
 
220
                    (insert "\n")
176
221
                    (setq pats (cddr pats)))
177
222
                   ((eq :book-chapter (car pats))
178
 
                    (insert "\n" (muse-markup-text 'chapter) (cadr pats)
179
 
                            (muse-markup-text 'chapter-end) "\n")
 
223
                    (insert "\n")
 
224
                    (muse-insert-markup (muse-markup-text 'chapter))
 
225
                    (insert (cadr pats))
 
226
                    (muse-insert-markup (muse-markup-text 'chapter-end))
 
227
                    (insert "\n")
180
228
                    (setq pats (cddr pats)))
181
229
                   ((eq :nochapters (car pats))
182
230
                    (setq nochapters t
204
252
                    (setq entries (cdr entries))))
205
253
                (setq pats (cdr pats)))))
206
254
          (goto-char (point-min))
207
 
          (if style-header (muse-insert-file-or-string style-header book))
 
255
          (if style-header (muse-insert-file-or-string style-header file))
208
256
          (goto-char (point-max))
209
 
          (if style-footer (muse-insert-file-or-string style-footer book))
 
257
          (if style-footer (muse-insert-file-or-string style-footer file))
210
258
          (run-hooks 'muse-after-book-publish-hook)
211
259
          (let ((backup-inhibited t))
212
260
            (write-file output-path))
213
261
          (if style-final
214
 
              (funcall style-final book output-path target)))))
 
262
              (funcall style-final file output-path target)))))
215
263
    (if published
216
 
        (message "The book \"%s\" has been published." book))
 
264
        (message "The book \"%s\" has been published." file))
217
265
    published))
218
266
 
219
 
(unless (assoc "book-latex" muse-publishing-styles)
220
 
  (muse-derive-style "book-latex" "latex"
221
 
                     :header 'muse-book-latex-header
222
 
                     :footer 'muse-book-latex-footer)
223
 
 
224
 
  (muse-derive-style "book-pdf" "pdf"
225
 
                     :header 'muse-book-latex-header
226
 
                     :footer 'muse-book-latex-footer))
 
267
;;; Register the Muse BOOK Publishers
 
268
 
 
269
(muse-derive-style "book-latex" "latex"
 
270
                   :header 'muse-book-latex-header
 
271
                   :footer 'muse-book-latex-footer
 
272
                   :publish 'muse-book-publish)
 
273
 
 
274
(muse-derive-style "book-pdf" "pdf"
 
275
                   :header 'muse-book-latex-header
 
276
                   :footer 'muse-book-latex-footer
 
277
                   :publish 'muse-book-publish)
227
278
 
228
279
(provide 'muse-book)
229
280