for-org-html.el

   1 ;;File adding and overriding parts of org-html
   2 (require 'org-html)
   3
   4 ;;;_ , General: make HTML links
   5 ;;;_  . org-html-cvt-link-fn
   6 (defconst org-html-cvt-link-fn
   7    ;;In the future this might change to take more args: type + path +
   8    ;;fragment
   9    #'identity
  10    "Function to convert link URLs to exportable URLs.
  11 Takes one argument, PATH.
  12 Returns exportable URL.
  13 Intended for remote exporting." )
  14
  15 ;;Special variables seen:
  16 ;;`html-extension' -- From plist
  17 ;;`org-par-open' is a special variable so it's not in the arglist.
  18
  19
  20 ;;;_  . org-html-make-link
  21 ;;Adapted from `org-export-as-html'
  22 (defun org-html-make-link (type path fragment desc descp attr
  23                                    may-inline-p)
  24    "Make an HTML link
  25 TYPE is the device-type of the link (And isn't used yet) (THIS://foo.html)
  26 PATH is the path of the link (http://THIS)
  27 FRAGMENT is the fragment part of the link, if any (The foo.html#THIS part)
  28 DESC is the link description, if any.
  29 DESCP is whether there originally was a description.
  30 ATTR is a string of other attributes of the a element.
  31 MAY-INLINE-P allows inlining it as an image."
  32
  33    (declare (special html-extension org-par-open))
  34    (let ((filename path)
  35             thefile)
  36       (save-match-data
  37          ;;First pass.  Mostly deals with treating local files.  TYPE
  38          ;;may still change.
  39          (cond
  40             ((string= type "file")
  41                ;;Substitute just if original path was absolute.
  42                ;;(Otherwise path must remain relative)
  43                (setq thefile
  44                   (if (file-name-absolute-p filename)
  45                      (expand-file-name filename)
  46                      filename))
  47
  48                (when (and org-export-html-link-org-files-as-html
  49                         (string-match "\\.org$" thefile))
  50                   (setq type "http")
  51                   (setq thefile (concat (substring thefile 0
  52                                            (match-beginning 0))
  53                                    "." html-extension))))
  54             (t (setq thefile filename)))
  55
  56          ;;If applicable, convert local path to remote URL
  57          (setq thefile
  58             (or
  59                (funcall org-html-cvt-link-fn thefile)
  60                thefile))
  61
  62          ;;Second pass.  Build final link except for leading type
  63          ;;spec.  Now TYPE is final.
  64          (cond
  65             ((or
  66                 (string= type "http")
  67                 (string= type "https"))
  68                (if fragment
  69                   (setq thefile (concat thefile "#" fragment))))
  70
  71             (t))
  72
  73          ;;Final URL-build, for all types.
  74          (setq thefile
  75             (concat type ":" (org-export-html-format-href thefile)))
  76
  77          (if (and
  78                 may-inline-p
  79                 ;;Can't inline a URL with a fragment.
  80                 (not fragment)
  81                 (or
  82                    (eq t org-export-html-inline-images)
  83                    (and
  84                       org-export-html-inline-images
  85                       (not descp)))
  86                 (org-file-image-p
  87                    filename org-export-html-inline-image-extensions))
  88
  89             (progn
  90                (message "image %s %s" thefile org-par-open)
  91                (org-export-html-format-image thefile org-par-open))
  92             (concat
  93                "<a href=\"" thefile "\"" attr ">"
  94                (org-export-html-format-desc desc)
  95                "</a>")))))
  96
  97 ;;;_  . Borrowed from org-html
  98
  99 (defun org-export-as-html (arg &optional hidden ext-plist
 100                                to-buffer body-only pub-dir)
 101   "Export the outline as a pretty HTML file.
 102 If there is an active region, export only the region.  The prefix
 103 ARG specifies how many levels of the outline should become
 104 headlines.  The default is 3.  Lower levels will become bulleted
 105 lists.  HIDDEN is obsolete and does nothing.
 106 EXT-PLIST is a property list with external parameters overriding
 107 org-mode's default settings, but still inferior to file-local
 108 settings.  When TO-BUFFER is non-nil, create a buffer with that
 109 name and export to that buffer.  If TO-BUFFER is the symbol
 110 `string', don't leave any buffer behind but just return the
 111 resulting HTML as a string.  When BODY-ONLY is set, don't produce
 112 the file header and footer, simply return the content of
 113 <body>...</body>, without even the body tags themselves.  When
 114 PUB-DIR is set, use this as the publishing directory."
 115   (interactive "P")
 116   (run-hooks 'org-export-first-hook)
 117
 118   ;; Make sure we have a file name when we need it.
 119   (when (and (not (or to-buffer body-only))
 120              (not buffer-file-name))
 121     (if (buffer-base-buffer)
 122         (org-set-local 'buffer-file-name
 123                        (with-current-buffer (buffer-base-buffer)
 124                          buffer-file-name))
 125       (error "Need a file name to be able to export")))
 126
 127   (message "Exporting...")
 128   (setq-default org-todo-line-regexp org-todo-line-regexp)
 129   (setq-default org-deadline-line-regexp org-deadline-line-regexp)
 130   (setq-default org-done-keywords org-done-keywords)
 131   (setq-default org-maybe-keyword-time-regexp org-maybe-keyword-time-regexp)
 132   (let* ((opt-plist
 133           (org-export-process-option-filters
 134            (org-combine-plists (org-default-export-plist)
 135                                ext-plist
 136                                (org-infile-export-plist))))
 137          (body-only (or body-only (plist-get opt-plist :body-only)))
 138          (style (concat (if (plist-get opt-plist :style-include-default)
 139                             org-export-html-style-default)
 140                         (plist-get opt-plist :style)
 141                         (plist-get opt-plist :style-extra)
 142                         "\n"
 143                         (if (plist-get opt-plist :style-include-scripts)
 144                             org-export-html-scripts)))
 145          (html-extension (plist-get opt-plist :html-extension))
 146          (link-validate (plist-get opt-plist :link-validation-function))
 147          valid thetoc have-headings first-heading-pos
 148          (odd org-odd-levels-only)
 149          (region-p (org-region-active-p))
 150          (rbeg (and region-p (region-beginning)))
 151          (rend (and region-p (region-end)))
 152          (subtree-p
 153           (if (plist-get opt-plist :ignore-subtree-p)
 154               nil
 155             (when region-p
 156               (save-excursion
 157                 (goto-char rbeg)
 158                 (and (org-at-heading-p)
 159                      (>= (org-end-of-subtree t t) rend))))))
 160          (level-offset (if subtree-p
 161                            (save-excursion
 162                              (goto-char rbeg)
 163                              (+ (funcall outline-level)
 164                                 (if org-odd-levels-only 1 0)))
 165                          0))
 166          (opt-plist (setq org-export-opt-plist
 167                           (if subtree-p
 168                               (org-export-add-subtree-options opt-plist rbeg)
 169                             opt-plist)))
 170          ;; The following two are dynamically scoped into other
 171          ;; routines below.
 172          (org-current-export-dir
 173           (or pub-dir (org-export-directory :html opt-plist)))
 174          (org-current-export-file buffer-file-name)
 175          (level 0) (line "") (origline "") txt todo
 176          (umax nil)
 177          (umax-toc nil)
 178          (filename (if to-buffer nil
 179                      (expand-file-name
 180                       (concat
 181                        (file-name-sans-extension
 182                         (or (and subtree-p
 183                                  (org-entry-get (region-beginning)
 184                                                 "EXPORT_FILE_NAME" t))
 185                             (file-name-nondirectory buffer-file-name)))
 186                        "." html-extension)
 187                       (file-name-as-directory
 188                        (or pub-dir (org-export-directory :html opt-plist))))))
 189          (current-dir (if buffer-file-name
 190                           (file-name-directory buffer-file-name)
 191                         default-directory))
 192          (buffer (if to-buffer
 193                      (cond
 194                       ((eq to-buffer 'string) (get-buffer-create "*Org HTML Export*"))
 195                       (t (get-buffer-create to-buffer)))
 196                    (find-file-noselect filename)))
 197          (org-levels-open (make-vector org-level-max nil))
 198          (date (plist-get opt-plist :date))
 199          (author      (plist-get opt-plist :author))
 200          (title       (or (and subtree-p (org-export-get-title-from-subtree))
 201                           (plist-get opt-plist :title)
 202                           (and (not body-only)
 203                                (not
 204                                 (plist-get opt-plist :skip-before-1st-heading))
 205                                (org-export-grab-title-from-buffer))
 206                           (and buffer-file-name
 207                                (file-name-sans-extension
 208                                 (file-name-nondirectory buffer-file-name)))
 209                           "UNTITLED"))
 210          (link-up (and (plist-get opt-plist :link-up)
 211                        (string-match "\\S-" (plist-get opt-plist :link-up))
 212                        (plist-get opt-plist :link-up)))
 213          (link-home (and (plist-get opt-plist :link-home)
 214                         (string-match "\\S-" (plist-get opt-plist :link-home))
 215                         (plist-get opt-plist :link-home)))
 216          (dummy (setq opt-plist (plist-put opt-plist :title title)))
 217          (html-table-tag (plist-get opt-plist :html-table-tag))
 218          (quote-re0   (concat "^[ \t]*" org-quote-string "\\>"))
 219          (quote-re    (concat "^\\(\\*+\\)\\([ \t]+" org-quote-string "\\>\\)"))
 220          (inquote     nil)
 221          (infixed     nil)
 222          (inverse     nil)
 223          (in-local-list nil)
 224          (local-list-type nil)
 225          (local-list-indent nil)
 226          (llt org-plain-list-ordered-item-terminator)
 227          (email       (plist-get opt-plist :email))
 228          (language    (plist-get opt-plist :language))
 229          (keywords    (plist-get opt-plist :keywords))
 230          (description (plist-get opt-plist :description))
 231          (lang-words  nil)
 232          (head-count  0) cnt
 233          (start       0)
 234          (coding-system (and (boundp 'buffer-file-coding-system)
 235                              buffer-file-coding-system))
 236          (coding-system-for-write (or org-export-html-coding-system
 237                                       coding-system))
 238          (save-buffer-coding-system (or org-export-html-coding-system
 239                                         coding-system))
 240          (charset (and coding-system-for-write
 241                        (fboundp 'coding-system-get)
 242                        (coding-system-get coding-system-for-write
 243                                           'mime-charset)))
 244          (region
 245           (buffer-substring
 246            (if region-p (region-beginning) (point-min))
 247            (if region-p (region-end) (point-max))))
 248          (lines
 249           (org-split-string
 250            (org-export-preprocess-string
 251             region
 252             :emph-multiline t
 253             :for-html t
 254             :skip-before-1st-heading
 255             (plist-get opt-plist :skip-before-1st-heading)
 256             :drawers (plist-get opt-plist :drawers)
 257             :todo-keywords (plist-get opt-plist :todo-keywords)
 258             :tags (plist-get opt-plist :tags)
 259             :priority (plist-get opt-plist :priority)
 260             :footnotes (plist-get opt-plist :footnotes)
 261             :timestamps (plist-get opt-plist :timestamps)
 262             :archived-trees
 263             (plist-get opt-plist :archived-trees)
 264             :select-tags (plist-get opt-plist :select-tags)
 265             :exclude-tags (plist-get opt-plist :exclude-tags)
 266             :add-text
 267             (plist-get opt-plist :text)
 268             :LaTeX-fragments
 269             (plist-get opt-plist :LaTeX-fragments))
 270            "[\r\n]"))
 271          table-open type
 272          table-buffer table-orig-buffer
 273          ind item-type starter didclose
 274          rpl path attr desc descp desc1 desc2 link
 275          snumber fnc item-tag
 276          footnotes footref-seen
 277          id-file href
 278          )
 279
 280     (let ((inhibit-read-only t))
 281       (org-unmodified
 282        (remove-text-properties (point-min) (point-max)
 283                                '(:org-license-to-kill t))))
 284
 285     (message "Exporting...")
 286
 287     (setq org-min-level (org-get-min-level lines level-offset))
 288     (setq org-last-level org-min-level)
 289     (org-init-section-numbers)
 290
 291     (cond
 292      ((and date (string-match "%" date))
 293       (setq date (format-time-string date)))
 294      (date)
 295      (t (setq date (format-time-string "%Y-%m-%d %T %Z"))))
 296
 297     ;; Get the language-dependent settings
 298     (setq lang-words (or (assoc language org-export-language-setup)
 299                          (assoc "en" org-export-language-setup)))
 300
 301     ;; Switch to the output buffer
 302     (set-buffer buffer)
 303     (let ((inhibit-read-only t)) (erase-buffer))
 304     (fundamental-mode)
 305     (org-install-letbind)
 306
 307     (and (fboundp 'set-buffer-file-coding-system)
 308          (set-buffer-file-coding-system coding-system-for-write))
 309
 310     (let ((case-fold-search nil)
 311           (org-odd-levels-only odd))
 312       ;; create local variables for all options, to make sure all called
 313       ;; functions get the correct information
 314       (mapc (lambda (x)
 315               (set (make-local-variable (nth 2 x))
 316                    (plist-get opt-plist (car x))))
 317             org-export-plist-vars)
 318       (setq umax (if arg (prefix-numeric-value arg)
 319                    org-export-headline-levels))
 320       (setq umax-toc (if (integerp org-export-with-toc)
 321                          (min org-export-with-toc umax)
 322                        umax))
 323       (unless body-only
 324         ;; File header
 325         (insert (format
 326                  "%s
 327 <!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
 328                \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">
 329 <html xmlns=\"http://www.w3.org/1999/xhtml\"
 330 lang=\"%s\" xml:lang=\"%s\">
 331 <head>
 332 <title>%s</title>
 333 <meta http-equiv=\"Content-Type\" content=\"text/html;charset=%s\"/>
 334 <meta name=\"generator\" content=\"Org-mode\"/>
 335 <meta name=\"generated\" content=\"%s\"/>
 336 <meta name=\"author\" content=\"%s\"/>
 337 <meta name=\"description\" content=\"%s\"/>
 338 <meta name=\"keywords\" content=\"%s\"/>
 339 %s
 340 </head>
 341 <body>
 342 <div id=\"content\">
 343 %s
 344 "
 345                  (format
 346                   (or (and (stringp org-export-html-xml-declaration)
 347                            org-export-html-xml-declaration)
 348                       (cdr (assoc html-extension org-export-html-xml-declaration))
 349                       (cdr (assoc "html" org-export-html-xml-declaration))
 350
 351                       "")
 352                   (or charset "iso-8859-1"))
 353                  language language
 354                  (org-html-expand title)
 355                  (or charset "iso-8859-1")
 356                  date author description keywords
 357                  style
 358                  (if (or link-up link-home)
 359                      (concat
 360                       (format org-export-html-home/up-format
 361                               (or link-up link-home)
 362                               (or link-home link-up))
 363                       "\n")
 364                    "")))
 365
 366         (org-export-html-insert-plist-item opt-plist :preamble opt-plist)
 367
 368         (when (plist-get opt-plist :auto-preamble)
 369           (if title (insert (format org-export-html-title-format
 370                                     (org-html-expand title))))))
 371
 372       (if (and org-export-with-toc (not body-only))
 373           (progn
 374             (push (format "<h%d>%s</h%d>\n"
 375                           org-export-html-toplevel-hlevel
 376                           (nth 3 lang-words)
 377                           org-export-html-toplevel-hlevel)
 378                   thetoc)
 379             (push "<div id=\"text-table-of-contents\">\n" thetoc)
 380             (push "<ul>\n<li>" thetoc)
 381             (setq lines
 382                   (mapcar '(lambda (line)
 383                     (if (and (string-match org-todo-line-regexp line)
 384                              (not (get-text-property 0 'org-protected line)))
 385                         ;; This is a headline
 386                         (progn
 387                           (setq have-headings t)
 388                           (setq level (- (match-end 1) (match-beginning 1)
 389                                          level-offset)
 390                                 level (org-tr-level level)
 391                                 txt (save-match-data
 392                                       (org-html-expand
 393                                        (org-export-cleanup-toc-line
 394                                         (match-string 3 line))))
 395                                 todo
 396                                 (or (and org-export-mark-todo-in-toc
 397                                          (match-beginning 2)
 398                                          (not (member (match-string 2 line)
 399                                                       org-done-keywords)))
 400                                         ; TODO, not DONE
 401                                     (and org-export-mark-todo-in-toc
 402                                          (= level umax-toc)
 403                                          (org-search-todo-below
 404                                           line lines level))))
 405                           (if (string-match
 406                                (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt)
 407                               (setq txt (replace-match  "&nbsp;&nbsp;&nbsp;<span class=\"tag\"> \\1</span>" t nil txt)))
 408                           (if (string-match quote-re0 txt)
 409                               (setq txt (replace-match "" t t txt)))
 410                           (setq snumber (org-section-number level))
 411                           (if org-export-with-section-numbers
 412                               (setq txt (concat snumber " " txt)))
 413                           (if (<= level (max umax umax-toc))
 414                               (setq head-count (+ head-count 1)))
 415                           (if (<= level umax-toc)
 416                               (progn
 417                                 (if (> level org-last-level)
 418                                     (progn
 419                                       (setq cnt (- level org-last-level))
 420                                       (while (>= (setq cnt (1- cnt)) 0)
 421                                         (push "\n<ul>\n<li>" thetoc))
 422                                       (push "\n" thetoc)))
 423                                 (if (< level org-last-level)
 424                                     (progn
 425                                       (setq cnt (- org-last-level level))
 426                                       (while (>= (setq cnt (1- cnt)) 0)
 427                                         (push "</li>\n</ul>" thetoc))
 428                                       (push "\n" thetoc)))
 429                                 ;; Check for targets
 430                                 (while (string-match org-any-target-regexp line)
 431                                   (setq line (replace-match
 432                                               (concat "@<span class=\"target\">" (match-string 1 line) "@</span> ")
 433                                               t t line)))
 434                                 (while (string-match "&lt;\\(&lt;\\)+\\|&gt;\\(&gt;\\)+" txt)
 435                                   (setq txt (replace-match "" t t txt)))
 436                                 (setq href (format "sec-%s" snumber))
 437                                 (setq href (or (cdr (assoc href org-export-preferred-target-alist)) href))
 438                                 (push
 439                                  (format
 440                                   (if todo
 441                                       "</li>\n<li><a href=\"#%s\"><span class=\"todo\">%s</span></a>"
 442                                     "</li>\n<li><a href=\"#%s\">%s</a>")
 443                                   href txt) thetoc)
 444
 445                                 (setq org-last-level level))
 446                             )))
 447                     line)
 448                           lines))
 449             (while (> org-last-level (1- org-min-level))
 450               (setq org-last-level (1- org-last-level))
 451               (push "</li>\n</ul>\n" thetoc))
 452             (push "</div>\n" thetoc)
 453             (setq thetoc (if have-headings (nreverse thetoc) nil))))
 454
 455       (setq head-count 0)
 456       (org-init-section-numbers)
 457
 458       (org-open-par)
 459
 460       (while (setq line (pop lines) origline line)
 461         (catch 'nextline
 462
 463           ;; end of quote section?
 464           (when (and inquote (string-match "^\\*+ " line))
 465             (insert "</pre>\n")
 466             (org-open-par)
 467             (setq inquote nil))
 468           ;; inside a quote section?
 469           (when inquote
 470             (insert (org-html-protect line) "\n")
 471             (throw 'nextline nil))
 472
 473           ;; Fixed-width, verbatim lines (examples)
 474           (when (and org-export-with-fixed-width
 475                      (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" line))
 476             (when (not infixed)
 477               (setq infixed t)
 478               (org-close-par-maybe)
 479
 480               (insert "<pre class=\"example\">\n"))
 481             (insert (org-html-protect (match-string 3 line)) "\n")
 482             (when (or (not lines)
 483                       (not (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)"
 484                                          (car lines))))
 485               (setq infixed nil)
 486               (insert "</pre>\n")
 487               (org-open-par))
 488             (throw 'nextline nil))
 489
 490           (org-export-html-close-lists-maybe line)
 491
 492           ;; Protected HTML
 493           (when (get-text-property 0 'org-protected line)
 494             (let (par (ind (get-text-property 0 'original-indentation line)))
 495               (when (re-search-backward
 496                      "\\(<p>\\)\\([ \t\r\n]*\\)\\=" (- (point) 100) t)
 497                 (setq par (match-string 1))
 498                 (replace-match "\\2\n"))
 499               (insert line "\n")
 500               (while (and lines
 501                           (or (= (length (car lines)) 0)
 502                               (not ind)
 503                               (equal ind (get-text-property 0 'original-indentation (car lines))))
 504                           (or (= (length (car lines)) 0)
 505                               (get-text-property 0 'org-protected (car lines))))
 506                 (insert (pop lines) "\n"))
 507               (and par (insert "<p>\n")))
 508             (throw 'nextline nil))
 509
 510           ;; Blockquotes, verse, and center
 511           (when (equal "ORG-BLOCKQUOTE-START" line)
 512             (org-close-par-maybe)
 513             (insert "<blockquote>\n")
 514             (org-open-par)
 515             (throw 'nextline nil))
 516           (when (equal "ORG-BLOCKQUOTE-END" line)
 517             (org-close-par-maybe)
 518             (insert "\n</blockquote>\n")
 519             (org-open-par)
 520             (throw 'nextline nil))
 521           (when (equal "ORG-VERSE-START" line)
 522             (org-close-par-maybe)
 523             (insert "\n<p class=\"verse\">\n")
 524             (setq inverse t)
 525             (throw 'nextline nil))
 526           (when (equal "ORG-VERSE-END" line)
 527             (insert "</p>\n")
 528             (org-open-par)
 529             (setq inverse nil)
 530             (throw 'nextline nil))
 531           (when (equal "ORG-CENTER-START" line)
 532             (org-close-par-maybe)
 533             (insert "\n<div style=\"text-align: center\">")
 534             (org-open-par)
 535             (throw 'nextline nil))
 536           (when (equal "ORG-CENTER-END" line)
 537             (org-close-par-maybe)
 538             (insert "\n</div>")
 539             (org-open-par)
 540             (throw 'nextline nil))
 541           (run-hooks 'org-export-html-after-blockquotes-hook)
 542           (when inverse
 543             (let ((i (org-get-string-indentation line)))
 544               (if (> i 0)
 545                   (setq line (concat (mapconcat 'identity
 546                                                 (make-list (* 2 i) "\\nbsp") "")
 547                                      " " (org-trim line))))
 548               (unless (string-match "\\\\\\\\[ \t]*$" line)
 549                 (setq line (concat line "\\\\")))))
 550
 551           ;; make targets to anchors
 552           (setq start 0)
 553           (while (string-match
 554                   "<<<?\\([^<>]*\\)>>>?\\((INVISIBLE)\\)?[ \t]*\n?" line start)
 555             (cond
 556              ((get-text-property (match-beginning 1) 'org-protected line)
 557               (setq start (match-end 1)))
 558              ((match-end 2)
 559               (setq line (replace-match
 560                           (format
 561                            "@<a name=\"%s\" id=\"%s\">@</a>"
 562                            (org-solidify-link-text (match-string 1 line))
 563                            (org-solidify-link-text (match-string 1 line)))
 564                           t t line)))
 565              ((and org-export-with-toc (equal (string-to-char line) ?*))
 566               ;; FIXME: NOT DEPENDENT on TOC?????????????????????
 567               (setq line (replace-match
 568                           (concat "@<span class=\"target\">"
 569                                   (match-string 1 line) "@</span> ")
 570                           ;; (concat "@<i>" (match-string 1 line) "@</i> ")
 571                           t t line)))
 572              (t
 573               (setq line (replace-match
 574                           (concat "@<a name=\""
 575                                   (org-solidify-link-text (match-string 1 line))
 576                                   "\" class=\"target\">" (match-string 1 line)
 577                                   "@</a> ")
 578                           t t line)))))
 579
 580           (setq line (org-html-handle-time-stamps line))
 581
 582           ;; replace "&" by "&amp;", "<" and ">" by "&lt;" and "&gt;"
 583           ;; handle @<..> HTML tags (replace "@&gt;..&lt;" by "<..>")
 584           ;; Also handle sub_superscripts and checkboxes
 585           (or (string-match org-table-hline-regexp line)
 586               (setq line (org-html-expand line)))
 587
 588           ;; Format the links
 589           (setq start 0)
 590           (while (string-match org-bracket-link-analytic-regexp++ line start)
 591             (setq start (match-beginning 0))
 592             (setq path (save-match-data (org-link-unescape
 593                                          (match-string 3 line))))
 594             (setq type (cond
 595                         ((match-end 2) (match-string 2 line))
 596                         ((save-match-data
 597                            (or (file-name-absolute-p path)
 598                                (string-match "^\\.\\.?/" path)))
 599                          "file")
 600                         (t "internal")))
 601             (setq path (org-extract-attributes (org-link-unescape path)))
 602             (setq attr (get-text-property 0 'org-attributes path))
 603             (setq desc1 (if (match-end 5) (match-string 5 line))
 604                   desc2 (if (match-end 2) (concat type ":" path) path)
 605                   descp (and desc1 (not (equal desc1 desc2)))
 606                   desc (or desc1 desc2))
 607             ;; Make an image out of the description if that is so wanted
 608             (when (and descp (org-file-image-p
 609                               desc org-export-html-inline-image-extensions))
 610               (save-match-data
 611                 (if (string-match "^file:" desc)
 612                     (setq desc (substring desc (match-end 0)))))
 613               (setq desc (org-add-props
 614                              (concat "<img src=\"" desc "\"/>")
 615                              '(org-protected t))))
 616             ;; FIXME: do we need to unescape here somewhere?
 617             (cond
 618              ((equal type "internal")
 619               (setq rpl
 620                     (concat
 621                      "<a href=\""
 622                      (if (= (string-to-char path) ?#) "" "#")
 623                      (org-solidify-link-text
 624                       (save-match-data (org-link-unescape path)) nil)
 625                      "\"" attr ">"
 626                      (org-export-html-format-desc desc)
 627                      "</a>")))
 628              ((and (equal type "id")
 629                    (setq id-file (org-id-find-id-file path)))
 630               ;; This is an id: link to another file (if it was the same file,
 631               ;; it would have become an internal link...)
 632               (save-match-data
 633                 (setq id-file (file-relative-name
 634                                id-file (file-name-directory org-current-export-file)))
 635                 (setq rpl
 636                    (org-html-make-link
 637                       "file" id-file
 638                       (concat (if (org-uuidgen-p path) "ID-") path)
 639                       (org-export-html-format-desc desc)
 640                       descp
 641                       attr
 642                       nil))))
 643              ((member type '("http" "https"))
 644               ;; standard URL, just check if we need to inline an
 645               ;; image
 646                 (setq rpl
 647                    (org-html-make-link
 648                       type path nil
 649                       (org-export-html-format-desc desc)
 650                       descp
 651                       attr
 652                       ;;But desc already becomes image.
 653                       t)))
 654              ((member type '("ftp" "mailto" "news"))
 655               ;; standard URL
 656               (setq link (concat type ":" path))
 657               (setq rpl (concat "<a href=\""
 658                                 (org-export-html-format-href link)
 659                                 "\"" attr ">"
 660                                 (org-export-html-format-desc desc)
 661                                 "</a>")))
 662
 663              ((string= type "coderef")
 664               (setq rpl (format "<a href=\"#coderef-%s\" class=\"coderef\" onmouseover=\"CodeHighlightOn(this, 'coderef-%s');\" onmouseout=\"CodeHighlightOff(this, 'coderef-%s');\">%s</a>"
 665                                 path path path
 666                                 (format (org-export-get-coderef-format path (and descp desc))
 667                                         (cdr (assoc path org-export-code-refs))))))
 668
 669              ((functionp (setq fnc (nth 2 (assoc type org-link-protocols))))
 670               ;; The link protocol has a function for format the link
 671               (setq rpl
 672                     (save-match-data
 673                       (funcall fnc (org-link-unescape path) desc1 'html))))
 674
 675              ((string= type "file")
 676               ;; FILE link
 677                 (save-match-data
 678                    (let*
 679                       ((frag-p
 680                           (string-match "::\\(.*\\)" path))
 681                          ;;Get the proper path
 682                          (path-1
 683                             (if frag-p
 684                                (replace-match "" t nil path)
 685                                path))
 686                          ;;Get the raw fragment
 687                          (fragment-0
 688                             (match-string 1 filename))
 689                          ;;Check the fragment.  If it can't be used as
 690                          ;;target fragment we'll use nil instead.
 691                          (fragment-1
 692                             (if
 693                                (and frag-p
 694                                   (not (string-match "^[0-9]*$" fragment-0))
 695                                   (not (string-match "^\\*" fragment-0))
 696                                   (not (string-match "^/.*/$" fragment-0)))
 697
 698                                (org-solidify-link-text
 699                                   (org-link-unescape fragment-0))
 700                                nil))
 701                          (desc-2
 702                             (if (string-match "^file:" desc)
 703                                (let
 704                                   ((desc-1 (replace-match "" t t desc)))
 705                                   (if (string-match "\\.org$" desc-1)
 706                                      (replace-match "" t t desc-1)
 707                                      desc-1))
 708                                desc)))
 709
 710                       (setq rpl
 711                          (if
 712                             (and
 713                                (functionp link-validate)
 714                                (not (funcall link-validate path-1 current-dir)))
 715                             desc
 716                             (org-html-make-link
 717                                "file" path-1 fragment-1 desc-2 descp
 718                                attr t))))))
 719
 720              (t
 721               ;; just publish the path, as default
 722               (setq rpl (concat "<i>&lt;" type ":"
 723                                 (save-match-data (org-link-unescape path))
 724                                 "&gt;</i>"))))
 725             (setq line (replace-match rpl t t line)
 726                   start (+ start (length rpl))))
 727
 728           ;; TODO items
 729           (if (and (string-match org-todo-line-regexp line)
 730                    (match-beginning 2))
 731
 732               (setq line
 733                     (concat (substring line 0 (match-beginning 2))
 734                             "<span class=\""
 735                             (if (member (match-string 2 line)
 736                                         org-done-keywords)
 737                                 "done" "todo")
 738                             " " (match-string 2 line)
 739                             "\"> " (org-export-html-get-todo-kwd-class-name
 740                                     (match-string 2 line))
 741                             "</span>" (substring line (match-end 2)))))
 742
 743           ;; Does this contain a reference to a footnote?
 744           (when org-export-with-footnotes
 745             (setq start 0)
 746             (while (string-match "\\([^* \t].*?\\)\\[\\([0-9]+\\)\\]" line start)
 747               (if (get-text-property (match-beginning 2) 'org-protected line)
 748                   (setq start (match-end 2))
 749                 (let ((n (match-string 2 line)) extra a)
 750                   (if (setq a (assoc n footref-seen))
 751                       (progn
 752                         (setcdr a (1+ (cdr a)))
 753                         (setq extra (format ".%d" (cdr a))))
 754                     (setq extra "")
 755                     (push (cons n 1) footref-seen))
 756                   (setq line
 757                         (replace-match
 758                          (format
 759                           (concat "%s"
 760                                   (format org-export-html-footnote-format
 761                                           "<a class=\"footref\" name=\"fnr.%s%s\" href=\"#fn.%s\">%s</a>"))
 762                           (or (match-string 1 line) "") n extra n n)
 763                          t t line))))))
 764
 765           (cond
 766            ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line)
 767             ;; This is a headline
 768             (setq level (org-tr-level (- (match-end 1) (match-beginning 1)
 769                                          level-offset))
 770                   txt (match-string 2 line))
 771             (if (string-match quote-re0 txt)
 772                 (setq txt (replace-match "" t t txt)))
 773             (if (<= level (max umax umax-toc))
 774                 (setq head-count (+ head-count 1)))
 775             (when in-local-list
 776               ;; Close any local lists before inserting a new header line
 777               (while local-list-type
 778                 (org-close-li (car local-list-type))
 779                 (insert (format "</%sl>\n" (car local-list-type)))
 780                 (pop local-list-type))
 781               (setq local-list-indent nil
 782                     in-local-list nil))
 783             (setq first-heading-pos (or first-heading-pos (point)))
 784             (org-html-level-start level txt umax
 785                                   (and org-export-with-toc (<= level umax))
 786                                   head-count)
 787
 788             ;; QUOTES
 789             (when (string-match quote-re line)
 790               (org-close-par-maybe)
 791               (insert "<pre>")
 792               (setq inquote t)))
 793
 794            ((string-match "^[ \t]*- __+[ \t]*$" line)
 795             ;; Explicit list closure
 796             (when local-list-type
 797               (let ((ind (org-get-indentation line)))
 798                 (while (and local-list-indent
 799                             (<= ind (car local-list-indent)))
 800                   (org-close-li (car local-list-type))
 801                   (insert (format "</%sl>\n" (car local-list-type)))
 802                   (pop local-list-type)
 803                   (pop local-list-indent))
 804                 (or local-list-indent (setq in-local-list nil))))
 805             (throw 'nextline nil))
 806
 807            ((and org-export-with-tables
 808                  (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line))
 809             (when (not table-open)
 810               ;; New table starts
 811               (setq table-open t table-buffer nil table-orig-buffer nil))
 812
 813             ;; Accumulate lines
 814             (setq table-buffer (cons line table-buffer)
 815                   table-orig-buffer (cons origline table-orig-buffer))
 816             (when (or (not lines)
 817                       (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)"
 818                                          (car lines))))
 819               (setq table-open nil
 820                     table-buffer (nreverse table-buffer)
 821                     table-orig-buffer (nreverse table-orig-buffer))
 822               (org-close-par-maybe)
 823               (insert (org-format-table-html table-buffer table-orig-buffer))))
 824            (t
 825             ;; Normal lines
 826             (when (string-match
 827                    (cond
 828                     ((eq llt t) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+[.)]\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)")
 829                     ((= llt ?.) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+\\.\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)")
 830                     ((= llt ?\)) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+)\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)")
 831                     (t (error "Invalid value of `org-plain-list-ordered-item-terminator'")))
 832                    line)
 833               (setq ind (or (get-text-property 0 'original-indentation line)
 834                             (org-get-string-indentation line))
 835                     item-type (if (match-beginning 4) "o" "u")
 836                     starter (if (match-beginning 2)
 837                                 (substring (match-string 2 line) 0 -1))
 838                     line (substring line (match-beginning 5))
 839                     item-tag nil)
 840               (if (and starter (string-match "\\(.*?\\) ::[ \t]*" line))
 841                   (setq item-type "d"
 842                         item-tag (match-string 1 line)
 843                         line (substring line (match-end 0))))
 844               (when (and (not (equal item-type "d"))
 845                          (not (string-match "[^ \t]" line)))
 846                 ;; empty line.  Pretend indentation is large.
 847                 (setq ind (if org-empty-line-terminates-plain-lists
 848                               0
 849                             (1+ (or (car local-list-indent) 1)))))
 850               (setq didclose nil)
 851               (while (and in-local-list
 852                           (or (and (= ind (car local-list-indent))
 853                                    (not starter))
 854                               (< ind (car local-list-indent))))
 855                 (setq didclose t)
 856                 (org-close-li (car local-list-type))
 857                 (insert (format "</%sl>\n" (car local-list-type)))
 858                 (pop local-list-type) (pop local-list-indent)
 859                 (setq in-local-list local-list-indent))
 860               (cond
 861                ((and starter
 862                      (or (not in-local-list)
 863                          (> ind (car local-list-indent))))
 864                 ;; Start new (level of) list
 865                 (org-close-par-maybe)
 866                 (insert (cond
 867                          ((equal item-type "u") "<ul>\n<li>\n")
 868                          ((equal item-type "o") "<ol>\n<li>\n")
 869                          ((equal item-type "d")
 870                           (format "<dl>\n<dt>%s</dt><dd>\n" item-tag))))
 871                 (push item-type local-list-type)
 872                 (push ind local-list-indent)
 873                 (setq in-local-list t))
 874                (starter
 875                 ;; continue current list
 876                 (org-close-li (car local-list-type))
 877                 (insert (cond
 878                          ((equal (car local-list-type) "d")
 879                           (format "<dt>%s</dt><dd>\n" (or item-tag "???")))
 880                          (t "<li>\n"))))
 881                (didclose
 882                 ;; we did close a list, normal text follows: need <p>
 883                 (org-open-par)))
 884               (if (string-match "^[ \t]*\\[\\([X ]\\)\\]" line)
 885                   (setq line
 886                         (replace-match
 887                          (if (equal (match-string 1 line) "X")
 888                              "<b>[X]</b>"
 889                            "<b>[<span style=\"visibility:hidden;\">X</span>]</b>")
 890                            t t line))))
 891
 892             ;; Horizontal line
 893             (when (string-match "^[ \t]*-\\{5,\\}[ \t]*$" line)
 894               (if org-par-open
 895                   (insert "\n</p>\n<hr/>\n<p>\n")
 896                 (insert "\n<hr/>\n"))
 897               (throw 'nextline nil))
 898
 899             ;; Empty lines start a new paragraph.  If hand-formatted lists
 900             ;; are not fully interpreted, lines starting with "-", "+", "*"
 901             ;; also start a new paragraph.
 902             (if (string-match "^ [-+*]-\\|^[ \t]*$" line) (org-open-par))
 903
 904             ;; Is this the start of a footnote?
 905             (when org-export-with-footnotes
 906               (when (and (boundp 'footnote-section-tag-regexp)
 907                          (string-match (concat "^" footnote-section-tag-regexp)
 908                                        line))
 909                 ;; ignore this line
 910                 (throw 'nextline nil))
 911               (when (string-match "^[ \t]*\\[\\([0-9]+\\)\\]" line)
 912                 (org-close-par-maybe)
 913                 (let ((n (match-string 1 line)))
 914                   (setq org-par-open t
 915                         line (replace-match
 916                               (format
 917                                (concat "<p class=\"footnote\">"
 918                                        (format org-export-html-footnote-format
 919                                                "<a class=\"footnum\" name=\"fn.%s\" href=\"#fnr.%s\">%s</a>"))
 920                                n n n) t t line)))))
 921             ;; Check if the line break needs to be conserved
 922             (cond
 923              ((string-match "\\\\\\\\[ \t]*$" line)
 924               (setq line (replace-match "<br/>" t t line)))
 925              (org-export-preserve-breaks
 926               (setq line (concat line "<br/>"))))
 927
 928             ;; Check if a paragraph should be started
 929             (let ((start 0))
 930               (while (and org-par-open
 931                           (string-match "\\\\par\\>" line start))
 932                 ;; Leave a space in the </p> so that the footnote matcher
 933                 ;; does not see this.
 934                 (if (not (get-text-property (match-beginning 0)
 935                                             'org-protected line))
 936                     (setq line (replace-match "</p ><p >" t t line)))
 937                 (setq start (match-end 0))))
 938
 939             (insert line "\n")))))
 940
 941       ;; Properly close all local lists and other lists
 942       (when inquote
 943         (insert "</pre>\n")
 944         (org-open-par))
 945       (when in-local-list
 946         ;; Close any local lists before inserting a new header line
 947         (while local-list-type
 948           (org-close-li (car local-list-type))
 949           (insert (format "</%sl>\n" (car local-list-type)))
 950           (pop local-list-type))
 951         (setq local-list-indent nil
 952               in-local-list nil))
 953       (org-html-level-start 1 nil umax
 954                             (and org-export-with-toc (<= level umax))
 955                             head-count)
 956       ;; the </div> to close the last text-... div.
 957       (when (and (> umax 0) first-heading-pos) (insert "</div>\n"))
 958
 959       (save-excursion
 960         (goto-char (point-min))
 961         (while (re-search-forward "<p class=\"footnote\">[^\000]*?\\(</p>\\|\\'\\)" nil t)
 962           (push (match-string 0) footnotes)
 963           (replace-match "" t t)))
 964       (when footnotes
 965         (insert (format org-export-html-footnotes-section
 966                         (nth 4 lang-words)
 967                         (mapconcat 'identity (nreverse footnotes) "\n"))
 968                 "\n"))
 969       (let ((bib (org-export-html-get-bibliography)))
 970         (when bib
 971           (insert "\n" bib "\n")))
 972       (unless body-only
 973         (when (plist-get opt-plist :auto-postamble)
 974           (insert "<div id=\"postamble\">\n")
 975           (when (and org-export-author-info author)
 976             (insert "<p class=\"author\"> "
 977                     (nth 1 lang-words) ": " author "\n")
 978             (when (and org-export-email-info email (string-match "\\S-" email))
 979               (if (listp (split-string email ",+ *"))
 980                   (mapc (lambda(e)
 981                           (insert "<a href=\"mailto:" e "\">&lt;"
 982                                   e "&gt;</a>\n"))
 983                         (split-string email ",+ *"))
 984                 (insert "<a href=\"mailto:" email "\">&lt;"
 985                         email "&gt;</a>\n")))
 986             (insert "</p>\n"))
 987           (when (and date org-export-time-stamp-file)
 988             (insert "<p class=\"date\"> "
 989                     (nth 2 lang-words) ": "
 990                     date "</p>\n"))
 991           (when org-export-creator-info
 992             (insert (format "<p class=\"creator\">HTML generated by org-mode %s in emacs %s</p>\n"
 993                             org-version emacs-major-version)))
 994           (when org-export-html-validation-link
 995             (insert org-export-html-validation-link "\n"))
 996           (insert "</div>"))
 997
 998         (if org-export-html-with-timestamp
 999             (insert org-export-html-html-helper-timestamp))
1000         (org-export-html-insert-plist-item opt-plist :postamble opt-plist)
1001         (insert "\n</div>\n</body>\n</html>\n"))
1002
1003       (unless (plist-get opt-plist :buffer-will-be-killed)
1004         (normal-mode)
1005         (if (eq major-mode (default-value 'major-mode))
1006             (html-mode)))
1007
1008       ;; insert the table of contents
1009       (goto-char (point-min))
1010       (when thetoc
1011         (if (or (re-search-forward
1012                  "<p>\\s-*\\[TABLE-OF-CONTENTS\\]\\s-*</p>" nil t)
1013                 (re-search-forward
1014                  "\\[TABLE-OF-CONTENTS\\]" nil t))
1015             (progn
1016               (goto-char (match-beginning 0))
1017               (replace-match ""))
1018           (goto-char first-heading-pos)
1019           (when (looking-at "\\s-*</p>")
1020             (goto-char (match-end 0))
1021             (insert "\n")))
1022         (insert "<div id=\"table-of-contents\">\n")
1023         (mapc 'insert thetoc)
1024         (insert "</div>\n"))
1025       ;; remove empty paragraphs and lists
1026       (goto-char (point-min))
1027       (while (re-search-forward "<p>[ \r\n\t]*</p>" nil t)
1028         (replace-match ""))
1029       (goto-char (point-min))
1030       (while (re-search-forward "<li>[ \r\n\t]*</li>\n?" nil t)
1031         (replace-match ""))
1032       (goto-char (point-min))
1033       (while (re-search-forward "</ul>\\s-*<ul>\n?" nil t)
1034         (replace-match ""))
1035       ;; Convert whitespace place holders
1036       (goto-char (point-min))
1037       (let (beg end n)
1038         (while (setq beg (next-single-property-change (point) 'org-whitespace))
1039           (setq n (get-text-property beg 'org-whitespace)
1040                 end (next-single-property-change beg 'org-whitespace))
1041           (goto-char beg)
1042           (delete-region beg end)
1043           (insert (format "<span style=\"visibility:hidden;\">%s</span>"
1044                           (make-string n ?x)))))
1045       ;; Remove empty lines at the beginning of the file.
1046       (goto-char (point-min))
1047       (when (looking-at "\\s-+\n") (replace-match ""))
1048       ;; Remove display properties
1049       (remove-text-properties (point-min) (point-max) '(display t))
1050       ;; Run the hook
1051       (run-hooks 'org-export-html-final-hook)
1052       (or to-buffer (save-buffer))
1053       (goto-char (point-min))
1054       (or (org-export-push-to-kill-ring "HTML")
1055           (message "Exporting... done"))
1056       (if (eq to-buffer 'string)
1057           (prog1 (buffer-substring (point-min) (point-max))
1058             (kill-buffer (current-buffer)))
1059         (current-buffer)))))
1060
1061 ;;;_. Footers
1062 ;;;_ , Provides
1063
1064 (provide 'org2blog/for-org-html)
1065
1066 ;;;_ * Local emacs vars.
1067 ;;;_  + Local variables:
1068 ;;;_  + mode: allout
1069 ;;;_  + End:
1070
1071 ;;;_ , End
1072 ;;; org2blog/for-org-html.el ends here