]*\\)>\n*" rtn) (setq rtn (concat (if caption (concat "" (format "" caption)) "") (replace-match (format "" ""))))) (if textareap (setq rtn (concat (format "\n" lang) t t rtn) (if caption "\n\n
\n")) (with-temp-buffer (insert rtn) (goto-char (point-min)) (while (re-search-forward "[<>&]" nil t) (replace-match (cdr (assq (char-before) '((?&."&")(?<."<")(?>.">")))) t t)) (setq rtn (buffer-string))) (setq rtn (concat "\n" rtn "\n")))) (unless textareap (setq rtn (org-export-number-lines rtn 1 1 num cont rpllbl fmt))) (if (string-match "\\(\\`<[^>]*>\\)\n" rtn) (setq rtn (replace-match "\\1" t nil rtn))) rtn) ((eq org-export-current-backend 'latex) (setq rtn (org-export-number-lines rtn 0 0 num cont rpllbl fmt)) (cond ((and lang org-export-latex-listings) (flet ((make-option-string (pair) (concat (first pair) (if (> (length (second pair)) 0) (concat "=" (second pair)))))) (let* ((lang-sym (intern lang)) (minted-p (eq org-export-latex-listings 'minted)) (listings-p (not minted-p)) (backend-lang (or (cadr (assq lang-sym (cond (minted-p org-export-latex-minted-langs) (listings-p org-export-latex-listings-langs)))) lang)) (custom-environment (cadr (assq lang-sym org-export-latex-custom-lang-environments)))) (concat (when (and listings-p (not custom-environment)) (format "\\lstset{%s}\n" (mapconcat #'make-option-string (append org-export-latex-listings-options `(("language" ,backend-lang))) ","))) (when (and caption org-export-latex-listings-w-names) (format "\n%s $\\equiv$ \n" (replace-regexp-in-string "_" "\\\\_" caption))) (cond (custom-environment (format "\\begin{%s}\n%s\\end{%s}\n" custom-environment rtn custom-environment)) (listings-p (format "\\begin{%s}\n%s\\end{%s}\n" "lstlisting" rtn "lstlisting")) (minted-p (format "\\begin{minted}[%s]{%s}\n%s\\end{minted}\n" (mapconcat #'make-option-string org-export-latex-minted-options ",") backend-lang rtn))))))) (t (concat (car org-export-latex-verbatim-wrap) rtn (cdr org-export-latex-verbatim-wrap))))) ((eq org-export-current-backend 'ascii) ;; This is not HTML or LaTeX, so just make it an example. (setq rtn (org-export-number-lines rtn 0 0 num cont rpllbl fmt)) (concat caption "\n" (concat (mapconcat (lambda (l) (concat " " l)) (org-split-string rtn "\n") "\n") "\n") )) (t (error "Don't know how to markup source or example block in %s" (upcase backend-name))))) (setq rtn (concat "\n#+BEGIN_" backend-name "\n" (org-add-props rtn '(org-protected t org-example t org-native-text t)) "\n#+END_" backend-name "\n\n")) (org-add-props rtn nil 'original-indentation indent)))) (defun org-export-number-lines (text &optional skip1 skip2 number cont replace-labels label-format) (setq skip1 (or skip1 0) skip2 (or skip2 0)) (if (not cont) (setq org-export-last-code-line-counter-value 0)) (with-temp-buffer (insert text) (goto-char (point-max)) (skip-chars-backward " \t\n\r") (delete-region (point) (point-max)) (beginning-of-line (- 1 skip2)) (let* ((last (org-current-line)) (n org-export-last-code-line-counter-value) (nmax (+ n (- last skip1))) (fmt (format "%%%dd: " (length (number-to-string nmax)))) (fm (cond ((eq org-export-current-backend 'html) (format "%s" fmt)) ((eq org-export-current-backend 'ascii) fmt) ((eq org-export-current-backend 'latex) fmt) ((eq org-export-current-backend 'docbook) fmt) (t ""))) (label-format (or label-format org-coderef-label-format)) (label-pre (if (string-match "%s" label-format) (substring label-format 0 (match-beginning 0)) label-format)) (label-post (if (string-match "%s" label-format) (substring label-format (match-end 0)) "")) (lbl-re (concat ".*?\\S-.*?\\([ \t]*\\(" (regexp-quote label-pre) "\\([-a-zA-Z0-9_ ]+\\)" (regexp-quote label-post) "\\)\\)")) ref) (org-goto-line (1+ skip1)) (while (and (re-search-forward "^" nil t) (not (eobp)) (< n nmax)) (if number (insert (format fm (incf n))) (forward-char 1)) (when (looking-at lbl-re) (setq ref (match-string 3)) (cond ((numberp replace-labels) ;; remove labels; use numbers for references when lines ;; are numbered, use labels otherwise (delete-region (match-beginning 1) (match-end 1)) (push (cons ref (if (> n 0) n ref)) org-export-code-refs)) ((eq replace-labels 'keep) ;; don't remove labels; use numbers for references when ;; lines are numbered, use labels otherwise (goto-char (match-beginning 2)) (delete-region (match-beginning 2) (match-end 2)) (insert "(" ref ")") (push (cons ref (if (> n 0) n (concat "(" ref ")"))) org-export-code-refs)) (t ;; don't remove labels and don't use numbers for ;; references (goto-char (match-beginning 2)) (delete-region (match-beginning 2) (match-end 2)) (insert "(" ref ")") (push (cons ref (concat "(" ref ")")) org-export-code-refs))) (when (eq org-export-current-backend 'html) (save-excursion (beginning-of-line 1) (insert (format "" ref)) (end-of-line 1) (insert ""))))) (setq org-export-last-code-line-counter-value n) (goto-char (point-max)) (newline) (buffer-string)))) (defun org-search-todo-below (line lines level) "Search the subtree below LINE for any TODO entries." (let ((rest (cdr (memq line lines))) (re org-todo-line-regexp) line lv todo) (catch 'exit (while (setq line (pop rest)) (if (string-match re line) (progn (setq lv (- (match-end 1) (match-beginning 1)) todo (and (match-beginning 2) (not (member (match-string 2 line) org-done-keywords)))) ; TODO, not DONE (if (<= lv level) (throw 'exit nil)) (if todo (throw 'exit t)))))))) ;;;###autoload (defun org-export-visible (type arg) "Create a copy of the visible part of the current buffer, and export it. The copy is created in a temporary buffer and removed after use. TYPE is the final key (as a string) that also selects the export command in the \\\\[org-export] export dispatcher. As a special case, if the you type SPC at the prompt, the temporary org-mode file will not be removed but presented to you so that you can continue to use it. The prefix arg ARG is passed through to the exporting command." (interactive (list (progn (message "Export visible: [a]SCII [h]tml [b]rowse HTML [H/R]buffer with HTML [D]ocBook [l]atex [p]df [d]view pdf [L]atex buffer [x]OXO [ ]keep buffer") (read-char-exclusive)) current-prefix-arg)) (if (not (member type '(?a ?n ?u ?\C-a ?b ?\C-b ?h ?D ?x ?\ ?l ?p ?d ?L ?H ?R))) (error "Invalid export key")) (let* ((binding (cdr (assoc type '( (?a . org-export-as-ascii) (?A . org-export-as-ascii-to-buffer) (?n . org-export-as-latin1) (?N . org-export-as-latin1-to-buffer) (?u . org-export-as-utf8) (?U . org-export-as-utf8-to-buffer) (?\C-a . org-export-as-ascii) (?b . org-export-as-html-and-open) (?\C-b . org-export-as-html-and-open) (?h . org-export-as-html) (?H . org-export-as-html-to-buffer) (?R . org-export-region-as-html) (?D . org-export-as-docbook) (?l . org-export-as-latex) (?p . org-export-as-pdf) (?d . org-export-as-pdf-and-open) (?L . org-export-as-latex-to-buffer) (?x . org-export-as-xoxo))))) (keepp (equal type ?\ )) (file buffer-file-name) (buffer (get-buffer-create "*Org Export Visible*")) s e) ;; Need to hack the drawers here. (save-excursion (goto-char (point-min)) (while (re-search-forward org-drawer-regexp nil t) (goto-char (match-beginning 1)) (or (outline-invisible-p) (org-flag-drawer nil)))) (with-current-buffer buffer (erase-buffer)) (save-excursion (setq s (goto-char (point-min))) (while (not (= (point) (point-max))) (goto-char (org-find-invisible)) (append-to-buffer buffer s (point)) (setq s (goto-char (org-find-visible)))) (org-cycle-hide-drawers 'all) (goto-char (point-min)) (unless keepp ;; Copy all comment lines to the end, to make sure #+ settings are ;; still available for the second export step. Kind of a hack, but ;; does do the trick. (if (looking-at "#[^\r\n]*") (append-to-buffer buffer (match-beginning 0) (1+ (match-end 0)))) (when (re-search-forward "^\\*+[ \t]+" nil t) (while (re-search-backward "[\n\r]#[^\n\r]*" nil t) (append-to-buffer buffer (1+ (match-beginning 0)) (min (point-max) (1+ (match-end 0))))))) (set-buffer buffer) (let ((buffer-file-name file) (org-inhibit-startup t)) (org-mode) (show-all) (unless keepp (funcall binding arg)))) (if (not keepp) (kill-buffer buffer) (switch-to-buffer-other-window buffer) (goto-char (point-min))))) (defun org-find-visible () (let ((s (point))) (while (and (not (= (point-max) (setq s (next-overlay-change s)))) (get-char-property s 'invisible))) s)) (defun org-find-invisible () (let ((s (point))) (while (and (not (= (point-max) (setq s (next-overlay-change s)))) (not (get-char-property s 'invisible)))) s)) (defvar org-export-htmlized-org-css-url) ;; defined in org-html.el (defun org-export-string (string fmt &optional dir) "Export STRING to FMT using existing export facilities. During export STRING is saved to a temporary file whose location could vary. Optional argument DIR can be used to force the directory in which the temporary file is created during export which can be useful for resolving relative paths. Dir defaults to the value of `temporary-file-directory'." (let ((temporary-file-directory (or dir temporary-file-directory)) (tmp-file (make-temp-file "org-"))) (unwind-protect (with-temp-buffer (insert string) (write-file tmp-file) (org-load-modules-maybe) (unless org-local-vars (setq org-local-vars (org-get-local-variables))) (eval ;; convert to fmt -- mimicing `org-run-like-in-org-mode' (list 'let org-local-vars (list (intern (format "org-export-as-%s" fmt)) nil nil nil ''string t)))) (delete-file tmp-file)))) ;;;###autoload (defun org-export-as-org (arg &optional hidden ext-plist to-buffer body-only pub-dir) "Make a copy with not-exporting stuff removed. The purpose of this function is to provide a way to export the source Org file of a webpage in Org format, but with sensitive and/or irrelevant stuff removed. This command will remove the following: - archived trees (if the variable `org-export-with-archived-trees' is nil) - comment blocks and trees starting with the COMMENT keyword - only trees that are consistent with `org-export-select-tags' and `org-export-exclude-tags'. The only arguments that will be used are EXT-PLIST and PUB-DIR, all the others will be ignored (but are present so that the general mechanism to call publishing functions will work). EXT-PLIST is a property list with external parameters overriding org-mode's default settings, but still inferior to file-local settings. When PUB-DIR is set, use this as the publishing directory." (interactive "P") (let* ((opt-plist (org-combine-plists (org-default-export-plist) ext-plist (org-infile-export-plist))) (bfname (buffer-file-name (or (buffer-base-buffer) (current-buffer)))) (filename (concat (file-name-as-directory (or pub-dir (org-export-directory :org opt-plist))) (file-name-sans-extension (file-name-nondirectory bfname)) ".org")) (filename (and filename (if (equal (file-truename filename) (file-truename bfname)) (concat (file-name-sans-extension filename) "-source." (file-name-extension filename)) filename))) (backup-inhibited t) (buffer (find-file-noselect filename)) (region (buffer-string)) str-ret) (save-excursion (switch-to-buffer buffer) (erase-buffer) (insert region) (let ((org-inhibit-startup t)) (org-mode)) (org-install-letbind) ;; Get rid of archived trees (org-export-remove-archived-trees (plist-get opt-plist :archived-trees)) ;; Remove comment environment and comment subtrees (org-export-remove-comment-blocks-and-subtrees) ;; Get rid of excluded trees (org-export-handle-export-tags (plist-get opt-plist :select-tags) (plist-get opt-plist :exclude-tags)) (when (or (plist-get opt-plist :plain-source) (not (or (plist-get opt-plist :plain-source) (plist-get opt-plist :htmlized-source)))) ;; Either nothing special is requested (default call) ;; or the plain source is explicitly requested ;; so: save it (save-buffer)) (when (plist-get opt-plist :htmlized-source) ;; Make the htmlized version (require 'htmlize) (require 'org-html) (font-lock-fontify-buffer) (let* ((htmlize-output-type 'css) (newbuf (htmlize-buffer))) (with-current-buffer newbuf (when org-export-htmlized-org-css-url (goto-char (point-min)) (and (re-search-forward ".*" nil t) (replace-match (format "" org-export-htmlized-org-css-url) t t))) (write-file (concat filename ".html"))) (kill-buffer newbuf))) (set-buffer-modified-p nil) (if (equal to-buffer 'string) (progn (setq str-ret (buffer-string)) (kill-buffer (current-buffer)) str-ret) (kill-buffer (current-buffer)))))) (defvar org-archive-location) ;; gets loaded with the org-archive require. (defun org-get-current-options () "Return a string with current options as keyword options. Does include HTML export options as well as TODO and CATEGORY stuff." (require 'org-archive) (format "#+TITLE: %s #+AUTHOR: %s #+EMAIL: %s #+DATE: %s #+DESCRIPTION: #+KEYWORDS: #+LANGUAGE: %s #+OPTIONS: H:%d num:%s toc:%s \\n:%s @:%s ::%s |:%s ^:%s -:%s f:%s *:%s <:%s #+OPTIONS: TeX:%s LaTeX:%s skip:%s d:%s todo:%s pri:%s tags:%s %s #+EXPORT_SELECT_TAGS: %s #+EXPORT_EXCLUDE_TAGS: %s #+LINK_UP: %s #+LINK_HOME: %s #+XSLT: #+CATEGORY: %s #+SEQ_TODO: %s #+TYP_TODO: %s #+PRIORITIES: %c %c %c #+DRAWERS: %s #+STARTUP: %s %s %s %s %s #+TAGS: %s #+FILETAGS: %s #+ARCHIVE: %s #+LINK: %s " (buffer-name) (user-full-name) user-mail-address (format-time-string (substring (car org-time-stamp-formats) 1 -1)) org-export-default-language org-export-headline-levels org-export-with-section-numbers org-export-with-toc org-export-preserve-breaks org-export-html-expand org-export-with-fixed-width org-export-with-tables org-export-with-sub-superscripts org-export-with-special-strings org-export-with-footnotes org-export-with-emphasize org-export-with-timestamps org-export-with-TeX-macros org-export-with-LaTeX-fragments org-export-skip-text-before-1st-heading org-export-with-drawers org-export-with-todo-keywords org-export-with-priority org-export-with-tags (if (featurep 'org-jsinfo) (org-infojs-options-inbuffer-template) "") (mapconcat 'identity org-export-select-tags " ") (mapconcat 'identity org-export-exclude-tags " ") org-export-html-link-up org-export-html-link-home (or (ignore-errors (file-name-sans-extension (file-name-nondirectory (buffer-file-name (buffer-base-buffer))))) "NOFILENAME") "TODO FEEDBACK VERIFY DONE" "Me Jason Marie DONE" org-highest-priority org-lowest-priority org-default-priority (mapconcat 'identity org-drawers " ") (cdr (assoc org-startup-folded '((nil . "showall") (t . "overview") (content . "content")))) (if org-odd-levels-only "odd" "oddeven") (if org-hide-leading-stars "hidestars" "showstars") (if org-startup-align-all-tables "align" "noalign") (cond ((eq org-log-done t) "logdone") ((equal org-log-done 'note) "lognotedone") ((not org-log-done) "nologdone")) (or (mapconcat (lambda (x) (cond ((equal :startgroup (car x)) "{") ((equal :endgroup (car x)) "}") ((equal :newline (car x)) "") ((cdr x) (format "%s(%c)" (car x) (cdr x))) (t (car x)))) (or org-tag-alist (org-get-buffer-tags)) " ") "") (mapconcat 'identity org-file-tags " ") org-archive-location "org file:~/org/%s.org" )) ;;;###autoload (defun org-insert-export-options-template () "Insert into the buffer a template with information for exporting." (interactive) (if (not (bolp)) (newline)) (let ((s (org-get-current-options))) (and (string-match "#\\+CATEGORY" s) (setq s (substring s 0 (match-beginning 0)))) (insert s))) (defvar org-table-colgroup-info nil) (defun org-table-clean-before-export (lines &optional maybe-quoted) "Check if the table has a marking column. If yes remove the column and the special lines." (setq org-table-colgroup-info nil) (if (memq nil (mapcar (lambda (x) (or (string-match "^[ \t]*|-" x) (string-match (if maybe-quoted "^[ \t]*| *\\\\?\\([\#!$*_^ /]\\) *|" "^[ \t]*| *\\([\#!$*_^ /]\\) *|") x))) lines)) ;; No special marking column (progn (setq org-table-clean-did-remove-column nil) (delq nil (mapcar (lambda (x) (cond ((org-table-colgroup-line-p x) ;; This line contains colgroup info, extract it ;; and then discard the line (setq org-table-colgroup-info (mapcar (lambda (x) (cond ((member x '("<" "<")) :start) ((member x '(">" ">")) :end) ((member x '("<>" "<>")) :startend) (t nil))) (org-split-string x "[ \t]*|[ \t]*"))) nil) ((org-table-cookie-line-p x) ;; This line contains formatting cookies, discard it nil) (t x))) lines))) ;; there is a special marking column (setq org-table-clean-did-remove-column t) (delq nil (mapcar (lambda (x) (cond ((org-table-colgroup-line-p x) ;; This line contains colgroup info, extract it ;; and then discard the line (setq org-table-colgroup-info (mapcar (lambda (x) (cond ((member x '("<" "<")) :start) ((member x '(">" ">")) :end) ((member x '("<>" "<>")) :startend) (t nil))) (cdr (org-split-string x "[ \t]*|[ \t]*")))) nil) ((org-table-cookie-line-p x) ;; This line contains formatting cookies, discard it nil) ((string-match "^[ \t]*| *[!_^/] *|" x) ;; ignore this line nil) ((or (string-match "^\\([ \t]*\\)|-+\\+" x) (string-match "^\\([ \t]*\\)|[^|]*|" x)) ;; remove the first column (replace-match "\\1|" t nil x)))) lines)))) (defun org-export-cleanup-toc-line (s) "Remove tags and timestamps from lines going into the toc." (when (memq org-export-with-tags '(not-in-toc nil)) (if (string-match (org-re " +:[[:alnum:]_@#%:]+: *$") s) (setq s (replace-match "" t t s)))) (when org-export-remove-timestamps-from-toc (while (string-match org-maybe-keyword-time-regexp s) (setq s (replace-match "" t t s)))) (while (string-match org-bracket-link-regexp s) (setq s (replace-match (match-string (if (match-end 3) 3 1) s) t t s))) (while (string-match "\\[\\([0-9]\\|fn:[^]]*\\)\\]" s) (setq s (replace-match "" t t s))) s) (defun org-get-text-property-any (pos prop &optional object) (or (get-text-property pos prop object) (and (setq pos (next-single-property-change pos prop object)) (get-text-property pos prop object)))) (defun org-export-get-coderef-format (path desc) (save-match-data (if (and desc (string-match (regexp-quote (concat "(" path ")")) desc)) (replace-match "%s" t t desc) (or desc "%s")))) (defun org-export-push-to-kill-ring (format) "Push buffer content to kill ring. The depends on the variable `org-export-copy-to-kill'." (when org-export-copy-to-kill-ring (org-kill-new (buffer-string)) (when (fboundp 'x-set-selection) (ignore-errors (x-set-selection 'PRIMARY (buffer-string))) (ignore-errors (x-set-selection 'CLIPBOARD (buffer-string)))) (message "%s export done, pushed to kill ring and clipboard" format))) (provide 'org-exp) ;; arch-tag: 65985fe9-095c-49c7-a7b6-cb4ee15c0a95 ;;; org-exp.el ends here