for-org-html.el

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