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   '("xhtml" "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-xhtml-get'.  It returns
 328 `org-xhtml-entity-control-callbacks-alist' and
 329 `org-xhtml-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-xhtml-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 (if (equal org-lparse-backend 'xhtml) ; hack
 641                              'html
 642                            org-lparse-backend)
 643             :skip-before-1st-heading
 644             (plist-get opt-plist :skip-before-1st-heading)
 645             :drawers (plist-get opt-plist :drawers)
 646             :todo-keywords (plist-get opt-plist :todo-keywords)
 647             :tasks (plist-get opt-plist :tasks)
 648             :tags (plist-get opt-plist :tags)
 649             :priority (plist-get opt-plist :priority)
 650             :footnotes (plist-get opt-plist :footnotes)
 651             :timestamps (plist-get opt-plist :timestamps)
 652             :archived-trees
 653             (plist-get opt-plist :archived-trees)
 654             :select-tags (plist-get opt-plist :select-tags)
 655             :exclude-tags (plist-get opt-plist :exclude-tags)
 656             :add-text
 657             (plist-get opt-plist :text)
 658             :LaTeX-fragments
 659             (plist-get opt-plist :LaTeX-fragments))
 660            "[\r\n]"))
 661          table-open
 662          table-buffer table-orig-buffer
 663          ind
 664          rpl path attr desc descp desc1 desc2 link
 665          snumber fnc
 666          footnotes footref-seen
 667          org-lparse-output-buffer
 668          org-lparse-footnote-definitions
 669          org-lparse-footnote-number
 670          org-lparse-footnote-buffer
 671          org-lparse-toc
 672          href
 673          )
 674
 675     (let ((inhibit-read-only t))
 676       (org-unmodified
 677        (remove-text-properties (point-min) (point-max)
 678                                '(:org-license-to-kill t))))
 679
 680     (message "Exporting...")
 681     (org-init-section-numbers)
 682
 683     ;; Switch to the output buffer
 684     (setq org-lparse-output-buffer buffer)
 685     (set-buffer org-lparse-output-buffer)
 686     (let ((inhibit-read-only t)) (erase-buffer))
 687     (fundamental-mode)
 688     (org-install-letbind)
 689
 690     (and (fboundp 'set-buffer-file-coding-system)
 691          (set-buffer-file-coding-system coding-system-for-write))
 692
 693     (let ((case-fold-search nil)
 694           (org-odd-levels-only odd))
 695       ;; create local variables for all options, to make sure all called
 696       ;; functions get the correct information
 697       (mapc (lambda (x)
 698               (set (make-local-variable (nth 2 x))
 699                    (plist-get opt-plist (car x))))
 700             org-export-plist-vars)
 701       (setq umax (if arg (prefix-numeric-value arg)
 702                    org-export-headline-levels))
 703       (setq umax-toc (if (integerp org-export-with-toc)
 704                          (min org-export-with-toc umax)
 705                        umax))
 706
 707       (when (and org-export-with-toc (not body-only))
 708         (setq lines (org-lparse-prepare-toc
 709                      lines level-offset opt-plist umax-toc)))
 710
 711       (unless body-only
 712         (org-lparse-begin 'DOCUMENT-CONTENT opt-plist)
 713         (org-lparse-begin 'DOCUMENT-BODY opt-plist))
 714
 715       (setq head-count 0)
 716       (org-init-section-numbers)
 717
 718       (org-lparse-begin-paragraph)
 719
 720       (while (setq line (pop lines) origline line)
 721         (catch 'nextline
 722           (when (and (org-lparse-current-environment-p 'quote)
 723                      (string-match "^\\*+ " line))
 724             (org-lparse-end-environment 'quote))
 725
 726           (when (org-lparse-current-environment-p 'quote)
 727             (org-lparse-insert 'LINE line)
 728             (throw 'nextline nil))
 729
 730           ;; Fixed-width, verbatim lines (examples)
 731           (when (and org-export-with-fixed-width
 732                      (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" line))
 733             (when (not (org-lparse-current-environment-p 'fixedwidth))
 734               (org-lparse-begin-environment 'fixedwidth))
 735             (org-lparse-insert 'LINE (match-string 3 line))
 736             (when (or (not lines)
 737                       (not (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)"
 738                                          (car lines))))
 739               (org-lparse-end-environment 'fixedwidth))
 740             (throw 'nextline nil))
 741
 742           ;; Notes: The baseline version of org-html.el (git commit
 743           ;; 3d802e), while encoutering a *line-long* protected text,
 744           ;; does one of the following two things based on the state
 745           ;; of the export buffer.
 746
 747           ;; 1. If a paragraph element has just been opened and
 748           ;;    contains only whitespace as content, insert the
 749           ;;    protected text as part of the previous paragraph.
 750
 751           ;; 2. If the paragraph element has already been opened and
 752           ;;    contains some valid content insert the protected text
 753           ;;    as part of the current paragraph.
 754
 755           ;; I think --->
 756
 757           ;; Scenario 1 mentioned above kicks in when a block of
 758           ;; protected text has to be inserted enbloc. For example,
 759           ;; this happens, when inserting an source or example block
 760           ;; or preformatted content enclosed in #+backend,
 761           ;; #+begin_bakend ... #+end_backend)
 762
 763           ;; Scenario 2 mentioned above kicks in when the protected
 764           ;; text is part of a running sentence. For example this
 765           ;; happens in the case of an *multiline* LaTeX equation that
 766           ;; needs to be inserted verbatim.
 767
 768           ;; org-html.el in the master branch seems to do some
 769           ;; jugglery by moving paragraphs around. Inorder to make
 770           ;; these changes backend-agnostic introduce a new text
 771           ;; property org-native-text and impose the added semantics
 772           ;; that these protected blocks appear outside of a
 773           ;; conventional paragraph element.
 774           ;;
 775           ;; Extra Note: Check whether org-example and org-native-text
 776           ;; are entirely equivalent.
 777
 778           ;; Fixes bug reported by Christian Moe concerning verbatim
 779           ;; LaTeX fragments.
 780           ;; on git commit 533ba3f90250a1f25f494c390d639ea6274f235c
 781           ;; http://repo.or.cz/w/org-mode/org-jambu.git/shortlog/refs/heads/staging
 782           ;; See http://lists.gnu.org/archive/html/emacs-orgmode/2011-03/msg01379.html
 783
 784           ;; Native Text
 785           (when (and (get-text-property 0 'org-native-text line)
 786                      ;; Make sure it is the entire line that is protected
 787                      (not (< (or (next-single-property-change
 788                                   0 'org-native-text line) 10000)
 789                              (length line))))
 790             (let ((ind (get-text-property 0 'original-indentation line)))
 791               (org-lparse-begin-environment 'native)
 792               (org-lparse-insert 'LINE line)
 793               (while (and lines
 794                           (or (= (length (car lines)) 0)
 795                               (not ind)
 796                               (equal ind (get-text-property
 797                                           0 'original-indentation (car lines))))
 798                           (or (= (length (car lines)) 0)
 799                               (get-text-property 0 'org-native-text (car lines))))
 800                 (org-lparse-insert 'LINE (pop lines)))
 801               (org-lparse-end-environment 'native))
 802             (throw 'nextline nil))
 803
 804           ;; Protected HTML
 805           (when (and (get-text-property 0 'org-protected line)
 806                      ;; Make sure it is the entire line that is protected
 807                      (not (< (or (next-single-property-change
 808                                   0 'org-protected line) 10000)
 809                              (length line))))
 810             (let ((ind (get-text-property 0 'original-indentation line)))
 811               (org-lparse-insert 'LINE line)
 812               (while (and lines
 813                           (or (= (length (car lines)) 0)
 814                               (not ind)
 815                               (equal ind (get-text-property
 816                                           0 'original-indentation (car lines))))
 817                           (or (= (length (car lines)) 0)
 818                               (get-text-property 0 'org-protected (car lines))))
 819                 (org-lparse-insert 'LINE (pop lines))))
 820             (throw 'nextline nil))
 821
 822           ;; Blockquotes, verse, and center
 823           (when (string-match  "^ORG-\\(.+\\)-\\(START\\|END\\)$" line)
 824             (let* ((style (intern (downcase (match-string 1 line))))
 825                    (f (cdr (assoc (match-string 2 line)
 826                                   '(("START" . org-lparse-begin-environment)
 827                                     ("END" . org-lparse-end-environment))))))
 828               (when (memq style '(blockquote verse center))
 829                 (funcall f style)
 830                 (throw 'nextline nil))))
 831
 832           (run-hooks 'org-export-html-after-blockquotes-hook)
 833           (when (org-lparse-current-environment-p 'verse)
 834             (let ((i (org-get-string-indentation line)))
 835               (if (> i 0)
 836                   (setq line (concat
 837                               (let ((org-lparse-encode-pending t))
 838                                 (org-lparse-format 'SPACES (* 2 i)))
 839                               " " (org-trim line))))
 840               (unless (string-match "\\\\\\\\[ \t]*$" line)
 841                 (setq line (concat line "\\\\")))))
 842
 843           ;; make targets to anchors
 844           (setq start 0)
 845           (while (string-match
 846                   "<<<?\\([^<>]*\\)>>>?\\((INVISIBLE)\\)?[ \t]*\n?" line start)
 847             (cond
 848              ((get-text-property (match-beginning 1) 'org-protected line)
 849               (setq start (match-end 1)))
 850              ((match-end 2)
 851               (setq line (replace-match
 852                           (let ((org-lparse-encode-pending t))
 853                             (org-lparse-format
 854                              'ANCHOR "" (org-solidify-link-text
 855                                          (match-string 1 line))))
 856                           t t line)))
 857              ((and org-export-with-toc (equal (string-to-char line) ?*))
 858               ;; FIXME: NOT DEPENDENT on TOC?????????????????????
 859               (setq line (replace-match
 860                           (let ((org-lparse-encode-pending t))
 861                             (org-lparse-format
 862                              'FONTIFY (match-string 1 line) "target"))
 863                           ;; (concat "@<i>" (match-string 1 line) "@</i> ")
 864                           t t line)))
 865              (t
 866               (setq line (replace-match
 867                           (concat
 868                            (let ((org-lparse-encode-pending t))
 869                              (org-lparse-format
 870                               'ANCHOR (match-string 1 line)
 871                               (org-solidify-link-text (match-string 1 line))
 872                               "target")) " ")
 873                           t t line)))))
 874
 875           (let ((org-lparse-encode-pending t))
 876             (setq line (org-lparse-handle-time-stamps line)))
 877
 878           ;; replace "&" by "&amp;", "<" and ">" by "&lt;" and "&gt;"
 879           ;; handle @<..> HTML tags (replace "@&gt;..&lt;" by "<..>")
 880           ;; Also handle sub_superscripts and checkboxes
 881           (or (string-match org-table-hline-regexp line)
 882               (string-match "^[ \t]*\\([+]-\\||[ ]\\)[-+ |]*[+|][ \t]*$" line)
 883               (setq line (org-xml-encode-org-text-skip-links line)))
 884
 885           (setq line (org-lparse-format-org-link line opt-plist))
 886
 887           ;; TODO items
 888           (if (and (string-match org-todo-line-regexp line)
 889                    (match-beginning 2))
 890               (setq line (concat
 891                           (substring line 0 (match-beginning 2))
 892                           (org-lparse-format 'TODO (match-string 2 line))
 893                           (substring line (match-end 2)))))
 894
 895           ;; Does this contain a reference to a footnote?
 896           (when org-export-with-footnotes
 897             (setq start 0)
 898             (while (string-match "\\([^* \t].*?\\)[ \t]*\\[\\([0-9]+\\)\\]" line start)
 899               (if (get-text-property (match-beginning 2) 'org-protected line)
 900                   (setq start (match-end 2))
 901                 (let ((n (match-string 2 line)) refcnt a)
 902                   (if (setq a (assoc n footref-seen))
 903                       (progn
 904                         (setcdr a (1+ (cdr a)))
 905                         (setq refcnt (cdr a)))
 906                     (setq refcnt 1)
 907                     (push (cons n 1) footref-seen))
 908                   (setq line
 909                         (replace-match
 910                          (concat
 911                           (or (match-string 1 line) "")
 912                           (org-lparse-format
 913                            'FOOTNOTE-REFERENCE
 914                            n (cdr (assoc n org-lparse-footnote-definitions))
 915                            refcnt))
 916                          t t line))))))
 917
 918           (cond
 919            ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line)
 920             ;; This is a headline
 921             (setq level (org-tr-level (- (match-end 1) (match-beginning 1)
 922                                          level-offset))
 923                   txt (match-string 2 line))
 924             (if (string-match quote-re0 txt)
 925                 (setq txt (replace-match "" t t txt)))
 926             (if (<= level (max umax umax-toc))
 927                 (setq head-count (+ head-count 1)))
 928             (unless org-lparse-dyn-first-heading-pos
 929               (setq org-lparse-dyn-first-heading-pos (point)))
 930             (org-lparse-begin-level level txt umax head-count)
 931
 932             ;; QUOTES
 933             (when (string-match quote-re line)
 934               (org-lparse-begin-environment 'quote)))
 935
 936            ((and org-export-with-tables
 937                  (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line))
 938             (when (not table-open)
 939               ;; New table starts
 940               (setq table-open t table-buffer nil table-orig-buffer nil))
 941
 942             ;; Accumulate lines
 943             (setq table-buffer (cons line table-buffer)
 944                   table-orig-buffer (cons origline table-orig-buffer))
 945             (when (or (not lines)
 946                       (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)"
 947                                          (car lines))))
 948               (setq table-open nil
 949                     table-buffer (nreverse table-buffer)
 950                     table-orig-buffer (nreverse table-orig-buffer))
 951               (org-lparse-end-paragraph)
 952               (org-lparse-insert 'TABLE table-buffer table-orig-buffer)))
 953
 954            ;; Normal lines
 955
 956            (t
 957             ;; This line either is list item or end a list.
 958             (when (get-text-property 0 'list-item line)
 959               (setq line (org-lparse-export-list-line
 960                           line
 961                           (get-text-property 0 'list-item line)
 962                           (get-text-property 0 'list-struct line)
 963                           (get-text-property 0 'list-prevs line))))
 964
 965             ;; Horizontal line
 966             (when (string-match "^[ \t]*-\\{5,\\}[ \t]*$" line)
 967               (with-org-lparse-preserve-paragraph-state
 968                (org-lparse-insert 'HORIZONTAL-LINE))
 969               (throw 'nextline nil))
 970
 971             ;; Empty lines start a new paragraph.  If hand-formatted lists
 972             ;; are not fully interpreted, lines starting with "-", "+", "*"
 973             ;; also start a new paragraph.
 974             (when (string-match "^ [-+*]-\\|^[ \t]*$" line)
 975               (when org-lparse-footnote-number
 976                 (org-lparse-end-footnote-definition org-lparse-footnote-number)
 977                 (setq org-lparse-footnote-number nil))
 978               (org-lparse-begin-paragraph))
 979
 980             ;; Is this the start of a footnote?
 981             (when org-export-with-footnotes
 982               (when (and (boundp 'footnote-section-tag-regexp)
 983                          (string-match (concat "^" footnote-section-tag-regexp)
 984                                        line))
 985                 ;; ignore this line
 986                 (throw 'nextline nil))
 987               (when (string-match "^[ \t]*\\[\\([0-9]+\\)\\]" line)
 988                 (org-lparse-end-paragraph)
 989                 (setq org-lparse-footnote-number (match-string 1 line))
 990                 (setq line (replace-match "" t t line))
 991                 (org-lparse-begin-footnote-definition org-lparse-footnote-number)))
 992             ;; Check if the line break needs to be conserved
 993             (cond
 994              ((string-match "\\\\\\\\[ \t]*$" line)
 995               (setq line (replace-match
 996                           (org-lparse-format 'LINE-BREAK)
 997                           t t line)))
 998              (org-export-preserve-breaks
 999               (setq line (concat line (org-lparse-format 'LINE-BREAK)))))
1000
1001             ;; Check if a paragraph should be started
1002             (let ((start 0))
1003               (while (and org-lparse-par-open
1004                           (string-match "\\\\par\\>" line start))
1005                 (error "FIXME")
1006                 ;; Leave a space in the </p> so that the footnote matcher
1007                 ;; does not see this.
1008                 (if (not (get-text-property (match-beginning 0)
1009                                             'org-protected line))
1010                     (setq line (replace-match "</p ><p >" t t line)))
1011                 (setq start (match-end 0))))
1012
1013             (org-lparse-insert 'LINE line)))))
1014
1015       ;; Properly close all local lists and other lists
1016       (when (org-lparse-current-environment-p 'quote)
1017         (org-lparse-end-environment 'quote))
1018
1019       (org-lparse-end-level 1 umax)
1020
1021       ;; the </div> to close the last text-... div.
1022       (when (and (> umax 0) org-lparse-dyn-first-heading-pos)
1023         (org-lparse-end-outline-text-or-outline))
1024
1025       (org-lparse-end 'DOCUMENT-BODY opt-plist)
1026       (unless body-only
1027         (org-lparse-end 'DOCUMENT-CONTENT))
1028
1029       (unless (plist-get opt-plist :buffer-will-be-killed)
1030         (set-auto-mode t))
1031
1032       (org-lparse-end 'EXPORT)
1033
1034       (goto-char (point-min))
1035       (or (org-export-push-to-kill-ring
1036            (upcase (symbol-name org-lparse-backend)))
1037           (message "Exporting... done"))
1038
1039       (cond
1040        ((not to-buffer)
1041         (let ((f (org-lparse-get 'SAVE-METHOD)))
1042           (or (and f (functionp f) (funcall f filename opt-plist))
1043               (save-buffer)))
1044         (or (when (and (boundp 'org-lparse-other-backend)
1045                        org-lparse-other-backend
1046                        (not (equal org-lparse-backend org-lparse-other-backend)))
1047               (let ((org-export-convert-process (org-lparse-get 'CONVERT-METHOD)))
1048                 (when org-export-convert-process
1049                   (org-export-convert buffer-file-name
1050                                       (symbol-name org-lparse-other-backend)))))
1051             (current-buffer)))
1052        ((eq to-buffer 'string)
1053         (prog1 (buffer-substring (point-min) (point-max))
1054           (kill-buffer (current-buffer))))
1055        (t (current-buffer))))))
1056
1057 (defun org-lparse-format-table (lines olines)
1058   "Retuns backend-specific code for org-type and table-type
1059 tables."
1060   (if (stringp lines)
1061       (setq lines (org-split-string lines "\n")))
1062   (if (string-match "^[ \t]*|" (car lines))
1063       ;; A normal org table
1064       (org-lparse-format-org-table lines nil)
1065     ;; Table made by table.el
1066     (or (org-lparse-format-table-table-using-table-generate-source
1067          org-lparse-backend olines
1068          (not org-export-prefer-native-exporter-for-tables))
1069         ;; We are here only when table.el table has NO col or row
1070         ;; spanning and the user prefers using org's own converter for
1071         ;; exporting of such simple table.el tables.
1072         (org-lparse-format-table-table lines))))
1073
1074 (defun org-lparse-table-get-colalign-info (lines)
1075   (let ((forced-aligns (org-find-text-property-in-string
1076                         'org-forced-aligns (car lines))))
1077     (when (and forced-aligns org-table-clean-did-remove-column)
1078       (setq forced-aligns
1079             (mapcar (lambda (x) (cons (1- (car x)) (cdr x))) forced-aligns)))
1080
1081     forced-aligns))
1082
1083 (defvar org-lparse-table-style)
1084 (defvar org-lparse-table-ncols)
1085 (defvar org-lparse-table-rownum)
1086 (defvar org-lparse-table-is-styled)
1087 (defvar org-lparse-table-begin-marker)
1088 (defvar org-lparse-table-num-numeric-items-per-column)
1089 (defvar org-lparse-table-colalign-info)
1090 (defvar org-lparse-table-colalign-vector)
1091
1092 ;; Following variables are defined in org-table.el
1093 (defvar org-table-number-fraction)
1094 (defvar org-table-number-regexp)
1095
1096 (defun org-lparse-do-format-org-table (lines &optional splice)
1097   "Format a org-type table into backend-specific code.
1098 LINES is a list of lines.  Optional argument SPLICE means, do not
1099 insert header and surrounding <table> tags, just format the lines.
1100 Optional argument NO-CSS means use XHTML attributes instead of CSS
1101 for formatting.  This is required for the DocBook exporter."
1102   (require 'org-table)
1103   ;; Get rid of hlines at beginning and end
1104   (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
1105   (setq lines (nreverse lines))
1106   (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
1107   (setq lines (nreverse lines))
1108   (when org-export-table-remove-special-lines
1109     ;; Check if the table has a marking column.  If yes remove the
1110     ;; column and the special lines
1111     (setq lines (org-table-clean-before-export lines)))
1112
1113   (let* ((caption (org-find-text-property-in-string 'org-caption (car lines)))
1114          (caption (and caption (org-xml-encode-org-text caption)))
1115          (label (org-find-text-property-in-string 'org-label (car lines)))
1116          (org-lparse-table-colalign-info (org-lparse-table-get-colalign-info lines))
1117          (attributes (org-find-text-property-in-string 'org-attributes
1118                                                        (car lines)))
1119          (head (and org-export-highlight-first-table-line
1120                     (delq nil (mapcar
1121                                (lambda (x) (string-match "^[ \t]*|-" x))
1122                                (cdr lines)))))
1123          (org-lparse-table-rownum -1) org-lparse-table-ncols i (cnt 0)
1124          tbopen line fields
1125          org-lparse-table-cur-rowgrp-is-hdr
1126          org-lparse-table-rowgrp-open
1127          org-lparse-table-num-numeric-items-per-column
1128          org-lparse-table-colalign-vector n
1129          org-lparse-table-rowgrp-info
1130          org-lparse-table-begin-marker
1131          (org-lparse-table-style 'org-table)
1132          org-lparse-table-is-styled)
1133     (cond
1134      (splice
1135       (setq org-lparse-table-is-styled nil)
1136       (while (setq line (pop lines))
1137         (unless (string-match "^[ \t]*|-" line)
1138           (insert
1139            (org-lparse-format-table-row
1140             (org-split-string line "[ \t]*|[ \t]*")) "\n"))))
1141      (t
1142       (setq org-lparse-table-is-styled t)
1143       (org-lparse-begin 'TABLE caption label attributes)
1144       (setq org-lparse-table-begin-marker (point))
1145       (org-lparse-begin-table-rowgroup head)
1146       (while (setq line (pop lines))
1147         (cond
1148          ((string-match "^[ \t]*|-" line)
1149           (when lines (org-lparse-begin-table-rowgroup)))
1150          (t
1151           (insert
1152            (org-lparse-format-table-row
1153             (org-split-string line "[ \t]*|[ \t]*")) "\n"))))
1154       (org-lparse-end 'TABLE-ROWGROUP)
1155       (org-lparse-end-table)))))
1156
1157 (defun org-lparse-format-org-table (lines &optional splice)
1158   (with-temp-buffer
1159     (org-lparse-do-format-org-table lines splice)
1160     (buffer-substring-no-properties (point-min) (point-max))))
1161
1162 (defun org-lparse-do-format-table-table (lines)
1163   "Format a table generated by table.el into backend-specific code.
1164 This conversion does *not* use `table-generate-source' from table.el.
1165 This has the advantage that Org-mode's HTML conversions can be used.
1166 But it has the disadvantage, that no cell- or row-spanning is allowed."
1167   (let (line field-buffer
1168              (org-lparse-table-cur-rowgrp-is-hdr
1169               org-export-highlight-first-table-line)
1170              (caption nil)
1171              (attributes nil)
1172              (label nil)
1173              (org-lparse-table-style 'table-table)
1174              (org-lparse-table-is-styled nil)
1175              fields org-lparse-table-ncols i (org-lparse-table-rownum -1)
1176              (empty (org-lparse-format 'SPACES 1)))
1177     (org-lparse-begin 'TABLE caption label attributes)
1178     (while (setq line (pop lines))
1179       (cond
1180        ((string-match "^[ \t]*\\+-" line)
1181         (when field-buffer
1182           (let ((org-export-table-row-tags '("<tr>" . "</tr>"))
1183                 ;; (org-export-html-table-use-header-tags-for-first-column nil)
1184                 )
1185             (insert (org-lparse-format-table-row field-buffer empty)))
1186           (setq org-lparse-table-cur-rowgrp-is-hdr nil)
1187           (setq field-buffer nil)))
1188        (t
1189         ;; Break the line into fields and store the fields
1190         (setq fields (org-split-string line "[ \t]*|[ \t]*"))
1191         (if field-buffer
1192             (setq field-buffer (mapcar
1193                                 (lambda (x)
1194                                   (concat x (org-lparse-format 'LINE-BREAK)
1195                                           (pop fields)))
1196                                 field-buffer))
1197           (setq field-buffer fields)))))
1198     (org-lparse-end-table)))
1199
1200 (defun org-lparse-format-table-table (lines)
1201   (with-temp-buffer
1202     (org-lparse-do-format-table-table lines)
1203     (buffer-substring-no-properties (point-min) (point-max))))
1204
1205 (defun org-lparse-format-table-table-using-table-generate-source (backend
1206                                                                  lines
1207                                                                  &optional
1208                                                                  spanned-only)
1209   "Format a table into BACKEND, using `table-generate-source' from table.el.
1210 Use SPANNED-ONLY to suppress exporting of simple table.el tables.
1211
1212 When SPANNED-ONLY is nil, all table.el tables are exported.  When
1213 SPANNED-ONLY is non-nil, only tables with either row or column
1214 spans are exported.
1215
1216 This routine returns the generated source or nil as appropriate.
1217
1218 Refer docstring of `org-export-prefer-native-exporter-for-tables'
1219 for further information."
1220   (require 'table)
1221   (with-current-buffer (get-buffer-create " org-tmp1 ")
1222     (erase-buffer)
1223     (insert (mapconcat 'identity lines "\n"))
1224     (goto-char (point-min))
1225     (if (not (re-search-forward "|[^+]" nil t))
1226         (error "Error processing table"))
1227     (table-recognize-table)
1228     (when (or (not spanned-only)
1229               (let* ((dim (table-query-dimension))
1230                      (c (nth 4 dim)) (r (nth 5 dim)) (cells (nth 6 dim)))
1231                 (not (= (* c r) cells))))
1232       (with-current-buffer (get-buffer-create " org-tmp2 ") (erase-buffer))
1233       (cond
1234        ((member backend table-source-languages)
1235         (table-generate-source backend " org-tmp2 ")
1236         (set-buffer " org-tmp2 ")
1237         (buffer-substring (point-min) (point-max)))
1238        (t
1239         ;; table.el doesn't support the given backend. Currently this
1240         ;; happens in case of odt export.  Strip the table from the
1241         ;; generated document. A better alternative would be to embed
1242         ;; the table as ascii text in the output document.
1243         (org-lparse-warn
1244          (concat
1245           "Found table.el-type table in the source org file. "
1246           (format "table.el doesn't support %s backend. "
1247                   (upcase (symbol-name backend)))
1248           "Skipping ahead ..."))
1249         "")))))
1250
1251 (defun org-lparse-handle-time-stamps (s)
1252   "Format time stamps in string S, or remove them."
1253   (catch 'exit
1254     (let (r b)
1255       (while (string-match org-maybe-keyword-time-regexp s)
1256         (or b (setq b (substring s 0 (match-beginning 0))))
1257         (setq r (concat
1258                  r (substring s 0 (match-beginning 0))
1259                  (org-lparse-format
1260                   'FONTIFY
1261                   (concat
1262                    (if (match-end 1)
1263                        (org-lparse-format
1264                         'FONTIFY
1265                         (match-string 1 s) "timestamp-kwd"))
1266                    (org-lparse-format
1267                     'FONTIFY
1268                     (substring (org-translate-time (match-string 3 s)) 1 -1)
1269                     "timestamp"))
1270                   "timestamp-wrapper"))
1271               s (substring s (match-end 0))))
1272       ;; Line break if line started and ended with time stamp stuff
1273       (if (not r)
1274           s
1275         (setq r (concat r s))
1276         (unless (string-match "\\S-" (concat b s))
1277           (setq r (concat r (org-lparse-format 'LINE-BREAK))))
1278         r))))
1279
1280 (defun org-xml-encode-plain-text (s)
1281   "Convert plain text characters to HTML equivalent.
1282 Possible conversions are set in `org-export-html-protect-char-alist'."
1283   (let ((cl (org-lparse-get 'PLAIN-TEXT-MAP)) c)
1284     (while (setq c (pop cl))
1285       (let ((start 0))
1286         (while (string-match (car c) s start)
1287           (setq s (replace-match (cdr c) t t s)
1288                 start (1+ (match-beginning 0))))))
1289     s))
1290
1291 (defun org-xml-encode-org-text-skip-links (string)
1292   "Prepare STRING for HTML export.  Apply all active conversions.
1293 If there are links in the string, don't modify these."
1294   (let* ((re (concat org-bracket-link-regexp "\\|"
1295                      (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")))
1296          m s l res)
1297     (while (setq m (string-match re string))
1298       (setq s (substring string 0 m)
1299             l (match-string 0 string)
1300             string (substring string (match-end 0)))
1301       (push (org-xml-encode-org-text s) res)
1302       (push l res))
1303     (push (org-xml-encode-org-text string) res)
1304     (apply 'concat (nreverse res))))
1305
1306 (defun org-xml-encode-org-text (s)
1307   "Apply all active conversions to translate special ASCII to HTML."
1308   (setq s (org-xml-encode-plain-text s))
1309   (if org-export-html-expand
1310       (while (string-match "@&lt;\\([^&]*\\)&gt;" s)
1311         (setq s (replace-match "<\\1>" t nil s))))
1312   (if org-export-with-emphasize
1313       (setq s (org-lparse-apply-char-styles s)))
1314   (if org-export-with-special-strings
1315       (setq s (org-lparse-convert-special-strings s)))
1316   (if org-export-with-sub-superscripts
1317       (setq s (org-lparse-apply-sub-superscript-styles s)))
1318   (if org-export-with-TeX-macros
1319       (let ((start 0) wd rep)
1320         (while (setq start (string-match "\\\\\\([a-zA-Z]+[0-9]*\\)\\({}\\)?"
1321                                          s start))
1322           (if (get-text-property (match-beginning 0) 'org-protected s)
1323               (setq start (match-end 0))
1324             (setq wd (match-string 1 s))
1325             (if (setq rep (org-lparse-format 'ORG-ENTITY wd))
1326                 (setq s (replace-match rep t t s))
1327               (setq start (+ start (length wd))))))))
1328   s)
1329
1330 (defun org-lparse-convert-special-strings (string)
1331   "Convert special characters in STRING to HTML."
1332   (let ((all (org-lparse-get 'SPECIAL-STRING-REGEXPS))
1333         e a re rpl start)
1334     (while (setq a (pop all))
1335       (setq re (car a) rpl (cdr a) start 0)
1336       (while (string-match re string start)
1337         (if (get-text-property (match-beginning 0) 'org-protected string)
1338             (setq start (match-end 0))
1339           (setq string (replace-match rpl t nil string)))))
1340     string))
1341
1342 (defun org-lparse-apply-sub-superscript-styles (string)
1343   "Apply subscript and superscript styles to STRING.
1344 Use `org-export-with-sub-superscripts' to control application of
1345 sub and superscript styles."
1346   (let (key c (s 0) (requireb (eq org-export-with-sub-superscripts '{})))
1347     (while (string-match org-match-substring-regexp string s)
1348       (cond
1349        ((and requireb (match-end 8)) (setq s (match-end 2)))
1350        ((get-text-property  (match-beginning 2) 'org-protected string)
1351         (setq s (match-end 2)))
1352        (t
1353         (setq s (match-end 1)
1354               key (if (string= (match-string 2 string) "_")
1355                       'subscript 'superscript)
1356               c (or (match-string 8 string)
1357                     (match-string 6 string)
1358                     (match-string 5 string))
1359               string (replace-match
1360                       (concat (match-string 1 string)
1361                               (org-lparse-format 'FONTIFY c key))
1362                       t t string)))))
1363     (while (string-match "\\\\\\([_^]\\)" string)
1364       (setq string (replace-match (match-string 1 string) t t string)))
1365     string))
1366
1367 (defvar org-lparse-char-styles
1368   `(("*" bold)
1369     ("/" emphasis)
1370     ("_" underline)
1371     ("=" code)
1372     ("~" verbatim)
1373     ("+" strike))
1374   "Map Org emphasis markers to char styles.
1375 This is an alist where each element is of the
1376 form (ORG-EMPHASIS-CHAR . CHAR-STYLE).")
1377
1378 (defun org-lparse-apply-char-styles (string)
1379   "Apply char styles to STRING.
1380 The variable `org-lparse-char-styles' controls how the Org
1381 emphasis markers are interpreted."
1382   (let ((s 0) rpl)
1383     (while (string-match org-emph-re string s)
1384       (if (not (equal
1385                 (substring string (match-beginning 3) (1+ (match-beginning 3)))
1386                 (substring string (match-beginning 4) (1+ (match-beginning 4)))))
1387           (setq s (match-beginning 0)
1388                 rpl
1389                 (concat
1390                  (match-string 1 string)
1391                  (org-lparse-format
1392                   'FONTIFY (match-string 4 string)
1393                   (nth 1 (assoc (match-string 3 string)
1394                                 org-lparse-char-styles)))
1395                  (match-string 5 string))
1396                 string (replace-match rpl t t string)
1397                 s (+ s (- (length rpl) 2)))
1398         (setq s (1+ s))))
1399     string))
1400
1401 (defun org-lparse-export-list-line (line pos struct prevs)
1402   "Insert list syntax in export buffer.  Return LINE, maybe modified.
1403
1404 POS is the item position or line position the line had before
1405 modifications to buffer.  STRUCT is the list structure.  PREVS is
1406 the alist of previous items."
1407   (let* ((get-type
1408           (function
1409            ;; Translate type of list containing POS to "d", "o" or
1410            ;; "u".
1411            (lambda (pos struct prevs)
1412              (let ((type (org-list-get-list-type pos struct prevs)))
1413                (cond
1414                 ((eq 'ordered type) "o")
1415                 ((eq 'descriptive type) "d")
1416                 (t "u"))))))
1417          (get-closings
1418           (function
1419            ;; Return list of all items and sublists ending at POS, in
1420            ;; reverse order.
1421            (lambda (pos)
1422              (let (out)
1423                (catch 'exit
1424                  (mapc (lambda (e)
1425                          (let ((end (nth 6 e))
1426                                (item (car e)))
1427                            (cond
1428                             ((= end pos) (push item out))
1429                             ((>= item pos) (throw 'exit nil)))))
1430                        struct))
1431                out)))))
1432     ;; First close any previous item, or list, ending at POS.
1433     (mapc (lambda (e)
1434             (let* ((lastp (= (org-list-get-last-item e struct prevs) e))
1435                    (first-item (org-list-get-list-begin e struct prevs))
1436                    (type (funcall get-type first-item struct prevs)))
1437               (org-lparse-end-paragraph)
1438               ;; Ending for every item
1439               (org-lparse-end-list-item type)
1440               ;; We're ending last item of the list: end list.
1441               (when lastp
1442                 (org-lparse-end 'LIST type)
1443                 (org-lparse-begin-paragraph))))
1444           (funcall get-closings pos))
1445     (cond
1446      ;; At an item: insert appropriate tags in export buffer.
1447      ((assq pos struct)
1448       (string-match
1449        (concat "[ \t]*\\(\\S-+[ \t]*\\)"
1450                "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\]\\)?"
1451                "\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?"
1452                "\\(?:\\(.*\\)[ \t]+::[ \t]+\\)?"
1453                "\\(.*\\)") line)
1454       (let* ((checkbox (match-string 3 line))
1455              (desc-tag (or (match-string 4 line) "???"))
1456              (body (or (match-string 5 line) ""))
1457              (list-beg (org-list-get-list-begin pos struct prevs))
1458              (firstp (= list-beg pos))
1459              ;; Always refer to first item to determine list type, in
1460              ;; case list is ill-formed.
1461              (type (funcall get-type list-beg struct prevs))
1462              (counter (let ((count-tmp (org-list-get-counter pos struct)))
1463                         (cond
1464                          ((not count-tmp) nil)
1465                          ((string-match "[A-Za-z]" count-tmp)
1466                           (- (string-to-char (upcase count-tmp)) 64))
1467                          ((string-match "[0-9]+" count-tmp)
1468                           count-tmp)))))
1469         (when firstp
1470           (org-lparse-end-paragraph)
1471           (org-lparse-begin 'LIST type))
1472
1473         (let ((arg (cond ((equal type "d") desc-tag)
1474                          ((equal type "o") counter))))
1475           (org-lparse-begin 'LIST-ITEM type arg))
1476
1477         ;; If line had a checkbox, some additional modification is required.
1478         (when checkbox
1479           (setq body
1480                 (concat
1481                  (org-lparse-format
1482                   'FONTIFY (concat
1483                             "["
1484                             (cond
1485                              ((string-match "X" checkbox) "X")
1486                              ((string-match " " checkbox)
1487                               (org-lparse-format 'SPACES 1))
1488                              (t "-"))
1489                             "]")
1490                   'code)
1491                  " "
1492                  body)))
1493         ;; Return modified line
1494         body))
1495      ;; At a list ender: go to next line (side-effects only).
1496      ((equal "ORG-LIST-END-MARKER" line) (throw 'nextline nil))
1497      ;; Not at an item: return line unchanged (side-effects only).
1498      (t line))))
1499
1500 (defun org-lparse-bind-local-variables (opt-plist)
1501   (mapc (lambda (x)
1502           (set (make-local-variable (nth 2 x))
1503                (plist-get opt-plist (car x))))
1504         org-export-plist-vars))
1505
1506 (defvar org-lparse-table-rowgrp-open)
1507 (defvar org-lparse-table-cur-rowgrp-is-hdr)
1508 (defvar org-lparse-footnote-number)
1509 (defvar org-lparse-footnote-definitions)
1510 (defvar org-lparse-footnote-buffer)
1511 (defvar org-lparse-output-buffer)
1512
1513 (defcustom org-lparse-debug nil
1514   "."
1515   :group 'org-lparse
1516   :type 'boolean)
1517
1518 (defun org-lparse-begin (entity &rest args)
1519   (when (and (member org-lparse-debug '(t control))
1520              (not (eq entity 'DOCUMENT-CONTENT)))
1521     (insert (org-lparse-format 'COMMENT "%s BEGIN %S" entity args)))
1522
1523   (let ((f (cadr (assoc entity org-lparse-entity-control-callbacks-alist))))
1524     (unless f (error "Unknown entity: %s" entity))
1525     (apply f args)))
1526
1527 (defun org-lparse-end (entity &rest args)
1528   (when (and (member org-lparse-debug '(t control))
1529              (not (eq entity 'DOCUMENT-CONTENT)))
1530     (insert (org-lparse-format 'COMMENT "%s END %S" entity args)))
1531
1532   (let ((f (caddr (assoc entity org-lparse-entity-control-callbacks-alist))))
1533     (unless f (error "Unknown entity: %s" entity))
1534     (apply f args)))
1535
1536 (defun org-lparse-begin-paragraph (&optional style)
1537   "Insert <p>, but first close previous paragraph if any."
1538   (org-lparse-end-paragraph)
1539   (org-lparse-begin 'PARAGRAPH style)
1540   (setq org-lparse-par-open t))
1541
1542 (defun org-lparse-end-paragraph ()
1543   "Close paragraph if there is one open."
1544   (when org-lparse-par-open
1545     (org-lparse-end 'PARAGRAPH)
1546     (setq org-lparse-par-open nil)))
1547
1548 (defun org-lparse-end-list-item (&optional type)
1549   "Close <li> if necessary."
1550   (org-lparse-end-paragraph)
1551   (org-lparse-end 'LIST-ITEM (or type "u")))
1552
1553 (defvar org-lparse-dyn-current-environment nil)
1554 (defun org-lparse-begin-environment (style)
1555   (assert (not org-lparse-dyn-current-environment) t)
1556   (setq org-lparse-dyn-current-environment style)
1557   (org-lparse-begin 'ENVIRONMENT  style))
1558
1559 (defun org-lparse-end-environment (style)
1560   (org-lparse-end 'ENVIRONMENT style)
1561
1562   (assert (eq org-lparse-dyn-current-environment style) t)
1563   (setq org-lparse-dyn-current-environment nil))
1564
1565 (defun org-lparse-current-environment-p (style)
1566   (eq org-lparse-dyn-current-environment style))
1567
1568 (defun org-lparse-begin-footnote-definition (n)
1569   (unless org-lparse-footnote-buffer
1570     (setq org-lparse-footnote-buffer
1571           (get-buffer-create "*Org HTML Export Footnotes*")))
1572   (set-buffer org-lparse-footnote-buffer)
1573   (erase-buffer)
1574   (setq org-lparse-insert-tag-with-newlines nil)
1575   (org-lparse-begin 'FOOTNOTE-DEFINITION n))
1576
1577 (defun org-lparse-end-footnote-definition (n)
1578   (org-lparse-end 'FOOTNOTE-DEFINITION n)
1579   (setq org-lparse-insert-tag-with-newlines 'both)
1580   (push (cons n (buffer-string)) org-lparse-footnote-definitions)
1581   (set-buffer org-lparse-output-buffer))
1582
1583 (defun org-lparse-format (entity &rest args)
1584   (when (and (member org-lparse-debug '(t format))
1585              (not (equal entity 'COMMENT)))
1586     (insert (org-lparse-format 'COMMENT "%s: %S" entity args)))
1587   (cond
1588    ((consp entity)
1589     (let ((text (pop args)))
1590       (apply 'org-lparse-format 'TAGS entity text args)))
1591    (t
1592     (let ((f (cdr (assoc entity org-lparse-entity-format-callbacks-alist))))
1593       (unless f (error "Unknown entity: %s" entity))
1594       (apply f args)))))
1595
1596 (defun org-lparse-insert (entity &rest args)
1597   (insert (apply 'org-lparse-format entity args)))
1598
1599 (defun org-lparse-prepare-toc (lines level-offset opt-plist umax-toc)
1600   (let* ((quote-re0 (concat "^[ \t]*" org-quote-string "\\>"))
1601          (org-min-level (org-get-min-level lines level-offset))
1602          (org-last-level org-min-level)
1603          level)
1604     (with-temp-buffer
1605       (org-lparse-bind-local-variables opt-plist)
1606       (erase-buffer)
1607       (org-lparse-begin 'TOC (nth 3 (plist-get opt-plist :lang-words)))
1608       (setq
1609        lines
1610        (mapcar
1611         #'(lambda (line)
1612             (when (and (string-match org-todo-line-regexp line)
1613                        (not (get-text-property 0 'org-protected line))
1614                        (<= (setq level (org-tr-level
1615                                         (- (match-end 1) (match-beginning 1)
1616                                            level-offset)))
1617                            umax-toc))
1618               (let ((txt (save-match-data
1619                            (org-xml-encode-org-text-skip-links
1620                             (org-export-cleanup-toc-line
1621                              (match-string 3 line)))))
1622                     (todo (and
1623                            org-export-mark-todo-in-toc
1624                            (or (and (match-beginning 2)
1625                                     (not (member (match-string 2 line)
1626                                                  org-done-keywords)))
1627                                (and (= level umax-toc)
1628                                     (org-search-todo-below
1629                                      line lines level)))))
1630                     tags)
1631                 ;; Check for targets
1632                 (while (string-match org-any-target-regexp line)
1633                   (setq line
1634                         (replace-match
1635                          (let ((org-lparse-encode-pending t))
1636                            (org-lparse-format 'FONTIFY
1637                                              (match-string 1 line) "target"))
1638                          t t line)))
1639                 (when (string-match
1640                        (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt)
1641                   (setq tags (match-string 1 txt)
1642                         txt (replace-match "" t nil txt)))
1643                 (when (string-match quote-re0 txt)
1644                   (setq txt (replace-match "" t t txt)))
1645                 (while (string-match "&lt;\\(&lt;\\)+\\|&gt;\\(&gt;\\)+" txt)
1646                   (setq txt (replace-match "" t t txt)))
1647                 (org-lparse-format
1648                  'TOC-ITEM
1649                  (let* ((snumber (org-section-number level))
1650                         (href (replace-regexp-in-string
1651                                "\\." "-" (format "sec-%s" snumber)))
1652                         (href
1653                          (or
1654                           (cdr (assoc
1655                                 href org-export-preferred-target-alist))
1656                           href))
1657                         (href (org-solidify-link-text href)))
1658                    (org-lparse-format 'TOC-ENTRY snumber todo txt tags href))
1659                  level org-last-level)
1660                 (setq org-last-level level)))
1661             line)
1662         lines))
1663       (org-lparse-end 'TOC)
1664       (setq org-lparse-toc (buffer-string))))
1665   lines)
1666
1667 (defun org-lparse-format-table-row (fields &optional text-for-empty-fields)
1668   (unless org-lparse-table-ncols
1669     ;; first row of the table
1670     (setq org-lparse-table-ncols (length fields))
1671     (when org-lparse-table-is-styled
1672       (setq org-lparse-table-num-numeric-items-per-column
1673             (make-vector org-lparse-table-ncols 0))
1674       (setq org-lparse-table-colalign-vector
1675             (make-vector org-lparse-table-ncols nil))
1676       (let ((c -1))
1677         (while  (< (incf c) org-lparse-table-ncols)
1678           (let ((cookie (cdr (assoc (1+ c) org-lparse-table-colalign-info))))
1679             (setf (aref org-lparse-table-colalign-vector c)
1680                   (cond
1681                    ((string= cookie "l") "left")
1682                    ((string= cookie "r") "right")
1683                    ((string= cookie "c") "center")
1684                    (t nil))))))))
1685   (incf org-lparse-table-rownum)
1686   (let ((i -1))
1687     (org-lparse-format
1688      'TABLE-ROW
1689      (mapconcat
1690       (lambda (x)
1691         (when (and (string= x "") text-for-empty-fields)
1692           (setq x text-for-empty-fields))
1693         (incf i)
1694         (and org-lparse-table-is-styled
1695              (< i org-lparse-table-ncols)
1696              (string-match org-table-number-regexp x)
1697              (incf (aref org-lparse-table-num-numeric-items-per-column i)))
1698         (org-lparse-format 'TABLE-CELL x org-lparse-table-rownum i))
1699       fields "\n"))))
1700
1701 (defun org-lparse-get (what &optional opt-plist)
1702   (if (boundp 'org-lparse-backend)
1703       (org-lparse-backend-get (symbol-name org-lparse-backend) what opt-plist)
1704     (error "org-lparse-backend is not bound yet")))
1705
1706 (defun org-lparse-backend-get (backend what &optional opt-plist)
1707   (assert (stringp backend) t)
1708   (unless (org-lparse-backend-is-native-p backend)
1709     (error "Unknown native backend %s" backend))
1710   (let ((backend-get-method (intern (format "org-%s-get" backend)))
1711         (backend-user-get-method (intern (format "org-%s-user-get" backend))))
1712     (cond
1713      ((functionp backend-get-method)
1714       (condition-case nil
1715           (funcall backend-user-get-method what opt-plist)
1716         (error (funcall backend-get-method what opt-plist))))
1717      (t
1718       (error "Native backend %s doesn't define %s" backend backend-get-method)))))
1719
1720 (defun org-lparse-insert-tag (tag &rest args)
1721   (when (member org-lparse-insert-tag-with-newlines '(lead both))
1722     (insert  "\n"))
1723   (insert (apply 'format tag args))
1724   (when (member org-lparse-insert-tag-with-newlines '(trail both))
1725     (insert  "\n")))
1726
1727 (defun org-lparse-get-targets-from-title (title)
1728   (let* ((target (org-get-text-property-any 0 'target title))
1729          (extra-targets (assoc target org-export-target-aliases))
1730          (target (or (cdr (assoc target org-export-preferred-target-alist))
1731                      target)))
1732     (cons target (remove target extra-targets))))
1733
1734 (defun org-lparse-suffix-from-snumber (snumber)
1735   (let* ((snu (replace-regexp-in-string "\\." "-" snumber))
1736          (href (cdr (assoc (concat "sec-" snu)
1737                            org-export-preferred-target-alist))))
1738     (org-solidify-link-text (or href snu))))
1739
1740 (defun org-lparse-begin-level (level title umax head-count)
1741   "Insert a new LEVEL in HTML export.
1742 When TITLE is nil, just close all open levels."
1743   (org-lparse-end-level level umax)
1744   (unless title (error "Why is heading nil"))
1745   (let* ((targets (org-lparse-get-targets-from-title title))
1746          (target (car targets)) (extra-targets (cdr targets))
1747          (target (and target (org-solidify-link-text target)))
1748          (extra-class (org-get-text-property-any 0 'html-container-class title))
1749          snumber tags level1 class)
1750     (when (string-match (org-re "\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title)
1751       (setq tags (and org-export-with-tags (match-string 1 title)))
1752       (setq title (replace-match "" t t title)))
1753     (if (> level umax)
1754         (progn
1755           (if (aref org-levels-open (1- level))
1756               (org-lparse-end-list-item)
1757             (aset org-levels-open (1- level) t)
1758             (org-lparse-end-paragraph)
1759             (org-lparse-begin 'LIST 'unordered))
1760           (org-lparse-begin
1761            'LIST-ITEM 'unordered target
1762            (org-lparse-format 'HEADLINE title extra-targets tags)))
1763       (aset org-levels-open (1- level) t)
1764       (setq snumber (org-section-number level))
1765       (setq level1 (+ level (or (org-lparse-get 'TOPLEVEL-HLEVEL) 1) -1))
1766       (unless (= head-count 1)
1767         (org-lparse-end-outline-text-or-outline))
1768       (org-lparse-begin-outline-and-outline-text
1769        level1 snumber title tags target extra-targets extra-class)
1770       (org-lparse-begin-paragraph))))
1771
1772 (defun org-lparse-end-level (level umax)
1773   (org-lparse-end-paragraph)
1774   (loop for l from org-level-max downto level
1775         do (when (aref org-levels-open (1- l))
1776              ;; Terminate one level in HTML export
1777              (if (<= l umax)
1778                  (org-lparse-end-outline-text-or-outline)
1779                (org-lparse-end-list-item)
1780                (org-lparse-end 'LIST 'unordered))
1781              (aset org-levels-open (1- l) nil))))
1782
1783 (defvar org-lparse-outline-text-open)
1784 (defun org-lparse-begin-outline-and-outline-text (level1 snumber title tags
1785                                                         target extra-targets
1786                                                         extra-class)
1787   (org-lparse-begin
1788    'OUTLINE level1 snumber title tags target extra-targets extra-class)
1789   (org-lparse-begin-outline-text level1 snumber extra-class))
1790
1791 (defun org-lparse-end-outline-text-or-outline ()
1792   (cond
1793    (org-lparse-outline-text-open
1794     (org-lparse-end 'OUTLINE-TEXT)
1795     (setq org-lparse-outline-text-open nil))
1796    (t (org-lparse-end 'OUTLINE))))
1797
1798 (defun org-lparse-begin-outline-text (level1 snumber extra-class)
1799   (assert (not org-lparse-outline-text-open) t)
1800   (setq org-lparse-outline-text-open t)
1801   (org-lparse-begin 'OUTLINE-TEXT level1 snumber extra-class))
1802
1803 (defun org-lparse-html-list-type-to-canonical-list-type (ltype)
1804   (cdr (assoc ltype '(("o" . ordered)
1805                       ("u" . unordered)
1806                       ("d" . description)))))
1807
1808 (defvar org-lparse-table-rowgrp-info)
1809 (defun org-lparse-begin-table-rowgroup (&optional is-header-row)
1810   (push (cons (1+ org-lparse-table-rownum) :start) org-lparse-table-rowgrp-info)
1811   (org-lparse-begin 'TABLE-ROWGROUP is-header-row))
1812
1813 (defun org-lparse-end-table ()
1814   (when org-lparse-table-is-styled
1815     ;; column groups
1816     (unless (car org-table-colgroup-info)
1817       (setq org-table-colgroup-info
1818             (cons :start (cdr org-table-colgroup-info))))
1819
1820     ;; column alignment
1821     (let ((c -1))
1822       (mapc
1823        (lambda (x)
1824          (incf c)
1825          (setf (aref org-lparse-table-colalign-vector c)
1826                (or (aref org-lparse-table-colalign-vector c)
1827                    (if (> (/ (float x) (1+ org-lparse-table-rownum))
1828                           org-table-number-fraction)
1829                        "right" "left"))))
1830        org-lparse-table-num-numeric-items-per-column)))
1831   (org-lparse-end 'TABLE))
1832
1833 (defvar org-lparse-encode-pending nil)
1834
1835 (defun org-lparse-format-tags (tag text prefix suffix &rest args)
1836   (cond
1837    ((consp tag)
1838     (concat prefix (apply 'format (car tag) args) text suffix
1839             (format (cdr tag))))
1840    ((stringp tag)                       ; singleton tag
1841     (concat prefix (apply 'format tag args) text))))
1842
1843 (defun org-xml-fix-class-name (kwd)     ; audit callers of this function
1844   "Turn todo keyword into a valid class name.
1845 Replaces invalid characters with \"_\"."
1846   (save-match-data
1847     (while (string-match "[^a-zA-Z0-9_]" kwd)
1848       (setq kwd (replace-match "_" t t kwd))))
1849   kwd)
1850
1851 (defun org-lparse-format-todo (todo)
1852   (org-lparse-format 'FONTIFY
1853                      (concat
1854                       (ignore-errors (org-lparse-get 'TODO-KWD-CLASS-PREFIX))
1855                       (org-xml-fix-class-name todo))
1856                      (list (if (member todo org-done-keywords) "done" "todo")
1857                            todo)))
1858
1859 (defun org-lparse-format-extra-targets (extra-targets)
1860   (if (not extra-targets) ""
1861       (mapconcat (lambda (x)
1862                (setq x (org-solidify-link-text
1863                         (if (org-uuidgen-p x) (concat "ID-" x) x)))
1864                (org-lparse-format 'ANCHOR "" x))
1865              extra-targets "")))
1866
1867 (defun org-lparse-format-org-tags (tags)
1868   (if (not tags) ""
1869     (org-lparse-format
1870      'FONTIFY (mapconcat
1871                (lambda (x)
1872                  (org-lparse-format
1873                   'FONTIFY x
1874                   (concat
1875                    (ignore-errors (org-lparse-get 'TAG-CLASS-PREFIX))
1876                    (org-xml-fix-class-name x))))
1877                (org-split-string tags ":")
1878                (org-lparse-format 'SPACES 1)) "tag")))
1879
1880 (defun org-lparse-format-section-number (&optional snumber level)
1881   (and org-export-with-section-numbers
1882        (not body-only) snumber level
1883        (org-lparse-format 'FONTIFY snumber (format "section-number-%d" level))))
1884
1885 (defun org-lparse-warn (msg)
1886   (put-text-property 0 (length msg) 'face 'font-lock-warning-face msg)
1887   (message msg)
1888   (sleep-for 3))
1889
1890 (defun org-xml-format-href (s)
1891   "Make sure the S is valid as a href reference in an XHTML document."
1892   (save-match-data
1893     (let ((start 0))
1894       (while (string-match "&" s start)
1895         (setq start (+ (match-beginning 0) 3)
1896               s (replace-match "&amp;" t t s)))))
1897   s)
1898
1899 (defun org-xml-format-desc (s)
1900   "Make sure the S is valid as a description in a link."
1901   (if (and s (not (get-text-property 1 'org-protected s)))
1902       (save-match-data
1903         (org-xml-encode-org-text s))
1904     s))
1905
1906 (provide 'org-lparse)
1907
1908 ;;; org-lparse.el ends here