diff options
author | Jambunathan K <kjambunathan@gmail.com> | 2012-07-14 18:20:52 +0530 |
---|---|---|
committer | Jambunathan K <kjambunathan@gmail.com> | 2012-07-14 18:21:31 +0530 |
commit | f0d5d935ce4046351d7bc9afae930769db4d17b4 (patch) | |
tree | afab99c86094a78a2ec2cc8c71d9deece3102a5d | |
parent | 373cb5a37e2539320c3e23e2848dae1da46e0053 (diff) | |
download | org-mode-f0d5d935ce4046351d7bc9afae930769db4d17b4.tar.gz |
org-e-odt.el: Introduced `org-e-odt--export-wrap'
- Clean up work directory and buffers on error.
- Don't use `org-current-export-file'.
- Handle file paths robustly i.e., don't rely on `default-directory'.
- Remove stale code.
-rw-r--r-- | contrib/lisp/org-e-odt.el | 367 |
1 files changed, 162 insertions, 205 deletions
diff --git a/contrib/lisp/org-e-odt.el b/contrib/lisp/org-e-odt.el index 2a68a20..e78f5d6 100644 --- a/contrib/lisp/org-e-odt.el +++ b/contrib/lisp/org-e-odt.el @@ -243,7 +243,7 @@ structure of the values.") (defun org-e-odt-write-automatic-styles () "Write automatic styles to \"content.xml\"." (with-current-buffer - (find-file-noselect (expand-file-name "content.xml") t) + (find-file-noselect (concat org-e-odt-zip-dir "content.xml") t) ;; position the cursor (goto-char (point-min)) (re-search-forward " </office:automatic-styles>" nil t) @@ -256,7 +256,7 @@ structure of the values.") (defun org-e-odt-update-display-level (&optional level) (with-current-buffer - (find-file-noselect (expand-file-name "content.xml") t) + (find-file-noselect (concat org-e-odt-zip-dir "content.xml") t) ;; position the cursor. (goto-char (point-min)) ;; remove existing sequence decls. @@ -465,7 +465,7 @@ Update styles.xml with styles that were collected as part of `org-e-odt-hfy-face-to-css' callbacks." (when styles (with-current-buffer - (find-file-noselect (expand-file-name "styles.xml") t) + (find-file-noselect (concat org-e-odt-zip-dir "styles.xml") t) (goto-char (point-min)) (when (re-search-forward "</office:styles>" nil t) (goto-char (match-beginning 0)) @@ -526,6 +526,9 @@ Update styles.xml with styles that were collected as part of (string-match "file:\\([^]]*\\)" formula-link) (match-string 1 formula-link)))) (t (error "what is this?")))) + (src-expanded (if (file-name-absolute-p src) src + (expand-file-name src (file-name-directory + (plist-get info :input-file))))) (caption-from (case (org-element-type element) (link (org-export-get-parent-element element)) @@ -535,7 +538,7 @@ Update styles.xml with styles that were collected as part of (href (org-e-odt-format-tags "<draw:object xlink:href=\"%s\" xlink:type=\"simple\" xlink:show=\"embed\" xlink:actuate=\"onLoad\"/>" "" - (file-name-directory (org-e-odt-copy-formula-file src)))) + (file-name-directory (org-e-odt-copy-formula-file src-expanded)))) (embed-as (if caption 'paragraph 'character)) width height) (cond @@ -563,25 +566,25 @@ Update styles.xml with styles that were collected as part of (car (org-e-odt-format-label caption-from info 'definition))))) '(table (:attr_odt (":style \"OrgEquation\""))) info)))))) -(defun org-e-odt-copy-formula-file (path) +(defun org-e-odt-copy-formula-file (src-file) "Returns the internal name of the file" - (let* ((src-file (expand-file-name - path (file-name-directory org-current-export-file))) - (target-dir (format "Formula-%04d/" + (let* ((target-dir (format "Formula-%04d/" (incf org-e-odt-embedded-formulas-count))) (target-file (concat target-dir "content.xml"))) - (message "Embedding %s as %s ..." - (substring-no-properties path) target-file) + (message "Embedding %s as %s ..." src-file target-file) + + (when (= org-e-odt-embedded-formulas-count 1) + (make-directory (concat org-e-odt-zip-dir target-dir))) - (make-directory target-dir) (org-e-odt-create-manifest-file-entry "application/vnd.oasis.opendocument.formula" target-dir "1.2") (case (org-e-odt-is-formula-link-p src-file) (mathml - (copy-file src-file target-file 'overwrite)) + (copy-file src-file (concat org-e-odt-zip-dir target-file) 'overwrite)) (odf - (org-e-odt-zip-extract-one src-file "content.xml" target-dir)) + (org-e-odt-zip-extract-one src-file "content.xml" + (concat org-e-odt-zip-dir target-dir))) (t (error "%s is not a formula file" src-file))) @@ -596,81 +599,6 @@ Update styles.xml with styles that were collected as part of ((string-match "\\.odf\\'" file) 'odf)))) -(defun org-e-odt-format-org-link (opt-plist type-1 path fragment desc attr - descp) - "Make a OpenDocument link. -OPT-PLIST is an options list. -TYPE-1 is the device-type of the link (THIS://foo.html). -PATH is the path of the link (http://THIS#location). -FRAGMENT is the fragment part of the link, if any (foo.html#THIS). -DESC is the link description, if any. -ATTR is a string of other attributes of the a element." - (declare (special org-lparse-par-open)) - (save-match-data - (let* ((may-inline-p - (and (member type-1 '("http" "https" "file")) - (org-lparse-should-inline-p path descp) - (not fragment))) - (type (if (equal type-1 "id") "file" type-1)) - (filename path) - (thefile path)) - (cond - ;; check for inlined images - ((and (member type '("file")) - (not fragment) - (org-file-image-p - filename org-e-odt-inline-image-extensions) - (not descp)) - (org-e-odt-format-inline-image thefile)) - ;; check for embedded formulas - ((and (member type '("file")) - (not fragment) - (org-e-odt-is-formula-link-p filename) - (or (not descp))) - (org-e-odt-format-formula thefile)) - ((string= type "coderef") - (let* ((ref fragment) - (lineno-or-ref (cdr (assoc ref org-export-code-refs))) - (desc (and descp desc)) - (org-e-odt-suppress-xref nil) - (href (org-xml-format-href (concat "#coderef-" ref)))) - (cond - ((and (numberp lineno-or-ref) (not desc)) - (org-e-odt-format-link lineno-or-ref href)) - ((and (numberp lineno-or-ref) desc - (string-match (regexp-quote (concat "(" ref ")")) desc)) - (format (replace-match "%s" t t desc) - (org-e-odt-format-link lineno-or-ref href))) - (t - (setq desc (format - (if (and desc (string-match - (regexp-quote (concat "(" ref ")")) - desc)) - (replace-match "%s" t t desc) - (or desc "%s")) - lineno-or-ref)) - (org-e-odt-format-link (org-xml-format-desc desc) href))))) - (t - (when (string= type "file") - (setq thefile - (cond - ((file-name-absolute-p path) - (concat "file://" (expand-file-name path))) - (t (org-e-odt-relocate-relative-path - thefile org-current-export-file))))) - - (when (and (member type '("" "http" "https" "file")) fragment) - (setq thefile (concat thefile "#" fragment))) - - (setq thefile (org-xml-format-href thefile)) - - (when (not (member type '("" "file"))) - (setq thefile (concat type ":" thefile))) - - (let ((org-e-odt-suppress-xref nil)) - (org-e-odt-format-link - (org-xml-format-desc desc) thefile attr))))))) - (defun org-e-odt-format-anchor (text name &optional class) (org-e-odt-format-target text name)) @@ -764,8 +692,6 @@ ATTR is a string of other attributes of the a element." "Returns the internal name of the file" (let* ((image-type (file-name-extension path)) (media-type (format "image/%s" image-type)) - (src-file (expand-file-name - path (file-name-directory org-current-export-file))) (target-dir "Images/") (target-file (format "%s%04d.%s" target-dir @@ -774,10 +700,10 @@ ATTR is a string of other attributes of the a element." (substring-no-properties path) target-file) (when (= 1 org-e-odt-embedded-images-count) - (make-directory target-dir) + (make-directory (concat org-e-odt-zip-dir target-dir)) (org-e-odt-create-manifest-file-entry "" target-dir)) - (copy-file src-file target-file 'overwrite) + (copy-file path (concat org-e-odt-zip-dir target-file) 'overwrite) (org-e-odt-create-manifest-file-entry media-type target-file) target-file)) @@ -810,9 +736,6 @@ ATTR is a string of other attributes of the a element." (defun org-e-odt-image-size-from-file (file &optional user-width user-height scale dpi embed-as) - (unless (file-name-absolute-p file) - (setq file (expand-file-name - file (file-name-directory org-current-export-file)))) (let* (size width height) (unless (and user-height user-width) (loop for probe-method in org-e-odt-image-size-probe-method @@ -967,7 +890,7 @@ ATTR is a string of other attributes of the a element." (find-file-noselect content-file t)) (current-buffer)))) -(defun org-e-odt-save-as-outfile (target opt-plist) +(defun org-e-odt-save-as-outfile () ;; write automatic styles (org-e-odt-write-automatic-styles) @@ -983,67 +906,14 @@ ATTR is a string of other attributes of the a element." (org-e-odt-create-manifest-file-entry "text/xml" "content.xml") ;; write out the manifest entries before zipping - (org-e-odt-write-manifest-file) - - (let ((xml-files '("mimetype" "META-INF/manifest.xml" "content.xml" - "meta.xml")) - (zipdir default-directory)) - (when (or t (equal org-lparse-backend 'odt)) ; FIXME - (push "styles.xml" xml-files)) - (message "Switching to directory %s" (expand-file-name zipdir)) - - ;; save all xml files - (mapc (lambda (file) - (with-current-buffer - (find-file-noselect (expand-file-name file) t) - ;; prettify output if needed - (when org-e-odt-prettify-xml - (indent-region (point-min) (point-max))) - (save-buffer 0))) - xml-files) - - (let* ((target-name (file-name-nondirectory target)) - (target-dir (file-name-directory target)) - (cmds `(("zip" "-mX0" ,target-name "mimetype") - ("zip" "-rmTq" ,target-name ".")))) - (when (file-exists-p target) - ;; FIXME: If the file is locked this throws a cryptic error - (delete-file target)) - - (let ((coding-system-for-write 'no-conversion) exitcode err-string) - (message "Creating odt file...") - (mapc - (lambda (cmd) - (message "Running %s" (mapconcat 'identity cmd " ")) - (setq err-string - (with-output-to-string - (setq exitcode - (apply 'call-process (car cmd) - nil standard-output nil (cdr cmd))))) - (or (zerop exitcode) - (ignore (message "%s" err-string)) - (error "Unable to create odt file (%S)" exitcode))) - cmds)) - - ;; move the file from outdir to target-dir - (rename-file target-name target-dir) - - ;; kill all xml buffers - (mapc (lambda (file) - (kill-buffer - (find-file-noselect (expand-file-name file zipdir) t))) - xml-files) - - (delete-directory zipdir))) - (message "Created %s" target) - (set-buffer (find-file-noselect target t))) + (org-e-odt-write-manifest-file)) (defun org-e-odt-create-manifest-file-entry (&rest args) (push args org-e-odt-manifest-file-entries)) (defun org-e-odt-write-manifest-file () - (make-directory "META-INF") - (let ((manifest-file (expand-file-name "META-INF/manifest.xml"))) + (make-directory (concat org-e-odt-zip-dir "META-INF")) + (let ((manifest-file (concat org-e-odt-zip-dir "META-INF/manifest.xml"))) (with-current-buffer (let ((nxml-auto-insert-xml-declaration-flag nil)) (find-file-noselect manifest-file t)) @@ -1093,7 +963,7 @@ ATTR is a string of other attributes of the a element." (format "<dc:title>%s</dc:title>\n" title) "\n" " </office:meta>\n" "</office:document-meta>") - nil (expand-file-name "meta.xml"))) + nil (concat org-e-odt-zip-dir "meta.xml"))) ;; create a manifest entry for meta.xml (org-e-odt-create-manifest-file-entry "text/xml" "meta.xml")) @@ -1106,7 +976,7 @@ ATTR is a string of other attributes of the a element." ;; FIXME: Who is opening an empty styles.xml before this point? (with-current-buffer - (find-file-noselect (expand-file-name "styles.xml") t) + (find-file-noselect (concat org-e-odt-zip-dir "styles.xml") t) (revert-buffer t t))) ;; Write custom styles for source blocks @@ -1123,7 +993,7 @@ ATTR is a string of other attributes of the a element." (odt "application/vnd.oasis.opendocument.text") (odf "application/vnd.oasis.opendocument.formula") (t (error "Unknown OpenDocument backend %S" org-lparse-backend))))) - (write-region mimetype nil (expand-file-name "mimetype")) + (write-region mimetype nil (concat org-e-odt-zip-dir "mimetype")) mimetype)) (defun org-e-odt-do-preprocess-latex-fragments () @@ -1216,9 +1086,10 @@ ATTR is a string of other attributes of the a element." (let ((styles-file-type (file-name-extension styles-file))) (cond ((string= styles-file-type "xml") - (copy-file styles-file (expand-file-name "styles.xml") t)) + (copy-file styles-file (concat org-e-odt-zip-dir "styles.xml") t)) ((member styles-file-type '("odt" "ott")) - (org-e-odt-zip-extract styles-file "styles.xml"))))) + (org-e-odt-zip-extract styles-file + (concat org-e-odt-zip-dir "styles.xml")))))) (t (error (format "Invalid specification of styles.xml file: %S" org-e-odt-styles-file)))) @@ -1287,8 +1158,7 @@ non-nil." (or (org-export-push-to-kill-ring (upcase (symbol-name org-lparse-backend))) (message "Exporting... done"))) - (org-e-odt-save-as-outfile filename nil ; FIXME - ))) + (org-e-odt-save-as-outfile filename))) ;;;###autoload (defun org-export-as-odf-and-open () @@ -1646,26 +1516,6 @@ captions on export.") (defvar org-lparse-latex-fragment-fallback) ; set by org-do-lparse -;;;; HTML Internal Variables - -(defvar html-table-tag nil) ; dynamically scoped into this. - -;; FIXME: it already exists in org-e-odt.el -(defconst org-e-odt-cvt-link-fn - nil - "Function to convert link URLs to exportable URLs. -Takes two arguments, TYPE and PATH. -Returns exportable url as (TYPE PATH), or nil to signal that it -didn't handle this case. -Intended to be locally bound around a call to `org-export-as-html'." ) - - -(defvar org-e-odt-headline-formatter - (lambda (level snumber todo todo-type priority - title tags target extra-targets extra-class) - (concat snumber " " title))) - - ;;; User Configuration Variables @@ -2627,7 +2477,7 @@ original parsed data. INFO is a plist holding export options." ;; Update styles.xml - take care of outline numbering (with-current-buffer - (find-file-noselect (expand-file-name "styles.xml") t) + (find-file-noselect (concat org-e-odt-zip-dir "styles.xml") t) ;; Don't make automatic backup of styles.xml file. This setting ;; prevents the backed-up styles.xml file from being zipped in to ;; odt file. This is more of a hackish fix. Better alternative @@ -3147,9 +2997,12 @@ used as a communication channel." (string-match "file:\\([^]]*\\)" formula-link) (match-string 1 formula-link)))) (t (error "what is this?")))) + (src-expanded (if (file-name-absolute-p src) src + (expand-file-name src (file-name-directory + (plist-get info :input-file))))) (href (org-e-odt-format-tags "<draw:image xlink:href=\"%s\" xlink:type=\"simple\" xlink:show=\"embed\" xlink:actuate=\"onLoad\"/>" "" - (org-e-odt-copy-image-file src))) + (org-e-odt-copy-image-file src-expanded))) ;; extract attributes from #+ATTR_ODT line. (attr-from (case (org-element-type element) (link (org-export-get-parent-element element)) @@ -3170,7 +3023,7 @@ used as a communication channel." ;; extrac ;; handle `:width', `:height' and `:scale' properties. (size (org-e-odt-image-size-from-file - src (plist-get attr-plist :width) + src-expanded (plist-get attr-plist :width) (plist-get attr-plist :height) (plist-get attr-plist :scale) nil ;; embed-as "paragraph" ; FIXME @@ -3970,6 +3823,107 @@ contextual information." ;;; Interactive functions +(defvar org-e-odt-zip-dir nil + "Temporary work directory for OpenDocument exporter.") + +(defmacro org-e-odt--export-wrap (out-file &rest body) + `(let* ((out-file-type (file-name-extension ,out-file)) + (org-e-odt-xml-files '("META-INF/manifest.xml" "content.xml" + "meta.xml" "styles.xml")) + ;; Initialize workarea. All files that end up in the + ;; exported get created here. + (org-e-odt-zip-dir (file-name-as-directory + (make-temp-file (format org-e-odt-tmpdir-prefix + out-file-type) t))) + (--cleanup-xml-buffers + (function + (lambda nil + ;; Kill all XML buffers. + (mapc (lambda (file) + (let ((buf (get-file-buffer + (concat org-e-odt-zip-dir file)))) + (when buf + (set-buffer-modified-p nil) + (kill-buffer buf)))) + org-e-odt-xml-files) + ;; Delete temporary directory and also other embedded + ;; files that get copied there. + (delete-directory org-e-odt-zip-dir t))))) + (org-condition-case-unless-debug + err + (progn + (unless (executable-find "zip") + ;; Not at all OSes ship with zip by default + (error "Executable \"zip\" needed for creating OpenDocument files")) + ;; Do export. This creates a bunch of xml files ready to be + ;; saved and zipped. + (progn ,@body) + ;; Save all XML files. + (mapc (lambda (file) + (let ((buf (get-file-buffer (concat org-e-odt-zip-dir file)))) + (when buf + (with-current-buffer buf + ;; Prettify output if needed. + (when org-e-odt-prettify-xml + (indent-region (point-min) (point-max))) + (save-buffer 0))))) + org-e-odt-xml-files) + ;; Run zip. + (let* ((target ,out-file) + (target-name (file-name-nondirectory target)) + (target-dir (file-name-directory target)) + (cmds `(("zip" "-mX0" ,target-name "mimetype") + ("zip" "-rmTq" ,target-name ".")))) + ;; If a file with same name as the desired output file + ;; exists, remove it. + (when (file-exists-p target) + (delete-file target)) + ;; Zip up the xml files. + (let ((coding-system-for-write 'no-conversion) exitcode err-string) + (message "Creating ODT file...") + ;; Switch temporarily to content.xml. This way Zip + ;; process will inherit `org-e-odt-zip-dir' as the current + ;; directory. + (with-current-buffer + (find-file-noselect (concat org-e-odt-zip-dir "content.xml") t) + (mapc + (lambda (cmd) + (message "Running %s" (mapconcat 'identity cmd " ")) + (setq err-string + (with-output-to-string + (setq exitcode + (apply 'call-process (car cmd) + nil standard-output nil (cdr cmd))))) + (or (zerop exitcode) + (error (concat "Unable to create OpenDocument file." + (format " Zip failed with error (%s)" + err-string))))) + cmds) + ;; Zip file is now in the rightful place. + (rename-file target-name target))) + (message "Created %s" target) + ;; Cleanup work directory and work files. + (funcall --cleanup-xml-buffers) + ;; Open the OpenDocument file in archive-mode for + ;; examination. + (find-file-noselect target t) + ;; Return exported file. + (cond + ;; Case 1: Conversion desired on exported file. Run the + ;; converter on the OpenDocument file. Return the + ;; converted file. + (org-e-odt-preferred-output-format + (or (org-e-odt-convert target org-e-odt-preferred-output-format) + target)) + ;; Case 2: No further conversion. Return exported + ;; OpenDocument file. + (t target)))) + ((quit error) + ;; Cleanup work directory and work files. + (funcall --cleanup-xml-buffers) + (message "OpenDocument export failed: %s" + (error-message-string err)))))) + ;;;###autoload (defun org-e-odt-export-to-odt (&optional subtreep visible-only body-only ext-plist pub-dir) @@ -3999,29 +3953,32 @@ directory. Return output file's name." (interactive) - (setq debug-on-error t) ; FIXME - - (let* ((outbuf (org-e-odt-init-outfile)) - (target (org-export-output-file-name ".odt" subtreep pub-dir)) - (outdir (file-name-directory (buffer-file-name outbuf))) - (default-directory outdir)) - - ;; FIXME: for copying embedded images - (setq org-current-export-file - (file-name-directory - (org-export-output-file-name ".odt" subtreep nil))) - - (org-export-to-buffer 'e-odt outbuf subtreep visible-only body-only) - - (setq org-lparse-opt-plist nil) ; FIXME - (org-e-odt-save-as-outfile target ;; info - nil - ) - - ;; return outfile - (if (not org-e-odt-preferred-output-format) target - (or (org-e-odt-convert target org-e-odt-preferred-output-format) - target)))) + (org-e-odt--export-wrap + (org-export-output-file-name ".odt" subtreep pub-dir) + (let* ((org-e-odt-manifest-file-entries nil) + (org-e-odt-embedded-images-count 0) + (org-e-odt-embedded-formulas-count 0) + (org-e-odt-section-count 0) + (org-e-odt-automatic-styles nil) + (org-e-odt-object-counters nil) + ;; Let `htmlfontify' know that we are interested in collecting + ;; styles. + (hfy-user-sheet-assoc nil)) + ;; Initialize content.xml and kick-off the export process. + (let ((out-buf (progn + (require 'nxml-mode) + (let ((nxml-auto-insert-xml-declaration-flag nil)) + (find-file-noselect + (concat org-e-odt-zip-dir "content.xml") t))))) + (org-export-to-buffer 'e-odt out-buf subtreep visible-only body-only)) + + ;; Prepare other XML files. + ;; - mimetype + ;; - content.xml + ;; - styles.xml + ;; - manifest.xml + ;; - meta.mxl + (org-e-odt-save-as-outfile)))) |