lisp/org-lparse.el

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