contrib/lisp/org-lparse.el

   1 ;;; org-lparse.el --- Line-oriented parser-exporter for Org-mode
   2
   3 ;; Copyright (C) 2010, 2011
   4 ;;   Jambunathan <kjambunathan at gmail dot com>
   5
   6 ;; Author: Jambunathan K <kjambunathan at gmail dot com>
   7 ;; Keywords: outlines, hypermedia, calendar, wp
   8 ;; Homepage: http://orgmode.org
   9 ;; Version: 0.8
  10
  11 ;; This file is not (yet) part of GNU Emacs.
  12 ;; However, it is distributed under the same license.
  13
  14 ;; GNU Emacs is free software: you can redistribute it and/or modify
  15 ;; it under the terms of the GNU General Public License as published by
  16 ;; the Free Software Foundation, either version 3 of the License, or
  17 ;; (at your option) any later version.
  18
  19 ;; GNU Emacs is distributed in the hope that it will be useful,
  20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ;; GNU General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  26 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  27 ;;
  28 ;;; Commentary:
  29
  30 ;; `org-lparse' is the entry point for the generic line-oriented
  31 ;; exporter.  `org-do-lparse' is the genericized version of the
  32 ;; original `org-export-as-html' routine.
  33
  34 ;; `org-lparse-native-backends' is a good starting point for
  35 ;; exploring the generic exporter.
  36
  37 ;; Following new interactive commands are provided by this library.
  38 ;; `org-lparse', `org-lparse-and-open', `org-lparse-to-buffer'
  39 ;; `org-replace-region-by', `org-lparse-region'.
  40
  41 ;; Note that the above routines correspond to the following routines
  42 ;; in the html exporter `org-export-as-html',
  43 ;; `org-export-as-html-and-open', `org-export-as-html-to-buffer',
  44 ;; `org-replace-region-by-html' and `org-export-region-as-html'.
  45
  46 ;; The new interactive command `org-lparse-convert' can be used to
  47 ;; convert documents between various formats.  Use this to command,
  48 ;; for example, to convert odt file to doc or pdf format.
  49
  50 ;; See README.org file that comes with this library for answers to
  51 ;; FAQs and more information on using this library.
  52
  53 ;;; Code:
  54
  55 (require 'org-exp)
  56 (require 'org-list)
  57
  58 ;;;###autoload
  59 (defun org-lparse-and-open (target-backend native-backend arg)
  60   "Export the outline to TARGET-BACKEND via NATIVE-BACKEND and open exported file.
  61 If there is an active region, export only the region.  The prefix
  62 ARG specifies how many levels of the outline should become
  63 headlines.  The default is 3.  Lower levels will become bulleted
  64 lists."
  65   ;; (interactive "Mbackend: \nP")
  66   (interactive
  67    (let* ((input (if (featurep 'ido) 'ido-completing-read 'completing-read))
  68           (all-backends (org-lparse-all-backends))
  69           (target-backend
  70            (funcall input "Export to: " all-backends nil t nil))
  71           (native-backend
  72            (or
  73             ;; (and (org-lparse-backend-is-native-p target-backend)
  74             ;;      target-backend)
  75             (funcall input "Use Native backend:  "
  76                      (cdr (assoc target-backend all-backends)) nil t nil))))
  77      (list target-backend native-backend current-prefix-arg)))
  78   (let (f (file-or-buf (org-lparse target-backend native-backend
  79                                    arg 'hidden)))
  80     (when file-or-buf
  81       (setq f (cond
  82                ((bufferp file-or-buf) buffer-file-name)
  83                ((file-exists-p file-or-buf) file-or-buf)
  84                (t (error "org-lparse-and-open: This shouldn't happen"))))
  85       (message "Opening file %s" f)
  86       (org-open-file f)
  87       (when org-export-kill-product-buffer-when-displayed
  88         (kill-buffer (current-buffer))))))
  89
  90 ;;;###autoload
  91 (defun org-lparse-batch (target-backend &optional native-backend)
  92   "Call the function `org-lparse'.
  93 This function can be used in batch processing as:
  94 emacs   --batch
  95         --load=$HOME/lib/emacs/org.el
  96         --eval \"(setq org-export-headline-levels 2)\"
  97         --visit=MyFile --funcall org-lparse-batch"
  98   (setq native-backend (or native-backend target-backend))
  99   (org-lparse target-backend native-backend
 100               org-export-headline-levels 'hidden))
 101
 102 ;;;###autoload
 103 (defun org-lparse-to-buffer (backend arg)
 104   "Call `org-lparse' with output to a temporary buffer.
 105 No file is created.  The prefix ARG is passed through to
 106 `org-lparse'."
 107   (interactive "Mbackend: \nP")
 108   (let ((tempbuf (format "*Org %s Export*" (upcase backend))))
 109       (org-lparse backend backend arg nil nil tempbuf)
 110       (when org-export-show-temporary-export-buffer
 111         (switch-to-buffer-other-window tempbuf))))
 112
 113 ;;;###autoload
 114 (defun org-replace-region-by (backend beg end)
 115   "Assume the current region has org-mode syntax, and convert it to HTML.
 116 This can be used in any buffer.  For example, you could write an
 117 itemized list in org-mode syntax in an HTML buffer and then use this
 118 command to convert it."
 119   (interactive "Mbackend: \nr")
 120   (let (reg backend-string buf pop-up-frames)
 121     (save-window-excursion
 122       (if (org-mode-p)
 123           (setq backend-string (org-lparse-region backend beg end t 'string))
 124         (setq reg (buffer-substring beg end)
 125               buf (get-buffer-create "*Org tmp*"))
 126         (with-current-buffer buf
 127           (erase-buffer)
 128           (insert reg)
 129           (org-mode)
 130           (setq backend-string (org-lparse-region backend (point-min)
 131                                                   (point-max) t 'string)))
 132         (kill-buffer buf)))
 133     (delete-region beg end)
 134     (insert backend-string)))
 135
 136 ;;;###autoload
 137 (defun org-lparse-region (backend beg end &optional body-only buffer)
 138   "Convert region from BEG to END in org-mode buffer to HTML.
 139 If prefix arg BODY-ONLY is set, omit file header, footer, and table of
 140 contents, and only produce the region of converted text, useful for
 141 cut-and-paste operations.
 142 If BUFFER is a buffer or a string, use/create that buffer as a target
 143 of the converted HTML.  If BUFFER is the symbol `string', return the
 144 produced HTML as a string and leave not buffer behind.  For example,
 145 a Lisp program could call this function in the following way:
 146
 147   (setq html (org-lparse-region \"html\" beg end t 'string))
 148
 149 When called interactively, the output buffer is selected, and shown
 150 in a window.  A non-interactive call will only return the buffer."
 151   (interactive "Mbackend: \nr\nP")
 152   (when (org-called-interactively-p 'any)
 153     (setq buffer (format "*Org %s Export*" (upcase backend))))
 154   (let ((transient-mark-mode t) (zmacs-regions t)
 155         ext-plist rtn)
 156     (setq ext-plist (plist-put ext-plist :ignore-subtree-p t))
 157     (goto-char end)
 158     (set-mark (point)) ;; to activate the region
 159     (goto-char beg)
 160     (setq rtn (org-lparse backend backend nil nil ext-plist buffer body-only))
 161     (if (fboundp 'deactivate-mark) (deactivate-mark))
 162     (if (and (org-called-interactively-p 'any) (bufferp rtn))
 163         (switch-to-buffer-other-window rtn)
 164       rtn)))
 165
 166 (defvar org-lparse-par-open nil)
 167
 168 (defun org-lparse-should-inline-p (filename descp)
 169    "Return non-nil if link FILENAME should be inlined.
 170 The decision to inline the FILENAME link is based on the current
 171 settings.  DESCP is the boolean of whether there was a link
 172 description.  See variables `org-export-html-inline-images' and
 173 `org-export-html-inline-image-extensions'."
 174    (let ((inline-images (org-lparse-get 'INLINE-IMAGES))
 175          (inline-image-extensions
 176           (org-lparse-get 'INLINE-IMAGE-EXTENSIONS)))
 177         (and (or (eq t inline-images) (and inline-images (not descp)))
 178              (org-file-image-p filename inline-image-extensions))))
 179
 180 (defun org-lparse-format-org-link (line opt-plist)
 181   "Return LINE with markup of Org mode links.
 182 OPT-PLIST is the export options list."
 183   (let ((start 0)
 184         (current-dir (if buffer-file-name
 185                          (file-name-directory buffer-file-name)
 186                        default-directory))
 187         (link-validate (plist-get opt-plist :link-validation-function))
 188         type id-file fnc
 189         rpl path attr desc descp desc1 desc2 link
 190         org-lparse-link-description-is-image)
 191     (while (string-match org-bracket-link-analytic-regexp++ line start)
 192       (setq org-lparse-link-description-is-image nil)
 193       (setq start (match-beginning 0))
 194       (setq path (save-match-data (org-link-unescape
 195                                    (match-string 3 line))))
 196       (setq type (cond
 197                   ((match-end 2) (match-string 2 line))
 198                   ((save-match-data
 199                      (or (file-name-absolute-p path)
 200                          (string-match "^\\.\\.?/" path)))
 201                    "file")
 202                   (t "internal")))
 203       (setq path (org-extract-attributes (org-link-unescape path)))
 204       (setq attr (get-text-property 0 'org-attributes path))
 205       (setq desc1 (if (match-end 5) (match-string 5 line))
 206             desc2 (if (match-end 2) (concat type ":" path) path)
 207             descp (and desc1 (not (equal desc1 desc2)))
 208             desc (or desc1 desc2))
 209       ;; Make an image out of the description if that is so wanted
 210       (when (and descp (org-file-image-p
 211                         desc (org-lparse-get 'INLINE-IMAGE-EXTENSIONS)))
 212         (setq org-lparse-link-description-is-image t)
 213         (save-match-data
 214           (if (string-match "^file:" desc)
 215               (setq desc (substring desc (match-end 0)))))
 216         (save-match-data
 217           (setq desc (org-add-props
 218                          (org-lparse-format 'INLINE-IMAGE desc)
 219                          '(org-protected t)))))
 220       (cond
 221        ((equal type "internal")
 222         (let
 223             ((frag-0
 224               (if (= (string-to-char path) ?#)
 225                   (substring path 1)
 226                 path)))
 227           (setq rpl
 228                 (org-lparse-format
 229                  'ORG-LINK opt-plist "" "" (org-solidify-link-text
 230                                             (save-match-data
 231                                               (org-link-unescape frag-0))
 232                                             nil) desc attr descp))))
 233        ((and (equal type "id")
 234              (setq id-file (org-id-find-id-file path)))
 235         ;; This is an id: link to another file (if it was the same file,
 236         ;; it would have become an internal link...)
 237         (save-match-data
 238           (setq id-file (file-relative-name
 239                          id-file
 240                          (file-name-directory org-current-export-file)))
 241           (setq rpl
 242                 (org-lparse-format
 243                  'ORG-LINK opt-plist type id-file
 244                  (concat (if (org-uuidgen-p path) "ID-") path)
 245                  desc attr descp))))
 246        ((member type '("http" "https"))
 247         ;; standard URL, can inline as image
 248         (setq rpl
 249               (org-lparse-format
 250                'ORG-LINK opt-plist type path nil desc attr descp)))
 251        ((member type '("ftp" "mailto" "news"))
 252         ;; standard URL, can't inline as image
 253         (setq rpl
 254               (org-lparse-format
 255                'ORG-LINK opt-plist type path nil desc attr descp)))
 256
 257        ((string= type "coderef")
 258         (setq rpl
 259               (org-lparse-format
 260                'ORG-LINK opt-plist type "" (format "coderef-%s" path)
 261                (format
 262                 (org-export-get-coderef-format
 263                  path
 264                  (and descp desc))
 265                 (cdr (assoc path org-export-code-refs))) nil descp)))
 266
 267        ((functionp (setq fnc (nth 2 (assoc type org-link-protocols))))
 268         ;; The link protocol has a function for format the link
 269         (setq rpl
 270               (save-match-data
 271                 (funcall fnc (org-link-unescape path) desc1 'html))))
 272
 273        ((string= type "file")
 274         ;; FILE link
 275         (save-match-data
 276           (let*
 277               ((components
 278                 (if
 279                     (string-match "::\\(.*\\)" path)
 280                     (list
 281                      (replace-match "" t nil path)
 282                      (match-string 1 path))
 283                   (list path nil)))
 284
 285                ;;The proper path, without a fragment
 286                (path-1
 287                 (first components))
 288
 289                ;;The raw fragment
 290                (fragment-0
 291                 (second components))
 292
 293                ;;Check the fragment.  If it can't be used as
 294                ;;target fragment we'll pass nil instead.
 295                (fragment-1
 296                 (if
 297                     (and fragment-0
 298                          (not (string-match "^[0-9]*$" fragment-0))
 299                          (not (string-match "^\\*" fragment-0))
 300                          (not (string-match "^/.*/$" fragment-0)))
 301                     (org-solidify-link-text
 302                      (org-link-unescape fragment-0))
 303                   nil))
 304                (desc-2
 305                 ;;Description minus "file:" and ".org"
 306                 (if (string-match "^file:" desc)
 307                     (let
 308                         ((desc-1 (replace-match "" t t desc)))
 309                       (if (string-match "\\.org$" desc-1)
 310                           (replace-match "" t t desc-1)
 311                         desc-1))
 312                   desc)))
 313
 314             (setq rpl
 315                   (if
 316                       (and
 317                        (functionp link-validate)
 318                        (not (funcall link-validate path-1 current-dir)))
 319                       desc
 320                     (org-lparse-format
 321                      'ORG-LINK opt-plist "file" path-1 fragment-1
 322                      desc-2 attr descp))))))
 323
 324        (t
 325         ;; just publish the path, as default
 326         (setq rpl (concat "<i>&lt;" type ":"
 327                           (save-match-data (org-link-unescape path))
 328                           "&gt;</i>"))))
 329       (setq line (replace-match rpl t t line)
 330             start (+ start (length rpl))))
 331     line))
 332
 333 (defmacro with-org-lparse-preserve-paragraph-state (&rest body)
 334   `(let ((org-lparse-do-open-par org-lparse-par-open))
 335      (org-lparse-end-paragraph)
 336      ,@body
 337      (when org-lparse-do-open-par
 338        (org-lparse-begin-paragraph))))
 339
 340 (defvar org-lparse-native-backends nil
 341   "List of native backends registered with `org-lparse'.
 342 A backend can use `org-lparse-register-backend' to add itself to
 343 this list.
 344
 345 All native backends must implement a get routine and a mandatory
 346 set of callback routines.
 347
 348 The get routine must be named as org-<backend>-get where backend
 349 is the name of the backend.  The exporter uses `org-lparse-get'
 350 and retrieves the backend-specific callback by querying for
 351 ENTITY-CONTROL and ENTITY-FORMAT variables.
 352
 353 For the sake of illustration, the html backend implements
 354 `org-xhtml-get'.  It returns
 355 `org-xhtml-entity-control-callbacks-alist' and
 356 `org-xhtml-entity-format-callbacks-alist' as the values of
 357 ENTITY-CONTROL and ENTITY-FORMAT settings.")
 358
 359 (defun org-lparse-register-backend (backend)
 360   "Make BACKEND known to org-lparse library.
 361 Add BACKEND to `org-lparse-native-backends'."
 362   (when backend
 363     (setq backend (cond
 364                    ((symbolp backend) (symbol-name backend))
 365                    ((stringp backend) backend)
 366                    (t (error "Error while registering backend: %S" backend))))
 367     (add-to-list 'org-lparse-native-backends backend)))
 368
 369 (defun org-lparse-unregister-backend (backend)
 370   (setq org-lparse-native-backends
 371         (remove (cond
 372                  ((symbolp backend) (symbol-name backend))
 373                  ((stringp backend) backend))
 374                 org-lparse-native-backends))
 375   (message "Unregistered backend %S" backend))
 376
 377 (defun org-lparse-get-other-backends (native-backend)
 378   (org-lparse-backend-get native-backend 'OTHER-BACKENDS))
 379
 380 (defun org-lparse-all-backends ()
 381   (let (all-backends)
 382     (flet ((add (other native)
 383                 (let ((val (assoc-string other all-backends t)))
 384                   (if val (setcdr val (nconc (list native) (cdr val)))
 385                     (push (cons other (list native)) all-backends)))))
 386       (loop for backend in org-lparse-native-backends
 387             do (loop for other in (org-lparse-get-other-backends backend)
 388                      do (add other backend))))
 389     all-backends))
 390
 391 (defun org-lparse-backend-is-native-p (backend)
 392   (member backend org-lparse-native-backends))
 393
 394 (defun org-lparse (target-backend native-backend arg
 395                                   &optional hidden ext-plist
 396                                   to-buffer body-only pub-dir)
 397   "Export the outline to various formats.
 398 If there is an active region, export only the region. The outline
 399 is first exported to NATIVE-BACKEND and optionally converted to
 400 TARGET-BACKEND. See `org-lparse-native-backends' for list of
 401 known native backends. Each native backend can specify a
 402 converter and list of target backends it exports to using the
 403 CONVERT-PROCESS and OTHER-BACKENDS settings of it's get
 404 method. See `org-xhtml-get' for an illustrative example.
 405
 406 ARG is a prefix argument that specifies how many levels of
 407 outline should become headlines.  The default is 3.  Lower levels
 408 will become bulleted lists.
 409
 410 HIDDEN is obsolete and does nothing.
 411
 412 EXT-PLIST is a property list that controls various aspects of
 413 export. The settings here override org-mode's default settings
 414 and but are inferior to file-local settings.
 415
 416 TO-BUFFER dumps the exported lines to a buffer or a string
 417 instead of a file. If TO-BUFFER is the symbol `string' return the
 418 exported lines as a string.  If TO-BUFFER is non-nil, create a
 419 buffer with that name and export to that buffer.
 420
 421 BODY-ONLY controls the presence of header and footer lines in
 422 exported text. If BODY-ONLY is non-nil, don't produce the file
 423 header and footer, simply return the content of <body>...</body>,
 424 without even the body tags themselves.
 425
 426 PUB-DIR specifies the publishing directory."
 427   (interactive
 428    (let* ((input (if (featurep 'ido) 'ido-completing-read 'completing-read))
 429           (all-backends (org-lparse-all-backends))
 430           (target-backend
 431            (funcall input "Export to: " all-backends nil t nil))
 432           (native-backend
 433            (or
 434             ;; (and (org-lparse-backend-is-native-p target-backend)
 435             ;;      target-backend)
 436             (funcall input "Use Native backend:  "
 437                      (cdr (assoc target-backend all-backends)) nil t nil))))
 438      (list target-backend native-backend current-prefix-arg)))
 439   (let* ((org-lparse-backend (intern native-backend))
 440          (org-lparse-other-backend (intern target-backend)))
 441     (unless (org-lparse-backend-is-native-p native-backend)
 442       (error "Don't know how to export natively to backend %s" native-backend))
 443     (unless (or (not target-backend)
 444                 (equal target-backend native-backend)
 445                 (member target-backend (org-lparse-get 'OTHER-BACKENDS)))
 446       (error "Don't know how to export to backend %s %s" target-backend
 447              (format "via %s" native-backend)))
 448     (run-hooks 'org-export-first-hook)
 449     (org-do-lparse arg hidden ext-plist to-buffer body-only pub-dir)))
 450
 451 (defcustom org-lparse-convert-process
 452   '("soffice" "-norestore" "-invisible" "-headless" "\"macro:///BasicODConverter.Main.Convert(%I,%f,%O)\"")
 453   "Command to covert a Org exported format to other formats.
 454 The variable is an list of the form (PROCESS ARG1 ARG2 ARG3
 455 ...).  Format specifiers used in the ARGs are replaced as below.
 456 %i input file name in full
 457 %I input file name as a URL
 458 %f format of the output file
 459 %o output file name in full
 460 %O output file name as a URL
 461 %d output dir in full
 462 %D output dir as a URL"
 463   :group 'org-lparse)
 464
 465 (defcustom org-lparse-use-flashy-warning nil
 466   "Use flashy warnings when exporting to ODT."
 467   :type 'boolean
 468   :group 'org-export)
 469
 470 (defun org-lparse-convert (&optional in-file fmt)
 471   "Convert file from one format to another using a converter.
 472 IN-FILE is the file to be converted.  If unspecified, it defaults
 473 to variable `buffer-file-name'.  FMT is the desired output format.  If the
 474 backend has registered a CONVERT-METHOD via it's get function
 475 then that converter is used.  Otherwise
 476 `org-export-conver-process' is used."
 477   (interactive
 478    (let* ((input (if (featurep 'ido) 'ido-completing-read 'completing-read))
 479           (in-file (read-file-name "File to be converted: "
 480                                    nil buffer-file-name t))
 481           (fmt (funcall input "Output format:  "
 482                         (or (ignore-errors
 483                               (org-lparse-get-other-backends
 484                                (file-name-extension in-file)))
 485                             (org-lparse-all-backends))
 486                         nil nil nil)))
 487      (list in-file fmt)))
 488   (require 'browse-url)
 489   (let* ((in-file (expand-file-name (or in-file buffer-file-name)))
 490          (fmt (or fmt "doc") )
 491          (out-file (concat (file-name-sans-extension in-file) "." fmt))
 492          (out-dir (file-name-directory in-file))
 493          (backend (when (boundp 'org-lparse-backend) org-lparse-backend))
 494          (convert-process
 495           (or (ignore-errors (org-lparse-backend-get backend 'CONVERT-METHOD))
 496               org-lparse-convert-process))
 497          program arglist)
 498
 499     (setq program (and convert-process (consp convert-process)
 500                        (car convert-process)))
 501     (unless (executable-find program)
 502       (error "Unable to locate the converter %s"  program))
 503
 504     (setq arglist
 505           (mapcar (lambda (arg)
 506                     (format-spec arg `((?i . ,in-file)
 507                                        (?I . ,(browse-url-file-url in-file))
 508                                        (?f . ,fmt)
 509                                        (?o . ,out-file)
 510                                        (?O . ,(browse-url-file-url out-file))
 511                                        (?d . ,out-dir)
 512                                        (?D . ,(browse-url-file-url out-dir)))))
 513                   (cdr convert-process)))
 514     (ignore-errors (delete-file out-file))
 515
 516     (message "Executing %s %s" program (mapconcat 'identity arglist " "))
 517     (apply 'call-process program nil nil nil arglist)
 518
 519     (cond
 520      ((file-exists-p out-file)
 521       (message "Exported to %s using %s" out-file program)
 522       out-file
 523       ;; (set-buffer (find-file-noselect out-file))
 524       )
 525      (t
 526       (message "Export to %s failed" out-file)
 527       nil))))
 528
 529 (defvar org-lparse-insert-tag-with-newlines 'both)
 530
 531 ;; Following variables are let-bound during `org-lparse'
 532 (defvar org-lparse-dyn-first-heading-pos)
 533 (defvar org-lparse-toc)
 534 (defvar org-lparse-entity-control-callbacks-alist)
 535 (defvar org-lparse-entity-format-callbacks-alist)
 536 (defvar org-lparse-backend nil
 537   "The native backend to which the document is currently exported.
 538 This variable is let bound during `org-lparse'.  Valid values are
 539 one of the symbols corresponding to `org-lparse-native-backends'.
 540
 541 Compare this variable with `org-export-current-backend' which is
 542 bound only during `org-export-preprocess-string' stage of the
 543 export process.
 544
 545 See also `org-lparse-other-backend'.")
 546
 547 (defvar org-lparse-other-backend nil
 548   "The target backend to which the document is currently exported.
 549 This variable is let bound during `org-lparse'.  This variable is
 550 set to either `org-lparse-backend' or one of the symbols
 551 corresponding to OTHER-BACKENDS specification of the
 552 org-lparse-backend.
 553
 554 For example, if a document is exported to \"odt\" then both
 555 org-lparse-backend and org-lparse-other-backend are bound to
 556 'odt.  On the other hand, if a document is exported to \"odt\"
 557 and then converted to \"doc\" then org-lparse-backend is set to
 558 'odt and org-lparse-other-backend is set to 'doc.")
 559
 560 (defvar org-lparse-body-only nil
 561   "Bind this to BODY-ONLY arg of `org-lparse'.")
 562
 563 (defvar org-lparse-to-buffer nil
 564   "Bind this to TO-BUFFER arg of `org-lparse'.")
 565
 566 (defun org-do-lparse (arg &optional hidden ext-plist
 567                           to-buffer body-only pub-dir)
 568   "Export the outline to various formats.
 569 See `org-lparse' for more information. This function is a
 570 html-agnostic version of the `org-export-as-html' function in 7.5
 571 version."
 572   ;; Make sure we have a file name when we need it.
 573   (when (and (not (or to-buffer body-only))
 574              (not buffer-file-name))
 575     (if (buffer-base-buffer)
 576         (org-set-local 'buffer-file-name
 577                        (with-current-buffer (buffer-base-buffer)
 578                          buffer-file-name))
 579       (error "Need a file name to be able to export")))
 580
 581   (org-lparse-warn
 582    (format "Exporting to %s using org-lparse..."
 583            (upcase (symbol-name
 584                     (or org-lparse-backend org-lparse-other-backend)))))
 585
 586   (setq-default org-todo-line-regexp org-todo-line-regexp)
 587   (setq-default org-deadline-line-regexp org-deadline-line-regexp)
 588   (setq-default org-done-keywords org-done-keywords)
 589   (setq-default org-maybe-keyword-time-regexp org-maybe-keyword-time-regexp)
 590   (let* (org-lparse-encode-pending
 591          org-lparse-par-open
 592          org-lparse-outline-text-open
 593          (org-lparse-latex-fragment-fallback ; currently used only by
 594                                         ; odt exporter
 595           (or (ignore-errors (org-lparse-get 'LATEX-FRAGMENT-FALLBACK))
 596               (if (and (org-check-external-command "latex" "" t)
 597                        (org-check-external-command "dvipng" "" t))
 598                   'dvipng
 599                 'verbatim)))
 600          (org-lparse-insert-tag-with-newlines 'both)
 601          (org-lparse-to-buffer to-buffer)
 602          (org-lparse-body-only body-only)
 603          (org-lparse-entity-control-callbacks-alist
 604           (org-lparse-get 'ENTITY-CONTROL))
 605          (org-lparse-entity-format-callbacks-alist
 606           (org-lparse-get 'ENTITY-FORMAT))
 607          (opt-plist
 608           (org-export-process-option-filters
 609            (org-combine-plists (org-default-export-plist)
 610                                ext-plist
 611                                (org-infile-export-plist))))
 612          (body-only (or body-only (plist-get opt-plist :body-only)))
 613          valid org-lparse-dyn-first-heading-pos
 614          (odd org-odd-levels-only)
 615          (region-p (org-region-active-p))
 616          (rbeg (and region-p (region-beginning)))
 617          (rend (and region-p (region-end)))
 618          (subtree-p
 619           (if (plist-get opt-plist :ignore-subtree-p)
 620               nil
 621             (when region-p
 622               (save-excursion
 623                 (goto-char rbeg)
 624                 (and (org-at-heading-p)
 625                      (>= (org-end-of-subtree t t) rend))))))
 626          (level-offset (if subtree-p
 627                            (save-excursion
 628                              (goto-char rbeg)
 629                              (+ (funcall outline-level)
 630                                 (if org-odd-levels-only 1 0)))
 631                          0))
 632          (opt-plist (setq org-export-opt-plist
 633                           (if subtree-p
 634                               (org-export-add-subtree-options opt-plist rbeg)
 635                             opt-plist)))
 636          ;; The following two are dynamically scoped into other
 637          ;; routines below.
 638          (org-current-export-dir
 639           (or pub-dir (org-lparse-get 'EXPORT-DIR opt-plist)))
 640          (org-current-export-file buffer-file-name)
 641          (level 0) (line "") (origline "") txt todo
 642          (umax nil)
 643          (umax-toc nil)
 644          (filename (if to-buffer nil
 645                      (expand-file-name
 646                       (concat
 647                        (file-name-sans-extension
 648                         (or (and subtree-p
 649                                  (org-entry-get (region-beginning)
 650                                                 "EXPORT_FILE_NAME" t))
 651                             (file-name-nondirectory buffer-file-name)))
 652                        "." (org-lparse-get 'FILE-NAME-EXTENSION opt-plist))
 653                       (file-name-as-directory
 654                        (or pub-dir (org-lparse-get 'EXPORT-DIR opt-plist))))))
 655          (current-dir (if buffer-file-name
 656                           (file-name-directory buffer-file-name)
 657                         default-directory))
 658          (buffer (if to-buffer
 659                      (cond
 660                       ((eq to-buffer 'string)
 661                        (get-buffer-create (org-lparse-get 'EXPORT-BUFFER-NAME)))
 662                       (t (get-buffer-create to-buffer)))
 663                    (find-file-noselect
 664                     (or (let ((f (org-lparse-get 'INIT-METHOD)))
 665                           (and f (functionp f) (funcall f filename)))
 666                         filename))))
 667          (org-levels-open (make-vector org-level-max nil))
 668          (date (plist-get opt-plist :date))
 669          (date (cond
 670                 ((and date (string-match "%" date))
 671                  (format-time-string date))
 672                 (date date)
 673                 (t (format-time-string "%Y-%m-%d %T %Z"))))
 674          (dummy (setq opt-plist (plist-put opt-plist :effective-date date)))
 675          (title       (org-xml-encode-org-text-skip-links
 676                        (or (and subtree-p (org-export-get-title-from-subtree))
 677                            (plist-get opt-plist :title)
 678                            (and (not body-only)
 679                                 (not
 680                                  (plist-get opt-plist :skip-before-1st-heading))
 681                                 (org-export-grab-title-from-buffer))
 682                            (and buffer-file-name
 683                                 (file-name-sans-extension
 684                                  (file-name-nondirectory buffer-file-name)))
 685                            "UNTITLED")))
 686          (dummy (setq opt-plist (plist-put opt-plist :title title)))
 687          (html-table-tag (plist-get opt-plist :html-table-tag))
 688          (quote-re0   (concat "^[ \t]*" org-quote-string "\\>"))
 689          (quote-re    (concat "^\\(\\*+\\)\\([ \t]+" org-quote-string "\\>\\)"))
 690          (org-lparse-dyn-current-environment nil)
 691          ;; Get the language-dependent settings
 692          (lang-words (or (assoc (plist-get opt-plist :language)
 693                                 org-export-language-setup)
 694                          (assoc "en" org-export-language-setup)))
 695          (dummy (setq opt-plist (plist-put opt-plist :lang-words lang-words)))
 696          (head-count  0) cnt
 697          (start       0)
 698          (coding-system-for-write
 699           (or (ignore-errors (org-lparse-get 'CODING-SYSTEM-FOR-WRITE))
 700               (and (boundp 'buffer-file-coding-system)
 701                    buffer-file-coding-system)))
 702          (save-buffer-coding-system
 703           (or (ignore-errors (org-lparse-get 'CODING-SYSTEM-FOR-SAVE))
 704               (and (boundp 'buffer-file-coding-system)
 705                    buffer-file-coding-system)))
 706          (region
 707           (buffer-substring
 708            (if region-p (region-beginning) (point-min))
 709            (if region-p (region-end) (point-max))))
 710          (org-export-have-math nil)
 711          (org-export-footnotes-seen nil)
 712          (org-export-footnotes-data (org-footnote-all-labels 'with-defs))
 713          (org-footnote-insert-pos-for-preprocessor 'point-min)
 714          (lines
 715           (org-split-string
 716            (org-export-preprocess-string
 717             region
 718             :emph-multiline t
 719             :for-backend (if (equal org-lparse-backend 'xhtml) ; hack
 720                              'html
 721                            org-lparse-backend)
 722             :skip-before-1st-heading
 723             (plist-get opt-plist :skip-before-1st-heading)
 724             :drawers (plist-get opt-plist :drawers)
 725             :todo-keywords (plist-get opt-plist :todo-keywords)
 726             :tasks (plist-get opt-plist :tasks)
 727             :tags (plist-get opt-plist :tags)
 728             :priority (plist-get opt-plist :priority)
 729             :footnotes (plist-get opt-plist :footnotes)
 730             :timestamps (plist-get opt-plist :timestamps)
 731             :archived-trees
 732             (plist-get opt-plist :archived-trees)
 733             :select-tags (plist-get opt-plist :select-tags)
 734             :exclude-tags (plist-get opt-plist :exclude-tags)
 735             :add-text
 736             (plist-get opt-plist :text)
 737             :LaTeX-fragments
 738             (plist-get opt-plist :LaTeX-fragments))
 739            "[\r\n]"))
 740          table-open
 741          table-buffer table-orig-buffer
 742          ind
 743          rpl path attr desc descp desc1 desc2 link
 744          snumber fnc
 745          footnotes footref-seen
 746          org-lparse-output-buffer
 747          org-lparse-footnote-definitions
 748          org-lparse-footnote-number
 749          org-lparse-footnote-buffer
 750          org-lparse-toc
 751          href
 752          )
 753
 754     (let ((inhibit-read-only t))
 755       (org-unmodified
 756        (remove-text-properties (point-min) (point-max)
 757                                '(:org-license-to-kill t))))
 758
 759     (message "Exporting...")
 760     (org-init-section-numbers)
 761
 762     ;; Switch to the output buffer
 763     (setq org-lparse-output-buffer buffer)
 764     (set-buffer org-lparse-output-buffer)
 765     (let ((inhibit-read-only t)) (erase-buffer))
 766     (fundamental-mode)
 767     (org-install-letbind)
 768
 769     (and (fboundp 'set-buffer-file-coding-system)
 770          (set-buffer-file-coding-system coding-system-for-write))
 771
 772     (let ((case-fold-search nil)
 773           (org-odd-levels-only odd))
 774       ;; create local variables for all options, to make sure all called
 775       ;; functions get the correct information
 776       (mapc (lambda (x)
 777               (set (make-local-variable (nth 2 x))
 778                    (plist-get opt-plist (car x))))
 779             org-export-plist-vars)
 780       (setq umax (if arg (prefix-numeric-value arg)
 781                    org-export-headline-levels))
 782       (setq umax-toc (if (integerp org-export-with-toc)
 783                          (min org-export-with-toc umax)
 784                        umax))
 785
 786       (when (and org-export-with-toc (not body-only))
 787         (setq lines (org-lparse-prepare-toc
 788                      lines level-offset opt-plist umax-toc)))
 789
 790       (unless body-only
 791         (org-lparse-begin 'DOCUMENT-CONTENT opt-plist)
 792         (org-lparse-begin 'DOCUMENT-BODY opt-plist))
 793
 794       (setq head-count 0)
 795       (org-init-section-numbers)
 796
 797       (org-lparse-begin-paragraph)
 798
 799       (while (setq line (pop lines) origline line)
 800         (catch 'nextline
 801           (when (and (org-lparse-current-environment-p 'quote)
 802                      (string-match org-outline-regexp-bol line))
 803             (org-lparse-end-environment 'quote))
 804
 805           (when (org-lparse-current-environment-p 'quote)
 806             (org-lparse-insert 'LINE line)
 807             (throw 'nextline nil))
 808
 809           ;; Fixed-width, verbatim lines (examples)
 810           (when (and org-export-with-fixed-width
 811                      (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" line))
 812             (when (not (org-lparse-current-environment-p 'fixedwidth))
 813               (org-lparse-begin-environment 'fixedwidth))
 814             (org-lparse-insert 'LINE (match-string 3 line))
 815             (when (or (not lines)
 816                       (not (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)"
 817                                          (car lines))))
 818               (org-lparse-end-environment 'fixedwidth))
 819             (throw 'nextline nil))
 820
 821           ;; Notes: The baseline version of org-html.el (git commit
 822           ;; 3d802e), while encoutering a *line-long* protected text,
 823           ;; does one of the following two things based on the state
 824           ;; of the export buffer.
 825
 826           ;; 1. If a paragraph element has just been opened and
 827           ;;    contains only whitespace as content, insert the
 828           ;;    protected text as part of the previous paragraph.
 829
 830           ;; 2. If the paragraph element has already been opened and
 831           ;;    contains some valid content insert the protected text
 832           ;;    as part of the current paragraph.
 833
 834           ;; I think --->
 835
 836           ;; Scenario 1 mentioned above kicks in when a block of
 837           ;; protected text has to be inserted enbloc. For example,
 838           ;; this happens, when inserting an source or example block
 839           ;; or preformatted content enclosed in #+backend,
 840           ;; #+begin_bakend ... #+end_backend)
 841
 842           ;; Scenario 2 mentioned above kicks in when the protected
 843           ;; text is part of a running sentence. For example this
 844           ;; happens in the case of an *multiline* LaTeX equation that
 845           ;; needs to be inserted verbatim.
 846
 847           ;; org-html.el in the master branch seems to do some
 848           ;; jugglery by moving paragraphs around. Inorder to make
 849           ;; these changes backend-agnostic introduce a new text
 850           ;; property org-native-text and impose the added semantics
 851           ;; that these protected blocks appear outside of a
 852           ;; conventional paragraph element.
 853           ;;
 854           ;; Extra Note: Check whether org-example and org-native-text
 855           ;; are entirely equivalent.
 856
 857           ;; Fixes bug reported by Christian Moe concerning verbatim
 858           ;; LaTeX fragments.
 859           ;; on git commit 533ba3f90250a1f25f494c390d639ea6274f235c
 860           ;; http://repo.or.cz/w/org-mode/org-jambu.git/shortlog/refs/heads/staging
 861           ;; See http://lists.gnu.org/archive/html/emacs-orgmode/2011-03/msg01379.html
 862
 863           ;; Native Text
 864           (when (and (get-text-property 0 'org-native-text line)
 865                      ;; Make sure it is the entire line that is protected
 866                      (not (< (or (next-single-property-change
 867                                   0 'org-native-text line) 10000)
 868                              (length line))))
 869             (let ((ind (get-text-property 0 'original-indentation line)))
 870               (org-lparse-begin-environment 'native)
 871               (org-lparse-insert 'LINE line)
 872               (while (and lines
 873                           (or (= (length (car lines)) 0)
 874                               (not ind)
 875                               (equal ind (get-text-property
 876                                           0 'original-indentation (car lines))))
 877                           (or (= (length (car lines)) 0)
 878                               (get-text-property 0 'org-native-text (car lines))))
 879                 (org-lparse-insert 'LINE (pop lines)))
 880               (org-lparse-end-environment 'native))
 881             (throw 'nextline nil))
 882
 883           ;; Protected HTML
 884           (when (and (get-text-property 0 'org-protected line)
 885                      ;; Make sure it is the entire line that is protected
 886                      (not (< (or (next-single-property-change
 887                                   0 'org-protected line) 10000)
 888                              (length line))))
 889             (let ((ind (get-text-property 0 'original-indentation line)))
 890               (org-lparse-insert 'LINE line)
 891               (while (and lines
 892                           (or (= (length (car lines)) 0)
 893                               (not ind)
 894                               (equal ind (get-text-property
 895                                           0 'original-indentation (car lines))))
 896                           (or (= (length (car lines)) 0)
 897                               (get-text-property 0 'org-protected (car lines))))
 898                 (org-lparse-insert 'LINE (pop lines))))
 899             (throw 'nextline nil))
 900
 901           ;; Blockquotes, verse, and center
 902           (when (string-match  "^ORG-\\(.+\\)-\\(START\\|END\\)$" line)
 903             (let* ((style (intern (downcase (match-string 1 line))))
 904                    (f (cdr (assoc (match-string 2 line)
 905                                   '(("START" . org-lparse-begin-environment)
 906                                     ("END" . org-lparse-end-environment))))))
 907               (when (memq style '(blockquote verse center))
 908                 (funcall f style)
 909                 (throw 'nextline nil))))
 910
 911           (run-hooks 'org-export-html-after-blockquotes-hook)
 912           (when (org-lparse-current-environment-p 'verse)
 913             (let ((i (org-get-string-indentation line)))
 914               (if (> i 0)
 915                   (setq line (concat
 916                               (let ((org-lparse-encode-pending t))
 917                                 (org-lparse-format 'SPACES (* 2 i)))
 918                               " " (org-trim line))))
 919               (unless (string-match "\\\\\\\\[ \t]*$" line)
 920                 (setq line (concat line "\\\\")))))
 921
 922           ;; make targets to anchors
 923           (setq start 0)
 924           (while (string-match
 925                   "<<<?\\([^<>]*\\)>>>?\\((INVISIBLE)\\)?[ \t]*\n?" line start)
 926             (cond
 927              ((get-text-property (match-beginning 1) 'org-protected line)
 928               (setq start (match-end 1)))
 929              ((match-end 2)
 930               (setq line (replace-match
 931                           (let ((org-lparse-encode-pending t))
 932                             (org-lparse-format
 933                              'ANCHOR "" (org-solidify-link-text
 934                                          (match-string 1 line))))
 935                           t t line)))
 936              ((and org-export-with-toc (equal (string-to-char line) ?*))
 937               ;; FIXME: NOT DEPENDENT on TOC?????????????????????
 938               (setq line (replace-match
 939                           (let ((org-lparse-encode-pending t))
 940                             (org-lparse-format
 941                              'FONTIFY (match-string 1 line) "target"))
 942                           ;; (concat "@<i>" (match-string 1 line) "@</i> ")
 943                           t t line)))
 944              (t
 945               (setq line (replace-match
 946                           (concat
 947                            (let ((org-lparse-encode-pending t))
 948                              (org-lparse-format
 949                               'ANCHOR (match-string 1 line)
 950                               (org-solidify-link-text (match-string 1 line))
 951                               "target")) " ")
 952                           t t line)))))
 953
 954           (let ((org-lparse-encode-pending t))
 955             (setq line (org-lparse-handle-time-stamps line)))
 956
 957           ;; replace "&" by "&amp;", "<" and ">" by "&lt;" and "&gt;"
 958           ;; handle @<..> HTML tags (replace "@&gt;..&lt;" by "<..>")
 959           ;; Also handle sub_superscripts and checkboxes
 960           (or (string-match org-table-hline-regexp line)
 961               (string-match "^[ \t]*\\([+]-\\||[ ]\\)[-+ |]*[+|][ \t]*$" line)
 962               (setq line (org-xml-encode-org-text-skip-links line)))
 963
 964           (setq line (org-lparse-format-org-link line opt-plist))
 965
 966           ;; TODO items
 967           (if (and (string-match org-todo-line-regexp line)
 968                    (match-beginning 2))
 969               (setq line (concat
 970                           (substring line 0 (match-beginning 2))
 971                           (org-lparse-format 'TODO (match-string 2 line))
 972                           (substring line (match-end 2)))))
 973
 974           ;; Does this contain a reference to a footnote?
 975           (when org-export-with-footnotes
 976             (setq start 0)
 977             (while (string-match "\\([^* \t].*?\\)[ \t]*\\[\\([0-9]+\\)\\]" line start)
 978               ;; Discard protected matches not clearly identified as
 979               ;; footnote markers.
 980               (if (or (get-text-property (match-beginning 2) 'org-protected line)
 981                       (not (get-text-property (match-beginning 2) 'org-footnote line)))
 982                   (setq start (match-end 2))
 983                 (let ((n (match-string 2 line)) refcnt a)
 984                   (if (setq a (assoc n footref-seen))
 985                       (progn
 986                         (setcdr a (1+ (cdr a)))
 987                         (setq refcnt (cdr a)))
 988                     (setq refcnt 1)
 989                     (push (cons n 1) footref-seen))
 990                   (setq line
 991                         (replace-match
 992                          (concat
 993                           (or (match-string 1 line) "")
 994                           (org-lparse-format
 995                            'FOOTNOTE-REFERENCE
 996                            n (cdr (assoc n org-lparse-footnote-definitions))
 997                            refcnt)
 998                           ;; If another footnote is following the
 999                           ;; current one, add a separator.
1000                           (if (save-match-data
1001                                 (string-match "\\`\\[[0-9]+\\]"
1002                                               (substring line (match-end 0))))
1003                               (ignore-errors
1004                                 (org-lparse-get 'FOOTNOTE-SEPARATOR))
1005                             ""))
1006                          t t line))))))
1007
1008           (cond
1009            ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line)
1010             ;; This is a headline
1011             (setq level (org-tr-level (- (match-end 1) (match-beginning 1)
1012                                          level-offset))
1013                   txt (match-string 2 line))
1014             (if (string-match quote-re0 txt)
1015                 (setq txt (replace-match "" t t txt)))
1016             (if (<= level (max umax umax-toc))
1017                 (setq head-count (+ head-count 1)))
1018             (unless org-lparse-dyn-first-heading-pos
1019               (setq org-lparse-dyn-first-heading-pos (point)))
1020             (org-lparse-begin-level level txt umax head-count)
1021
1022             ;; QUOTES
1023             (when (string-match quote-re line)
1024               (org-lparse-begin-environment 'quote)))
1025
1026            ((and org-export-with-tables
1027                  (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line))
1028             (when (not table-open)
1029               ;; New table starts
1030               (setq table-open t table-buffer nil table-orig-buffer nil))
1031
1032             ;; Accumulate lines
1033             (setq table-buffer (cons line table-buffer)
1034                   table-orig-buffer (cons origline table-orig-buffer))
1035             (when (or (not lines)
1036                       (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)"
1037                                          (car lines))))
1038               (setq table-open nil
1039                     table-buffer (nreverse table-buffer)
1040                     table-orig-buffer (nreverse table-orig-buffer))
1041               (org-lparse-end-paragraph)
1042               (org-lparse-insert 'TABLE table-buffer table-orig-buffer)))
1043
1044            ;; Normal lines
1045
1046            (t
1047             ;; This line either is list item or end a list.
1048             (when (get-text-property 0 'list-item line)
1049               (setq line (org-lparse-export-list-line
1050                           line
1051                           (get-text-property 0 'list-item line)
1052                           (get-text-property 0 'list-struct line)
1053                           (get-text-property 0 'list-prevs line))))
1054
1055             ;; Horizontal line
1056             (when (string-match "^[ \t]*-\\{5,\\}[ \t]*$" line)
1057               (with-org-lparse-preserve-paragraph-state
1058                (org-lparse-insert 'HORIZONTAL-LINE))
1059               (throw 'nextline nil))
1060
1061             ;; Empty lines start a new paragraph.  If hand-formatted lists
1062             ;; are not fully interpreted, lines starting with "-", "+", "*"
1063             ;; also start a new paragraph.
1064             (when (string-match "^ [-+*]-\\|^[ \t]*$" line)
1065               (when org-lparse-footnote-number
1066                 (org-lparse-end-footnote-definition org-lparse-footnote-number)
1067                 (setq org-lparse-footnote-number nil))
1068               (org-lparse-begin-paragraph))
1069
1070             ;; Is this the start of a footnote?
1071             (when org-export-with-footnotes
1072               (when (and (boundp 'footnote-section-tag-regexp)
1073                          (string-match (concat "^" footnote-section-tag-regexp)
1074                                        line))
1075                 ;; ignore this line
1076                 (throw 'nextline nil))
1077               (when (string-match "^[ \t]*\\[\\([0-9]+\\)\\]" line)
1078                 (org-lparse-end-paragraph)
1079                 (setq org-lparse-footnote-number (match-string 1 line))
1080                 (setq line (replace-match "" t t line))
1081                 (org-lparse-begin-footnote-definition org-lparse-footnote-number)))
1082             ;; Check if the line break needs to be conserved
1083             (cond
1084              ((string-match "\\\\\\\\[ \t]*$" line)
1085               (setq line (replace-match
1086                           (org-lparse-format 'LINE-BREAK)
1087                           t t line)))
1088              (org-export-preserve-breaks
1089               (setq line (concat line (org-lparse-format 'LINE-BREAK)))))
1090
1091             ;; Check if a paragraph should be started
1092             (let ((start 0))
1093               (while (and org-lparse-par-open
1094                           (string-match "\\\\par\\>" line start))
1095                 (error "FIXME")
1096                 ;; Leave a space in the </p> so that the footnote matcher
1097                 ;; does not see this.
1098                 (if (not (get-text-property (match-beginning 0)
1099                                             'org-protected line))
1100                     (setq line (replace-match "</p ><p >" t t line)))
1101                 (setq start (match-end 0))))
1102
1103             (org-lparse-insert 'LINE line)))))
1104
1105       ;; Properly close all local lists and other lists
1106       (when (org-lparse-current-environment-p 'quote)
1107         (org-lparse-end-environment 'quote))
1108
1109       (org-lparse-end-level 1 umax)
1110
1111       ;; the </div> to close the last text-... div.
1112       (when (and (> umax 0) org-lparse-dyn-first-heading-pos)
1113         (org-lparse-end-outline-text-or-outline))
1114
1115       (org-lparse-end 'DOCUMENT-BODY opt-plist)
1116       (unless body-only
1117         (org-lparse-end 'DOCUMENT-CONTENT))
1118
1119       (unless (plist-get opt-plist :buffer-will-be-killed)
1120         (set-auto-mode t))
1121
1122       (org-lparse-end 'EXPORT)
1123
1124       (goto-char (point-min))
1125       (or (org-export-push-to-kill-ring
1126            (upcase (symbol-name org-lparse-backend)))
1127           (message "Exporting... done"))
1128
1129       (cond
1130        ((not to-buffer)
1131         (let ((f (org-lparse-get 'SAVE-METHOD)))
1132           (or (and f (functionp f) (funcall f filename opt-plist))
1133               (save-buffer)))
1134         (or (when (and (boundp 'org-lparse-other-backend)
1135                        org-lparse-other-backend
1136                        (not (equal org-lparse-backend org-lparse-other-backend)))
1137               (let ((org-lparse-convert-process (org-lparse-get 'CONVERT-METHOD)))
1138                 (when org-lparse-convert-process
1139                   (org-lparse-convert buffer-file-name
1140                                       (symbol-name org-lparse-other-backend)))))
1141             (current-buffer)))
1142        ((eq to-buffer 'string)
1143         (prog1 (buffer-substring (point-min) (point-max))
1144           (kill-buffer (current-buffer))))
1145        (t (current-buffer))))))
1146
1147 (defun org-lparse-format-table (lines olines)
1148   "Retuns backend-specific code for org-type and table-type
1149 tables."
1150   (if (stringp lines)
1151       (setq lines (org-split-string lines "\n")))
1152   (if (string-match "^[ \t]*|" (car lines))
1153       ;; A normal org table
1154       (org-lparse-format-org-table lines nil)
1155     ;; Table made by table.el
1156     (or (org-lparse-format-table-table-using-table-generate-source
1157          org-lparse-backend olines
1158          (not org-export-prefer-native-exporter-for-tables))
1159         ;; We are here only when table.el table has NO col or row
1160         ;; spanning and the user prefers using org's own converter for
1161         ;; exporting of such simple table.el tables.
1162         (org-lparse-format-table-table lines))))
1163
1164 (defun org-lparse-table-get-colalign-info (lines)
1165   (let ((forced-aligns (org-find-text-property-in-string
1166                         'org-forced-aligns (car lines))))
1167     (when (and forced-aligns org-table-clean-did-remove-column)
1168       (setq forced-aligns
1169             (mapcar (lambda (x) (cons (1- (car x)) (cdr x))) forced-aligns)))
1170
1171     forced-aligns))
1172
1173 (defvar org-lparse-table-style)
1174 (defvar org-lparse-table-ncols)
1175 (defvar org-lparse-table-rownum)
1176 (defvar org-lparse-table-is-styled)
1177 (defvar org-lparse-table-begin-marker)
1178 (defvar org-lparse-table-num-numeric-items-per-column)
1179 (defvar org-lparse-table-colalign-info)
1180 (defvar org-lparse-table-colalign-vector)
1181
1182 ;; Following variables are defined in org-table.el
1183 (defvar org-table-number-fraction)
1184 (defvar org-table-number-regexp)
1185
1186 (defun org-lparse-do-format-org-table (lines &optional splice)
1187   "Format a org-type table into backend-specific code.
1188 LINES is a list of lines.  Optional argument SPLICE means, do not
1189 insert header and surrounding <table> tags, just format the lines.
1190 Optional argument NO-CSS means use XHTML attributes instead of CSS
1191 for formatting.  This is required for the DocBook exporter."
1192   (require 'org-table)
1193   ;; Get rid of hlines at beginning and end
1194   (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
1195   (setq lines (nreverse lines))
1196   (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
1197   (setq lines (nreverse lines))
1198   (when org-export-table-remove-special-lines
1199     ;; Check if the table has a marking column.  If yes remove the
1200     ;; column and the special lines
1201     (setq lines (org-table-clean-before-export lines)))
1202
1203   (let* ((caption (org-find-text-property-in-string 'org-caption (car lines)))
1204          (caption (and caption (org-xml-encode-org-text caption)))
1205          (label (org-find-text-property-in-string 'org-label (car lines)))
1206          (org-lparse-table-colalign-info (org-lparse-table-get-colalign-info lines))
1207          (attributes (org-find-text-property-in-string 'org-attributes
1208                                                        (car lines)))
1209          (head (and org-export-highlight-first-table-line
1210                     (delq nil (mapcar
1211                                (lambda (x) (string-match "^[ \t]*|-" x))
1212                                (cdr lines)))))
1213          (org-lparse-table-rownum -1) org-lparse-table-ncols i (cnt 0)
1214          tbopen line fields
1215          org-lparse-table-cur-rowgrp-is-hdr
1216          org-lparse-table-rowgrp-open
1217          org-lparse-table-num-numeric-items-per-column
1218          org-lparse-table-colalign-vector n
1219          org-lparse-table-rowgrp-info
1220          org-lparse-table-begin-marker
1221          (org-lparse-table-style 'org-table)
1222          org-lparse-table-is-styled)
1223     (cond
1224      (splice
1225       (setq org-lparse-table-is-styled nil)
1226       (while (setq line (pop lines))
1227         (unless (string-match "^[ \t]*|-" line)
1228           (insert
1229            (org-lparse-format-table-row
1230             (org-split-string line "[ \t]*|[ \t]*")) "\n"))))
1231      (t
1232       (setq org-lparse-table-is-styled t)
1233       (org-lparse-begin 'TABLE caption label attributes)
1234       (setq org-lparse-table-begin-marker (point))
1235       (org-lparse-begin-table-rowgroup head)
1236       (while (setq line (pop lines))
1237         (cond
1238          ((string-match "^[ \t]*|-" line)
1239           (when lines (org-lparse-begin-table-rowgroup)))
1240          (t
1241           (insert
1242            (org-lparse-format-table-row
1243             (org-split-string line "[ \t]*|[ \t]*")) "\n"))))
1244       (org-lparse-end 'TABLE-ROWGROUP)
1245       (org-lparse-end-table)))))
1246
1247 (defun org-lparse-format-org-table (lines &optional splice)
1248   (with-temp-buffer
1249     (org-lparse-do-format-org-table lines splice)
1250     (buffer-substring-no-properties (point-min) (point-max))))
1251
1252 (defun org-lparse-do-format-table-table (lines)
1253   "Format a table generated by table.el into backend-specific code.
1254 This conversion does *not* use `table-generate-source' from table.el.
1255 This has the advantage that Org-mode's HTML conversions can be used.
1256 But it has the disadvantage, that no cell- or row-spanning is allowed."
1257   (let (line field-buffer
1258              (org-lparse-table-cur-rowgrp-is-hdr
1259               org-export-highlight-first-table-line)
1260              (caption nil)
1261              (attributes nil)
1262              (label nil)
1263              (org-lparse-table-style 'table-table)
1264              (org-lparse-table-is-styled nil)
1265              fields org-lparse-table-ncols i (org-lparse-table-rownum -1)
1266              (empty (org-lparse-format 'SPACES 1)))
1267     (org-lparse-begin 'TABLE caption label attributes)
1268     (while (setq line (pop lines))
1269       (cond
1270        ((string-match "^[ \t]*\\+-" line)
1271         (when field-buffer
1272           (let ((org-export-table-row-tags '("<tr>" . "</tr>"))
1273                 ;; (org-export-html-table-use-header-tags-for-first-column nil)
1274                 )
1275             (insert (org-lparse-format-table-row field-buffer empty)))
1276           (setq org-lparse-table-cur-rowgrp-is-hdr nil)
1277           (setq field-buffer nil)))
1278        (t
1279         ;; Break the line into fields and store the fields
1280         (setq fields (org-split-string line "[ \t]*|[ \t]*"))
1281         (if field-buffer
1282             (setq field-buffer (mapcar
1283                                 (lambda (x)
1284                                   (concat x (org-lparse-format 'LINE-BREAK)
1285                                           (pop fields)))
1286                                 field-buffer))
1287           (setq field-buffer fields)))))
1288     (org-lparse-end-table)))
1289
1290 (defun org-lparse-format-table-table (lines)
1291   (with-temp-buffer
1292     (org-lparse-do-format-table-table lines)
1293     (buffer-substring-no-properties (point-min) (point-max))))
1294
1295 (defvar table-source-languages)         ; defined in table.el
1296 (defun org-lparse-format-table-table-using-table-generate-source (backend
1297                                                                  lines
1298                                                                  &optional
1299                                                                  spanned-only)
1300   "Format a table into BACKEND, using `table-generate-source' from table.el.
1301 Use SPANNED-ONLY to suppress exporting of simple table.el tables.
1302
1303 When SPANNED-ONLY is nil, all table.el tables are exported.  When
1304 SPANNED-ONLY is non-nil, only tables with either row or column
1305 spans are exported.
1306
1307 This routine returns the generated source or nil as appropriate.
1308
1309 Refer docstring of `org-export-prefer-native-exporter-for-tables'
1310 for further information."
1311   (require 'table)
1312   (with-current-buffer (get-buffer-create " org-tmp1 ")
1313     (erase-buffer)
1314     (insert (mapconcat 'identity lines "\n"))
1315     (goto-char (point-min))
1316     (if (not (re-search-forward "|[^+]" nil t))
1317         (error "Error processing table"))
1318     (table-recognize-table)
1319     (when (or (not spanned-only)
1320               (let* ((dim (table-query-dimension))
1321                      (c (nth 4 dim)) (r (nth 5 dim)) (cells (nth 6 dim)))
1322                 (not (= (* c r) cells))))
1323       (with-current-buffer (get-buffer-create " org-tmp2 ") (erase-buffer))
1324       (cond
1325        ((member backend table-source-languages)
1326         (table-generate-source backend " org-tmp2 ")
1327         (set-buffer " org-tmp2 ")
1328         (buffer-substring (point-min) (point-max)))
1329        (t
1330         ;; table.el doesn't support the given backend. Currently this
1331         ;; happens in case of odt export.  Strip the table from the
1332         ;; generated document. A better alternative would be to embed
1333         ;; the table as ascii text in the output document.
1334         (org-lparse-warn
1335          (concat
1336           "Found table.el-type table in the source org file. "
1337           (format "table.el doesn't support %s backend. "
1338                   (upcase (symbol-name backend)))
1339           "Skipping ahead ..."))
1340         "")))))
1341
1342 (defun org-lparse-handle-time-stamps (s)
1343   "Format time stamps in string S, or remove them."
1344   (catch 'exit
1345     (let (r b)
1346       (while (string-match org-maybe-keyword-time-regexp s)
1347         (or b (setq b (substring s 0 (match-beginning 0))))
1348         (setq r (concat
1349                  r (substring s 0 (match-beginning 0)) " "
1350                  (org-lparse-format
1351                   'FONTIFY
1352                   (concat
1353                    (if (match-end 1)
1354                        (org-lparse-format
1355                         'FONTIFY
1356                         (match-string 1 s) "timestamp-kwd"))
1357                    " "
1358                    (org-lparse-format
1359                     'FONTIFY
1360                     (substring (org-translate-time (match-string 3 s)) 1 -1)
1361                     "timestamp"))
1362                   "timestamp-wrapper"))
1363               s (substring s (match-end 0))))
1364       ;; Line break if line started and ended with time stamp stuff
1365       (if (not r)
1366           s
1367         (setq r (concat r s))
1368         (unless (string-match "\\S-" (concat b s))
1369           (setq r (concat r (org-lparse-format 'LINE-BREAK))))
1370         r))))
1371
1372 (defun org-xml-encode-plain-text (s)
1373   "Convert plain text characters to HTML equivalent.
1374 Possible conversions are set in `org-export-html-protect-char-alist'."
1375   (let ((cl (org-lparse-get 'PLAIN-TEXT-MAP)) c)
1376     (while (setq c (pop cl))
1377       (let ((start 0))
1378         (while (string-match (car c) s start)
1379           (setq s (replace-match (cdr c) t t s)
1380                 start (1+ (match-beginning 0))))))
1381     s))
1382
1383 (defun org-xml-encode-org-text-skip-links (string)
1384   "Prepare STRING for HTML export.  Apply all active conversions.
1385 If there are links in the string, don't modify these."
1386   (let* ((re (concat org-bracket-link-regexp "\\|"
1387                      (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")))
1388          m s l res)
1389     (while (setq m (string-match re string))
1390       (setq s (substring string 0 m)
1391             l (match-string 0 string)
1392             string (substring string (match-end 0)))
1393       (push (org-xml-encode-org-text s) res)
1394       (push l res))
1395     (push (org-xml-encode-org-text string) res)
1396     (apply 'concat (nreverse res))))
1397
1398 (defun org-xml-encode-org-text (s)
1399   "Apply all active conversions to translate special ASCII to HTML."
1400   (setq s (org-xml-encode-plain-text s))
1401   (if org-export-html-expand
1402       (while (string-match "@&lt;\\([^&]*\\)&gt;" s)
1403         (setq s (replace-match "<\\1>" t nil s))))
1404   (if org-export-with-emphasize
1405       (setq s (org-lparse-apply-char-styles s)))
1406   (if org-export-with-special-strings
1407       (setq s (org-lparse-convert-special-strings s)))
1408   (if org-export-with-sub-superscripts
1409       (setq s (org-lparse-apply-sub-superscript-styles s)))
1410   (if org-export-with-TeX-macros
1411       (let ((start 0) wd rep)
1412         (while (setq start (string-match "\\\\\\([a-zA-Z]+[0-9]*\\)\\({}\\)?"
1413                                          s start))
1414           (if (get-text-property (match-beginning 0) 'org-protected s)
1415               (setq start (match-end 0))
1416             (setq wd (match-string 1 s))
1417             (if (setq rep (org-lparse-format 'ORG-ENTITY wd))
1418                 (setq s (replace-match rep t t s))
1419               (setq start (+ start (length wd))))))))
1420   s)
1421
1422 (defun org-lparse-convert-special-strings (string)
1423   "Convert special characters in STRING to HTML."
1424   (let ((all (org-lparse-get 'SPECIAL-STRING-REGEXPS))
1425         e a re rpl start)
1426     (while (setq a (pop all))
1427       (setq re (car a) rpl (cdr a) start 0)
1428       (while (string-match re string start)
1429         (if (get-text-property (match-beginning 0) 'org-protected string)
1430             (setq start (match-end 0))
1431           (setq string (replace-match rpl t nil string)))))
1432     string))
1433
1434 (defun org-lparse-apply-sub-superscript-styles (string)
1435   "Apply subscript and superscript styles to STRING.
1436 Use `org-export-with-sub-superscripts' to control application of
1437 sub and superscript styles."
1438   (let (key c (s 0) (requireb (eq org-export-with-sub-superscripts '{})))
1439     (while (string-match org-match-substring-regexp string s)
1440       (cond
1441        ((and requireb (match-end 8)) (setq s (match-end 2)))
1442        ((get-text-property  (match-beginning 2) 'org-protected string)
1443         (setq s (match-end 2)))
1444        (t
1445         (setq s (match-end 1)
1446               key (if (string= (match-string 2 string) "_")
1447                       'subscript 'superscript)
1448               c (or (match-string 8 string)
1449                     (match-string 6 string)
1450                     (match-string 5 string))
1451               string (replace-match
1452                       (concat (match-string 1 string)
1453                               (org-lparse-format 'FONTIFY c key))
1454                       t t string)))))
1455     (while (string-match "\\\\\\([_^]\\)" string)
1456       (setq string (replace-match (match-string 1 string) t t string)))
1457     string))
1458
1459 (defvar org-lparse-char-styles
1460   `(("*" bold)
1461     ("/" emphasis)
1462     ("_" underline)
1463     ("=" code)
1464     ("~" verbatim)
1465     ("+" strike))
1466   "Map Org emphasis markers to char styles.
1467 This is an alist where each element is of the
1468 form (ORG-EMPHASIS-CHAR . CHAR-STYLE).")
1469
1470 (defun org-lparse-apply-char-styles (string)
1471   "Apply char styles to STRING.
1472 The variable `org-lparse-char-styles' controls how the Org
1473 emphasis markers are interpreted."
1474   (let ((s 0) rpl)
1475     (while (string-match org-emph-re string s)
1476       (if (not (equal
1477                 (substring string (match-beginning 3) (1+ (match-beginning 3)))
1478                 (substring string (match-beginning 4) (1+ (match-beginning 4)))))
1479           (setq s (match-beginning 0)
1480                 rpl
1481                 (concat
1482                  (match-string 1 string)
1483                  (org-lparse-format
1484                   'FONTIFY (match-string 4 string)
1485                   (nth 1 (assoc (match-string 3 string)
1486                                 org-lparse-char-styles)))
1487                  (match-string 5 string))
1488                 string (replace-match rpl t t string)
1489                 s (+ s (- (length rpl) 2)))
1490         (setq s (1+ s))))
1491     string))
1492
1493 (defun org-lparse-export-list-line (line pos struct prevs)
1494   "Insert list syntax in export buffer.  Return LINE, maybe modified.
1495
1496 POS is the item position or line position the line had before
1497 modifications to buffer.  STRUCT is the list structure.  PREVS is
1498 the alist of previous items."
1499   (let* ((get-type
1500           (function
1501            ;; Translate type of list containing POS to "d", "o" or
1502            ;; "u".
1503            (lambda (pos struct prevs)
1504              (let ((type (org-list-get-list-type pos struct prevs)))
1505                (cond
1506                 ((eq 'ordered type) "o")
1507                 ((eq 'descriptive type) "d")
1508                 (t "u"))))))
1509          (get-closings
1510           (function
1511            ;; Return list of all items and sublists ending at POS, in
1512            ;; reverse order.
1513            (lambda (pos)
1514              (let (out)
1515                (catch 'exit
1516                  (mapc (lambda (e)
1517                          (let ((end (nth 6 e))
1518                                (item (car e)))
1519                            (cond
1520                             ((= end pos) (push item out))
1521                             ((>= item pos) (throw 'exit nil)))))
1522                        struct))
1523                out)))))
1524     ;; First close any previous item, or list, ending at POS.
1525     (mapc (lambda (e)
1526             (let* ((lastp (= (org-list-get-last-item e struct prevs) e))
1527                    (first-item (org-list-get-list-begin e struct prevs))
1528                    (type (funcall get-type first-item struct prevs)))
1529               (org-lparse-end-paragraph)
1530               ;; Ending for every item
1531               (org-lparse-end-list-item type)
1532               ;; We're ending last item of the list: end list.
1533               (when lastp
1534                 (org-lparse-end 'LIST type)
1535                 (org-lparse-begin-paragraph))))
1536           (funcall get-closings pos))
1537     (cond
1538      ;; At an item: insert appropriate tags in export buffer.
1539      ((assq pos struct)
1540       (string-match
1541        (concat "[ \t]*\\(\\S-+[ \t]*\\)"
1542                "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?"
1543                "\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?"
1544                "\\(?:\\(.*\\)[ \t]+::\\(?:[ \t]+\\|$\\)\\)?"
1545                "\\(.*\\)") line)
1546       (let* ((checkbox (match-string 3 line))
1547              (desc-tag (or (match-string 4 line) "???"))
1548              (body (or (match-string 5 line) ""))
1549              (list-beg (org-list-get-list-begin pos struct prevs))
1550              (firstp (= list-beg pos))
1551              ;; Always refer to first item to determine list type, in
1552              ;; case list is ill-formed.
1553              (type (funcall get-type list-beg struct prevs))
1554              (counter (let ((count-tmp (org-list-get-counter pos struct)))
1555                         (cond
1556                          ((not count-tmp) nil)
1557                          ((string-match "[A-Za-z]" count-tmp)
1558                           (- (string-to-char (upcase count-tmp)) 64))
1559                          ((string-match "[0-9]+" count-tmp)
1560                           count-tmp)))))
1561         (when firstp
1562           (org-lparse-end-paragraph)
1563           (org-lparse-begin 'LIST type))
1564
1565         (let ((arg (cond ((equal type "d") desc-tag)
1566                          ((equal type "o") counter))))
1567           (org-lparse-begin 'LIST-ITEM type arg))
1568
1569         ;; If line had a checkbox, some additional modification is required.
1570         (when checkbox
1571           (setq body
1572                 (concat
1573                  (org-lparse-format
1574                   'FONTIFY (concat
1575                             "["
1576                             (cond
1577                              ((string-match "X" checkbox) "X")
1578                              ((string-match " " checkbox)
1579                               (org-lparse-format 'SPACES 1))
1580                              (t "-"))
1581                             "]")
1582                   'code)
1583                  " "
1584                  body)))
1585         ;; Return modified line
1586         body))
1587      ;; At a list ender: go to next line (side-effects only).
1588      ((equal "ORG-LIST-END-MARKER" line) (throw 'nextline nil))
1589      ;; Not at an item: return line unchanged (side-effects only).
1590      (t line))))
1591
1592 (defun org-lparse-bind-local-variables (opt-plist)
1593   (mapc (lambda (x)
1594           (set (make-local-variable (nth 2 x))
1595                (plist-get opt-plist (car x))))
1596         org-export-plist-vars))
1597
1598 (defvar org-lparse-table-rowgrp-open)
1599 (defvar org-lparse-table-cur-rowgrp-is-hdr)
1600 (defvar org-lparse-footnote-number)
1601 (defvar org-lparse-footnote-definitions)
1602 (defvar org-lparse-footnote-buffer)
1603 (defvar org-lparse-output-buffer)
1604
1605 (defcustom org-lparse-debug nil
1606   "Enable or Disable logging of `org-lparse' callbacks.
1607 The parameters passed to the backend-registered ENTITY-CONTROL
1608 and ENTITY-FORMAT callbacks are logged as comment strings in the
1609 exported buffer.  (org-lparse-format 'COMMENT fmt args) is used
1610 for logging.  Customize this variable only if you are an expert
1611 user.  Valid values of this variable are:
1612 nil     : Disable logging
1613 control : Log all invocations of `org-lparse-begin' and
1614           `org-lparse-end' callbacks.
1615 format  : Log invocations of `org-lparse-format' callbacks.
1616 t       : Log all invocations of `org-lparse-begin', `org-lparse-end'
1617           and `org-lparse-format' callbacks,"
1618   :group 'org-lparse
1619   :type '(choice
1620           (const :tag "Disable" nil)
1621           (const :tag "Format callbacks" format)
1622           (const :tag "Control callbacks" control)
1623           (const :tag "Format and Control callbacks" t)))
1624
1625 (defun org-lparse-begin (entity &rest args)
1626   "Begin ENTITY in current buffer. ARGS is entity specific.
1627 ENTITY can be one of PARAGRAPH, LIST, LIST-ITEM etc.
1628
1629 Use (org-lparse-begin 'LIST \"o\") to begin a list in current
1630 buffer.
1631
1632 See `org-xhtml-entity-control-callbacks-alist' for more
1633 information."
1634   (when (and (member org-lparse-debug '(t control))
1635              (not (eq entity 'DOCUMENT-CONTENT)))
1636     (insert (org-lparse-format 'COMMENT "%s BEGIN %S" entity args)))
1637
1638   (let ((f (cadr (assoc entity org-lparse-entity-control-callbacks-alist))))
1639     (unless f (error "Unknown entity: %s" entity))
1640     (apply f args)))
1641
1642 (defun org-lparse-end (entity &rest args)
1643   "Close ENTITY in current buffer. ARGS is entity specific.
1644 ENTITY can be one of PARAGRAPH, LIST, LIST-ITEM
1645 etc.
1646
1647 Use (org-lparse-end 'LIST \"o\") to close a list in current
1648 buffer.
1649
1650 See `org-xhtml-entity-control-callbacks-alist' for more
1651 information."
1652   (when (and (member org-lparse-debug '(t control))
1653              (not (eq entity 'DOCUMENT-CONTENT)))
1654     (insert (org-lparse-format 'COMMENT "%s END %S" entity args)))
1655
1656   (let ((f (caddr (assoc entity org-lparse-entity-control-callbacks-alist))))
1657     (unless f (error "Unknown entity: %s" entity))
1658     (apply f args)))
1659
1660 (defun org-lparse-begin-paragraph (&optional style)
1661   "Insert <p>, but first close previous paragraph if any."
1662   (org-lparse-end-paragraph)
1663   (org-lparse-begin 'PARAGRAPH style)
1664   (setq org-lparse-par-open t))
1665
1666 (defun org-lparse-end-paragraph ()
1667   "Close paragraph if there is one open."
1668   (when org-lparse-par-open
1669     (org-lparse-end 'PARAGRAPH)
1670     (setq org-lparse-par-open nil)))
1671
1672 (defun org-lparse-end-list-item (&optional type)
1673   "Close <li> if necessary."
1674   (org-lparse-end-paragraph)
1675   (org-lparse-end 'LIST-ITEM (or type "u")))
1676
1677 (defvar org-lparse-dyn-current-environment nil)
1678 (defun org-lparse-begin-environment (style)
1679   (assert (not org-lparse-dyn-current-environment) t)
1680   (setq org-lparse-dyn-current-environment style)
1681   (org-lparse-begin 'ENVIRONMENT  style))
1682
1683 (defun org-lparse-end-environment (style)
1684   (org-lparse-end 'ENVIRONMENT style)
1685
1686   (assert (eq org-lparse-dyn-current-environment style) t)
1687   (setq org-lparse-dyn-current-environment nil))
1688
1689 (defun org-lparse-current-environment-p (style)
1690   (eq org-lparse-dyn-current-environment style))
1691
1692 (defun org-lparse-begin-footnote-definition (n)
1693   (unless org-lparse-footnote-buffer
1694     (setq org-lparse-footnote-buffer
1695           (get-buffer-create "*Org HTML Export Footnotes*")))
1696   (set-buffer org-lparse-footnote-buffer)
1697   (erase-buffer)
1698   (setq org-lparse-insert-tag-with-newlines nil)
1699   (org-lparse-begin 'FOOTNOTE-DEFINITION n))
1700
1701 (defun org-lparse-end-footnote-definition (n)
1702   (org-lparse-end 'FOOTNOTE-DEFINITION n)
1703   (setq org-lparse-insert-tag-with-newlines 'both)
1704   (push (cons n (buffer-string)) org-lparse-footnote-definitions)
1705   (set-buffer org-lparse-output-buffer))
1706
1707 (defun org-lparse-format (entity &rest args)
1708   "Format ENTITY in backend-specific way and return it.
1709 ARGS is specific to entity being formatted.
1710
1711 Use (org-lparse-format 'HEADING \"text\" 1) to format text as
1712 level 1 heading.
1713
1714 See `org-xhtml-entity-format-callbacks-alist' for more information."
1715   (when (and (member org-lparse-debug '(t format))
1716              (not (equal entity 'COMMENT)))
1717     (insert (org-lparse-format 'COMMENT "%s: %S" entity args)))
1718   (cond
1719    ((consp entity)
1720     (let ((text (pop args)))
1721       (apply 'org-lparse-format 'TAGS entity text args)))
1722    (t
1723     (let ((f (cdr (assoc entity org-lparse-entity-format-callbacks-alist))))
1724       (unless f (error "Unknown entity: %s" entity))
1725       (apply f args)))))
1726
1727 (defun org-lparse-insert (entity &rest args)
1728   (insert (apply 'org-lparse-format entity args)))
1729
1730 (defun org-lparse-prepare-toc (lines level-offset opt-plist umax-toc)
1731   (let* ((quote-re0 (concat "^[ \t]*" org-quote-string "\\>"))
1732          (org-min-level (org-get-min-level lines level-offset))
1733          (org-last-level org-min-level)
1734          level)
1735     (with-temp-buffer
1736       (org-lparse-bind-local-variables opt-plist)
1737       (erase-buffer)
1738       (org-lparse-begin 'TOC (nth 3 (plist-get opt-plist :lang-words)))
1739       (setq
1740        lines
1741        (mapcar
1742         #'(lambda (line)
1743             (when (and (string-match org-todo-line-regexp line)
1744                        (not (get-text-property 0 'org-protected line))
1745                        (<= (setq level (org-tr-level
1746                                         (- (match-end 1) (match-beginning 1)
1747                                            level-offset)))
1748                            umax-toc))
1749               (let ((txt (save-match-data
1750                            (org-xml-encode-org-text-skip-links
1751                             (org-export-cleanup-toc-line
1752                              (match-string 3 line)))))
1753                     (todo (and
1754                            org-export-mark-todo-in-toc
1755                            (or (and (match-beginning 2)
1756                                     (not (member (match-string 2 line)
1757                                                  org-done-keywords)))
1758                                (and (= level umax-toc)
1759                                     (org-search-todo-below
1760                                      line lines level)))))
1761                     tags)
1762                 ;; Check for targets
1763                 (while (string-match org-any-target-regexp line)
1764                   (setq line
1765                         (replace-match
1766                          (let ((org-lparse-encode-pending t))
1767                            (org-lparse-format 'FONTIFY
1768                                              (match-string 1 line) "target"))
1769                          t t line)))
1770                 (when (string-match
1771                        (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt)
1772                   (setq tags (match-string 1 txt)
1773                         txt (replace-match "" t nil txt)))
1774                 (when (string-match quote-re0 txt)
1775                   (setq txt (replace-match "" t t txt)))
1776                 (while (string-match "&lt;\\(&lt;\\)+\\|&gt;\\(&gt;\\)+" txt)
1777                   (setq txt (replace-match "" t t txt)))
1778                 (org-lparse-format
1779                  'TOC-ITEM
1780                  (let* ((snumber (org-section-number level))
1781                         (href (replace-regexp-in-string
1782                                "\\." "-" (format "sec-%s" snumber)))
1783                         (href
1784                          (or
1785                           (cdr (assoc
1786                                 href org-export-preferred-target-alist))
1787                           href))
1788                         (href (org-solidify-link-text href)))
1789                    (org-lparse-format 'TOC-ENTRY snumber todo txt tags href))
1790                  level org-last-level)
1791                 (setq org-last-level level)))
1792             line)
1793         lines))
1794       (org-lparse-end 'TOC)
1795       (setq org-lparse-toc (buffer-string))))
1796   lines)
1797
1798 (defun org-lparse-format-table-row (fields &optional text-for-empty-fields)
1799   (unless org-lparse-table-ncols
1800     ;; first row of the table
1801     (setq org-lparse-table-ncols (length fields))
1802     (when org-lparse-table-is-styled
1803       (setq org-lparse-table-num-numeric-items-per-column
1804             (make-vector org-lparse-table-ncols 0))
1805       (setq org-lparse-table-colalign-vector
1806             (make-vector org-lparse-table-ncols nil))
1807       (let ((c -1))
1808         (while  (< (incf c) org-lparse-table-ncols)
1809           (let ((cookie (cdr (assoc (1+ c) org-lparse-table-colalign-info))))
1810             (setf (aref org-lparse-table-colalign-vector c)
1811                   (cond
1812                    ((string= cookie "l") "left")
1813                    ((string= cookie "r") "right")
1814                    ((string= cookie "c") "center")
1815                    (t nil))))))))
1816   (incf org-lparse-table-rownum)
1817   (let ((i -1))
1818     (org-lparse-format
1819      'TABLE-ROW
1820      (mapconcat
1821       (lambda (x)
1822         (when (and (string= x "") text-for-empty-fields)
1823           (setq x text-for-empty-fields))
1824         (incf i)
1825         (and org-lparse-table-is-styled
1826              (< i org-lparse-table-ncols)
1827              (string-match org-table-number-regexp x)
1828              (incf (aref org-lparse-table-num-numeric-items-per-column i)))
1829         (org-lparse-format 'TABLE-CELL x org-lparse-table-rownum i))
1830       fields "\n"))))
1831
1832 (defun org-lparse-get (what &optional opt-plist)
1833   "Query for value of WHAT for the current backend `org-lparse-backend'.
1834 See also `org-lparse-backend-get'."
1835   (if (boundp 'org-lparse-backend)
1836       (org-lparse-backend-get (symbol-name org-lparse-backend) what opt-plist)
1837     (error "org-lparse-backend is not bound yet")))
1838
1839 (defun org-lparse-backend-get (backend what &optional opt-plist)
1840   "Query BACKEND for value of WHAT.
1841 Dispatch the call to `org-<backend>-user-get'.  If that throws an
1842 error, dispatch the call to `org-<backend>-get'.  See
1843 `org-xhtml-get' for all known settings queried for by
1844 `org-lparse' during the course of export."
1845   (assert (stringp backend) t)
1846   (unless (org-lparse-backend-is-native-p backend)
1847     (error "Unknown native backend %s" backend))
1848   (let ((backend-get-method (intern (format "org-%s-get" backend)))
1849         (backend-user-get-method (intern (format "org-%s-user-get" backend))))
1850     (cond
1851      ((functionp backend-get-method)
1852       (condition-case nil
1853           (funcall backend-user-get-method what opt-plist)
1854         (error (funcall backend-get-method what opt-plist))))
1855      (t
1856       (error "Native backend %s doesn't define %s" backend backend-get-method)))))
1857
1858 (defun org-lparse-insert-tag (tag &rest args)
1859   (when (member org-lparse-insert-tag-with-newlines '(lead both))
1860     (insert  "\n"))
1861   (insert (apply 'format tag args))
1862   (when (member org-lparse-insert-tag-with-newlines '(trail both))
1863     (insert  "\n")))
1864
1865 (defun org-lparse-get-targets-from-title (title)
1866   (let* ((target (org-get-text-property-any 0 'target title))
1867          (extra-targets (assoc target org-export-target-aliases))
1868          (target (or (cdr (assoc target org-export-preferred-target-alist))
1869                      target)))
1870     (cons target (remove target extra-targets))))
1871
1872 (defun org-lparse-suffix-from-snumber (snumber)
1873   (let* ((snu (replace-regexp-in-string "\\." "-" snumber))
1874          (href (cdr (assoc (concat "sec-" snu)
1875                            org-export-preferred-target-alist))))
1876     (org-solidify-link-text (or href snu))))
1877
1878 (defun org-lparse-begin-level (level title umax head-count)
1879   "Insert a new LEVEL in HTML export.
1880 When TITLE is nil, just close all open levels."
1881   (org-lparse-end-level level umax)
1882   (unless title (error "Why is heading nil"))
1883   (let* ((targets (org-lparse-get-targets-from-title title))
1884          (target (car targets)) (extra-targets (cdr targets))
1885          (target (and target (org-solidify-link-text target)))
1886          (extra-class (org-get-text-property-any 0 'html-container-class title))
1887          snumber tags level1 class)
1888     (when (string-match (org-re "\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title)
1889       (setq tags (and org-export-with-tags (match-string 1 title)))
1890       (setq title (replace-match "" t t title)))
1891     (if (> level umax)
1892         (progn
1893           (if (aref org-levels-open (1- level))
1894               (org-lparse-end-list-item)
1895             (aset org-levels-open (1- level) t)
1896             (org-lparse-end-paragraph)
1897             (org-lparse-begin 'LIST 'unordered))
1898           (org-lparse-begin
1899            'LIST-ITEM 'unordered target
1900            (org-lparse-format 'HEADLINE title extra-targets tags)))
1901       (aset org-levels-open (1- level) t)
1902       (setq snumber (org-section-number level))
1903       (setq level1 (+ level (or (org-lparse-get 'TOPLEVEL-HLEVEL) 1) -1))
1904       (unless (= head-count 1)
1905         (org-lparse-end-outline-text-or-outline))
1906       (org-lparse-begin-outline-and-outline-text
1907        level1 snumber title tags target extra-targets extra-class)
1908       (org-lparse-begin-paragraph))))
1909
1910 (defun org-lparse-end-level (level umax)
1911   (org-lparse-end-paragraph)
1912   (loop for l from org-level-max downto level
1913         do (when (aref org-levels-open (1- l))
1914              ;; Terminate one level in HTML export
1915              (if (<= l umax)
1916                  (org-lparse-end-outline-text-or-outline)
1917                (org-lparse-end-list-item)
1918                (org-lparse-end 'LIST 'unordered))
1919              (aset org-levels-open (1- l) nil))))
1920
1921 (defvar org-lparse-outline-text-open)
1922 (defun org-lparse-begin-outline-and-outline-text (level1 snumber title tags
1923                                                         target extra-targets
1924                                                         extra-class)
1925   (org-lparse-begin
1926    'OUTLINE level1 snumber title tags target extra-targets extra-class)
1927   (org-lparse-begin-outline-text level1 snumber extra-class))
1928
1929 (defun org-lparse-end-outline-text-or-outline ()
1930   (cond
1931    (org-lparse-outline-text-open
1932     (org-lparse-end 'OUTLINE-TEXT)
1933     (setq org-lparse-outline-text-open nil))
1934    (t (org-lparse-end 'OUTLINE))))
1935
1936 (defun org-lparse-begin-outline-text (level1 snumber extra-class)
1937   (assert (not org-lparse-outline-text-open) t)
1938   (setq org-lparse-outline-text-open t)
1939   (org-lparse-begin 'OUTLINE-TEXT level1 snumber extra-class))
1940
1941 (defun org-lparse-html-list-type-to-canonical-list-type (ltype)
1942   (cdr (assoc ltype '(("o" . ordered)
1943                       ("u" . unordered)
1944                       ("d" . description)))))
1945
1946 (defvar org-lparse-table-rowgrp-info)
1947 (defun org-lparse-begin-table-rowgroup (&optional is-header-row)
1948   (push (cons (1+ org-lparse-table-rownum) :start) org-lparse-table-rowgrp-info)
1949   (org-lparse-begin 'TABLE-ROWGROUP is-header-row))
1950
1951 (defun org-lparse-end-table ()
1952   (when org-lparse-table-is-styled
1953     ;; column groups
1954     (unless (car org-table-colgroup-info)
1955       (setq org-table-colgroup-info
1956             (cons :start (cdr org-table-colgroup-info))))
1957
1958     ;; column alignment
1959     (let ((c -1))
1960       (mapc
1961        (lambda (x)
1962          (incf c)
1963          (setf (aref org-lparse-table-colalign-vector c)
1964                (or (aref org-lparse-table-colalign-vector c)
1965                    (if (> (/ (float x) (1+ org-lparse-table-rownum))
1966                           org-table-number-fraction)
1967                        "right" "left"))))
1968        org-lparse-table-num-numeric-items-per-column)))
1969   (org-lparse-end 'TABLE))
1970
1971 (defvar org-lparse-encode-pending nil)
1972
1973 (defun org-lparse-format-tags (tag text prefix suffix &rest args)
1974   (cond
1975    ((consp tag)
1976     (concat prefix (apply 'format (car tag) args) text suffix
1977             (format (cdr tag))))
1978    ((stringp tag)                       ; singleton tag
1979     (concat prefix (apply 'format tag args) text))))
1980
1981 (defun org-xml-fix-class-name (kwd)     ; audit callers of this function
1982   "Turn todo keyword into a valid class name.
1983 Replaces invalid characters with \"_\"."
1984   (save-match-data
1985     (while (string-match "[^a-zA-Z0-9_]" kwd)
1986       (setq kwd (replace-match "_" t t kwd))))
1987   kwd)
1988
1989 (defun org-lparse-format-todo (todo)
1990   (org-lparse-format 'FONTIFY
1991                      (concat
1992                       (ignore-errors (org-lparse-get 'TODO-KWD-CLASS-PREFIX))
1993                       (org-xml-fix-class-name todo))
1994                      (list (if (member todo org-done-keywords) "done" "todo")
1995                            todo)))
1996
1997 (defun org-lparse-format-extra-targets (extra-targets)
1998   (if (not extra-targets) ""
1999       (mapconcat (lambda (x)
2000                (setq x (org-solidify-link-text
2001                         (if (org-uuidgen-p x) (concat "ID-" x) x)))
2002                (org-lparse-format 'ANCHOR "" x))
2003              extra-targets "")))
2004
2005 (defun org-lparse-format-org-tags (tags)
2006   (if (not tags) ""
2007     (org-lparse-format
2008      'FONTIFY (mapconcat
2009                (lambda (x)
2010                  (org-lparse-format
2011                   'FONTIFY x
2012                   (concat
2013                    (ignore-errors (org-lparse-get 'TAG-CLASS-PREFIX))
2014                    (org-xml-fix-class-name x))))
2015                (org-split-string tags ":")
2016                (org-lparse-format 'SPACES 1)) "tag")))
2017
2018 (defun org-lparse-format-section-number (&optional snumber level)
2019   (and org-export-with-section-numbers
2020        (not org-lparse-body-only) snumber level
2021        (org-lparse-format 'FONTIFY snumber (format "section-number-%d" level))))
2022
2023 (defun org-lparse-warn (msg)
2024   (if (not org-lparse-use-flashy-warning)
2025       (message msg)
2026     (put-text-property 0 (length msg) 'face 'font-lock-warning-face msg)
2027     (message msg)
2028     (sleep-for 3)))
2029
2030 (defun org-xml-format-href (s)
2031   "Make sure the S is valid as a href reference in an XHTML document."
2032   (save-match-data
2033     (let ((start 0))
2034       (while (string-match "&" s start)
2035         (setq start (+ (match-beginning 0) 3)
2036               s (replace-match "&amp;" t t s)))))
2037   s)
2038
2039 (defun org-xml-format-desc (s)
2040   "Make sure the S is valid as a description in a link."
2041   (if (and s (not (get-text-property 1 'org-protected s)))
2042       (save-match-data
2043         (org-xml-encode-org-text s))
2044     s))
2045
2046 (provide 'org-lparse)
2047
2048 ;;; org-lparse.el ends here