diff --git a/ChangeLog b/ChangeLog index 6ea7b88af..62543c2b1 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,28 @@ +2008-04-13 Carsten Dominik + + * lisp/org-exp.el (org-export-preprocess-string): Renamed-from + `org-cleaned-string-for-export'. + + * lisp/org-export-latex.el (org-export-latex-preprocess): Renamed + from `org-export-latex-cleaned-string'. + + * lisp/org-exp.el (org-export-html-style): Made target class look + like normal text. + (org-export-as-html): Make use of the better proprocessing in + `org-cleaned-string-for-export'. + + * lisp/org.el (org-store-link): Link to headline when there is not + target and no region in an org-mode buffer when creating a link. + + * lisp/org-exp.el (org-cleaned-string-for-export): Better + treatment of heuristic targets, many more internal links will now + work in HTML export. + +2008-04-12 Carsten Dominik + + * lisp/org.el (org-link-types-re): New variable. + (org-make-link-regexps): Compute `org-link-types-re'. + 2008-04-10 Carsten Dominik * lisp/org-clock.el (org-dblock-write:clocktable): Fixed bug with diff --git a/ORGWEBPAGE/Changes.org b/ORGWEBPAGE/Changes.org index 10c3745f3..4953a7980 100644 --- a/ORGWEBPAGE/Changes.org +++ b/ORGWEBPAGE/Changes.org @@ -89,6 +89,13 @@ in Org. However, there are also monay bug fixes and new features. For details see the documentation provided by Sebastian Rose together with org-info.js. +*** Export of internal links to HTML + + The export of internal links to html now works a lot better. + Most internal links that work while editing an Org file + inside Emacs will now also work the the corresponding HTML + file. + *** Improvements to clocktable - The clocktable is now much more flexible and user friendly diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 61e654267..0a069d717 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -486,7 +486,7 @@ Needs to be set before org.el is loaded." :group 'org-agenda-startup :type 'boolean) -(defconst org-agenda-include-inactive-timestamps nil +(defvar org-agenda-include-inactive-timestamps nil "Non-nil means, include inactive time stamps in agenda and timeline.") (defgroup org-agenda-windows nil diff --git a/lisp/org-exp.el b/lisp/org-exp.el index c1ec833a0..aa23ae02c 100644 --- a/lisp/org-exp.el +++ b/lisp/org-exp.el @@ -32,7 +32,7 @@ (eval-and-compile (require 'cl)) -(declare-function org-export-latex-cleaned-string "org-export-latex" ()) +(declare-function org-export-latex-preprocess "org-export-latex" ()) (declare-function org-agenda-skip "org-agenda" ()) (declare-function org-infojs-options-inbuffer-template "org-infojs" ()) @@ -437,7 +437,7 @@ Org-mode file." .timestamp { color: grey } .timestamp-kwd { color: CadetBlue } .tag { background-color:lightblue; font-weight:normal } - .target { background-color: lavender; } + .target { } pre { border: 1pt solid #AEBDCC; background-color: #F3F5F7; @@ -1103,8 +1103,12 @@ translations. There is currently no way for users to extend this.") ;;; General functions for all backends -(defun org-cleaned-string-for-export (string &rest parameters) - "Cleanup a buffer STRING so that links can be created safely." +(defun org-export-preprocess-string (string &rest parameters) + "Cleanup STRING so that that the true exported has a more consistent source. +This function takes STRING, which should be a buffer-string of an org-file +to export. It then creates a temporary buffer where it does its job. +The result is then again returned as a string, and the exporter works +on this string to produce the exported version." (interactive) (let* ((re-radio (and org-target-link-regexp (concat "\\([^<]\\)\\(" org-target-link-regexp "\\)"))) @@ -1122,12 +1126,15 @@ translations. There is currently no way for users to extend this.") (drawers org-drawers) (exp-drawers (plist-get parameters :drawers)) (outline-regexp "\\*+ ") + target-alist tmp target level a b xx rtn p) (with-current-buffer (get-buffer-create " org-mode-tmp") (erase-buffer) (insert string) ;; Remove license-to-kill stuff + ;; The caller markes some stuff fo killing, stuff that has been + ;; used to create the page title, for example. (while (setq p (text-property-any (point-min) (point-max) :org-license-to-kill t)) (delete-region p (next-single-property-change p :org-license-to-kill))) @@ -1171,11 +1178,36 @@ translations. There is currently no way for users to extend this.") b (org-end-of-subtree t)) (if (> b a) (delete-region a b))))) + ;; Find all headings and compute the targets for them + (goto-char (point-min)) + (org-init-section-numbers) + (while (re-search-forward org-outline-regexp nil t) + (setq level (org-reduced-level + (save-excursion (goto-char (point-at-bol)) + (org-outline-level)))) + (setq target (org-solidify-link-text + (format "sec-%s" (org-section-number level)))) + (push (cons target target) target-alist) + (add-text-properties + (point-at-bol) (point-at-eol) + (list 'target target))) + ;; Find targets in comments and move them out of comments, ;; but mark them as targets that should be invisible (goto-char (point-min)) - (while (re-search-forward "^#.*?\\(<<\r\n]+>>>?\\).*" nil t) - (replace-match "\\1(INVISIBLE)")) + (while (re-search-forward "^#.*?\\(<<\r\n]+\\)>>>?\\).*" nil t) + ;; Check if the line before or after is a headline with a target + (if (setq target (or (get-text-property (point-at-bol 0) 'target) + (get-text-property (point-at-bol 2) 'target))) + (progn + ;; use the existing target in a neighboring line + (setq tmp (match-string 2)) + (replace-match "") + (and (looking-at "\n") (delete-char 1)) + (push (cons (org-solidify-link-text tmp) target) + target-alist)) + ;; Make an invisible target + (replace-match "\\1(INVISIBLE)"))) ;; Protect backend specific stuff, throw away the others. (let ((formatters @@ -1249,7 +1281,7 @@ translations. There is currently no way for users to extend this.") ;; Specific LaTeX stuff (when latexp (require 'org-export-latex nil) - (org-export-latex-cleaned-string)) + (org-export-latex-preprocess)) (when asciip (org-export-ascii-clean-string)) @@ -1288,7 +1320,43 @@ translations. There is currently no way for users to extend this.") (replace-match "\\1 \\3") (goto-char (match-beginning 0)))) + ;; Find all internal links. If they have a fuzzy match (i.e. not + ;; a *dedicated* target match, let the link point to the + ;; correspinding section. + (goto-char (point-min)) + (while (re-search-forward org-bracket-link-regexp nil t) + (org-if-unprotected + (let* ((md (match-data)) + (desc (match-end 2)) + (link (org-link-unescape (match-string 1))) + (slink (org-solidify-link-text link)) + found props pos + (target + (or (cdr (assoc slink target-alist)) + (save-excursion + (unless (string-match org-link-types-re link) + (setq found (condition-case nil (org-link-search link) + (error nil))) + (when (and found + (or (org-on-heading-p) + (not (eq found 'dedicated)))) + (or (get-text-property (point) 'target) + (get-text-property + (max (point-min) + (1- (previous-single-property-change + (point) 'target))) + 'target)))))))) + (when target + (set-match-data md) + (goto-char (match-beginning 1)) + (setq props (text-properties-at (point))) + (delete-region (match-beginning 1) (match-end 1)) + (setq pos (point)) + (insert target) + (unless desc (insert "][" link)) + (add-text-properties pos (point) props))))) + ;; Normalize links: Convert angle and plain links into bracket links ;; Expand link abbreviations (goto-char (point-min)) @@ -1373,7 +1441,7 @@ translations. There is currently no way for users to extend this.") (let* ((rtn (mapconcat 'identity - (org-split-string s "[ \t\r\n]+") "--")) + (org-split-string s "[ \t\r\n]+") "==")) (a (assoc rtn alist))) (or (cdr a) rtn)))) @@ -1497,7 +1565,7 @@ underlined headlines. The default is 3." (if (org-region-active-p) (region-beginning) (point-min)) (if (org-region-active-p) (region-end) (point-max)))) (lines (org-split-string - (org-cleaned-string-for-export + (org-export-preprocess-string region :for-ascii t :skip-before-1st-heading @@ -2118,7 +2186,6 @@ PUB-DIR is set, use this as the publishing directory." (email (plist-get opt-plist :email)) (language (plist-get opt-plist :language)) (lang-words nil) - (target-alist nil) tg (head-count 0) cnt (start 0) (coding-system (and (boundp 'buffer-file-coding-system) @@ -2137,7 +2204,7 @@ PUB-DIR is set, use this as the publishing directory." (if region-p (region-end) (point-max)))) (lines (org-split-string - (org-cleaned-string-for-export + (org-export-preprocess-string region :emph-multiline t :for-html t @@ -2281,14 +2348,10 @@ lang=\"%s\" xml:lang=\"%s\"> (push "\n" thetoc)) (push "\n" thetoc))) ;; Check for targets - (while (string-match org-target-regexp line) - (setq tg (match-string 1 line) - line (replace-match - (concat "@" tg "@ ") - t t line)) - (push (cons (org-solidify-link-text tg) - (format "sec-%s" snumber)) - target-alist)) + (while (string-match org-any-target-regexp line) + (setq line (replace-match + (concat "@" (match-string 1 line) "@ ") + t t line))) (while (string-match "<\\(<\\)+\\|>\\(>\\)+" txt) (setq txt (replace-match "" t t txt))) (push @@ -2409,7 +2472,7 @@ lang=\"%s\" xml:lang=\"%s\"> (concat "" desc ""))) ((member type '("http" "https")) ;; standard URL, just check if we need to inline an image @@ -3184,7 +3247,9 @@ stacked delimiters is N. Escaping delimiters is not possible." "Insert a new level in HTML export. When TITLE is nil, just close all open levels." (org-close-par-maybe) - (let ((l org-level-max) snumber) + (let ((target (and title (org-get-text-property-any 0 'target title))) + (l org-level-max) + snumber) (while (>= l level) (if (aref org-levels-open (1- l)) (progn @@ -3211,10 +3276,15 @@ When TITLE is nil, just close all open levels." (if (aref org-levels-open (1- level)) (progn (org-close-li) - (insert "
  • " title "
    \n")) + (if target + (insert (format "
  • " target) title "
    \n") + (insert "
  • " title "
    \n"))) (aset org-levels-open (1- level) t) (org-close-par-maybe) - (insert "
      \n
    • " title "
      \n"))) + (if target + (insert (format "
        \n
      • " target) + title "
        \n") + (insert "
          \n
        • " title "
          \n")))) (aset org-levels-open (1- level) t) (setq snumber (org-section-number level)) (if (and org-export-with-section-numbers (not body-only)) @@ -3225,6 +3295,11 @@ When TITLE is nil, just close all open levels." snumber level level snumber title level snumber)) (org-open-par))))) +(defun org-get-text-property-any (pos prop &optional object) + (or (get-text-property pos prop object) + (and (setq pos (next-single-property-change pos prop object)) + (get-text-property pos prop object)))) + (defun org-html-level-close (level max-outline-level) "Terminate one level in HTML export." (if (<= level max-outline-level) diff --git a/lisp/org-export-latex.el b/lisp/org-export-latex.el index 75d2799ad..d19d61038 100644 --- a/lisp/org-export-latex.el +++ b/lisp/org-export-latex.el @@ -410,7 +410,7 @@ when PUB-DIR is set, use this as the publishing directory." (if region-p (region-beginning) (point-min)) (if region-p (region-end) (point-max)))) (string-for-export - (org-cleaned-string-for-export + (org-export-preprocess-string region :emph-multiline t :for-LaTeX t :comments nil @@ -682,7 +682,7 @@ formatting string like %%%%s if we want to comment them out." (goto-char (match-beginning 0)) (goto-char (point-max))))) (org-export-latex-content - (org-cleaned-string-for-export + (org-export-preprocess-string (buffer-substring (point-min) end) :for-LaTeX t :emph-multiline t @@ -1080,7 +1080,7 @@ Regexps are those from `org-export-latex-special-string-regexps'." (defvar org-latex-entities) ; defined below -(defun org-export-latex-cleaned-string () +(defun org-export-latex-preprocess () "Clean stuff in the LaTeX export." ;; Preserve line breaks diff --git a/lisp/org.el b/lisp/org.el index f4fdc2164..ba4c8ec95 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -3101,6 +3101,8 @@ The following commands are available: (defconst org-non-link-chars "]\t\n\r<>") (defvar org-link-types '("http" "https" "ftp" "mailto" "file" "news" "shell" "elisp")) +(defvar org-link-types-re nil + "Matches a link that has a url-like prefix like \"http:\"") (defvar org-link-re-with-space nil "Matches a link with spaces, optional angular brackets around it.") (defvar org-link-re-with-space2 nil @@ -3125,7 +3127,10 @@ Here is what the match groups contain after a match: (defun org-make-link-regexps () "Update the link regular expressions. This should be called after the variable `org-link-types' has changed." - (setq org-link-re-with-space + (setq org-link-types-re + (concat + "\\`\\(" (mapconcat 'identity org-link-types "\\|") "\\):") + org-link-re-with-space (concat ">") nil t) - (setq pos (match-beginning 0)))) + (setq type 'dedicated + pos (match-beginning 0)))) ;; There is an exact target for this (goto-char pos)) ((string-match "^/\\(.*\\)/$" s) @@ -6849,17 +6855,21 @@ in all files. If AVOID-POS is given, ignore matches near that position." '(face nil mouse-face nil keymap nil fontified nil) s) ;; Make a series of regular expressions to find a match (setq words (org-split-string s "[ \n\r\t]+") + re0 (concat "\\(<<" (regexp-quote s0) ">>\\)") re2 (concat markers "\\(" (mapconcat 'downcase words "[ \t]+") "\\)" markers) - re2a (concat "[ \t\r\n]\\(" (mapconcat 'downcase words "[ \t\r\n]+") "\\)[ \t\r\n]") - re4 (concat "[^a-zA-Z_]\\(" (mapconcat 'downcase words "[^a-zA-Z_\r\n]+") "\\)[^a-zA-Z_]") + re2a_ (concat "\\(" (mapconcat 'downcase words "[ \t\r\n]+") "\\)[ \t\r\n]") + re2a (concat "[ \t\r\n]" re2a_) + re4_ (concat "\\(" (mapconcat 'downcase words "[^a-zA-Z_\r\n]+") "\\)[^a-zA-Z_]") + re4 (concat "[^a-zA-Z_]" re4_) + re1 (concat pre re2 post) - re3 (concat pre re4 post) + re3 (concat pre (if pre re4_ re4) post) re5 (concat pre ".*" re4) re2 (concat pre re2) - re2a (concat pre re2a) - re4 (concat pre re4) + re2a (concat pre (if pre re2a_ re2a)) + re4 (concat pre (if pre re4_ re4)) reall (concat "\\(" re0 "\\)\\|\\(" re1 "\\)\\|\\(" re2 "\\)\\|\\(" re3 "\\)\\|\\(" re4 "\\)\\|\\(" re5 "\\)" @@ -6868,7 +6878,8 @@ in all files. If AVOID-POS is given, ignore matches near that position." ((eq type 'org-occur) (org-occur reall)) ((eq type 'occur) (org-do-occur (downcase reall) 'cleanup)) (t (goto-char (point-min)) - (if (or (org-search-not-self 1 re0 nil t) + (setq type 'fuzzy) + (if (or (and (org-search-not-self 1 re0 nil t) (setq type 'dedicated)) (org-search-not-self 1 re1 nil t) (org-search-not-self 1 re2 nil t) (org-search-not-self 1 re2a nil t) @@ -6885,7 +6896,8 @@ in all files. If AVOID-POS is given, ignore matches near that position." (if (search-forward s nil t) (goto-char (match-beginning 0)) (error "No match")))) - (and (org-mode-p) (org-show-context 'link-search)))) + (and (org-mode-p) (org-show-context 'link-search)) + type)) (defun org-search-not-self (group &rest args) "Execute `re-search-forward', but only accept matches that do not