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