Index: emacs/lisp/textmodes/org.el diff -c emacs/lisp/textmodes/org.el:1.33 emacs/lisp/textmodes/org.el:1.34 *** emacs/lisp/textmodes/org.el:1.33 Sat Aug 6 17:41:14 2005 --- emacs/lisp/textmodes/org.el Tue Aug 30 12:06:14 2005 *************** *** 1,12 **** ! ;; org.el --- Outline-based notes management and organizer ;; Carstens outline-mode for keeping track of everything. ! ! ;; Copyright (C) 2004, 2005 Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik <dominik at science dot uva dot nl> ;; Keywords: outlines, hypermedia, calendar ;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/ ! ;; Version: 3.14 ;; ;; This file is part of GNU Emacs. ;; --- 1,11 ---- ! ;;; org.el --- Outline-based notes management and organizer ;; Carstens outline-mode for keeping track of everything. ! ;; Copyright (c) 2004, 2005 Free Software Foundation ;; ;; Author: Carsten Dominik <dominik at science dot uva dot nl> ;; Keywords: outlines, hypermedia, calendar ;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/ ! ;; Version: 3.15 ;; ;; This file is part of GNU Emacs. ;; *************** *** 81,86 **** --- 80,92 ---- ;; ;; Changes: ;; ------- + ;; Version 3.15 + ;; - QUOTE keyword at the beginning of an entry causes fixed-width export + ;; of unmodified entry text. `C-c :' toggles this keyword. + ;; - New face `org-special-keyword' which is used for COMMENT, QUOTE, + ;; DEADLINE and SCHEDULED, and priority cookies. Default is only a weak + ;; color, to reduce the amount of aggressive color in the buffer. + ;; ;; Version 3.14 ;; - Formulas for individual fields in table. ;; - Automatic recalculation in calculating tables. *************** *** 189,195 **** ;;; Customization variables ! (defvar org-version "3.14" "The version number of the file org.el.") (defun org-version () (interactive) --- 195,201 ---- ;;; Customization variables ! (defvar org-version "3.15" "The version number of the file org.el.") (defun org-version () (interactive) *************** *** 388,393 **** --- 394,408 ---- :group 'org-keywords :type 'string) + (defcustom org-quote-string "QUOTE" + "Entries starting with this keyword will be exported in fixed-width font. + Quoting applies only to the text in the entry following the headline, and does + not extend beyond the next headline, even if that is lower level. + An entry can be toggled between QUOTE and normal with + \\[org-toggle-fixed-width-section]" + :group 'org-keywords + :type 'string) + (defcustom org-after-todo-state-change-hook nil "Hook which is run after the state of a TODO item was changed. The new state (a string with a todo keyword, or nil) is available in the *************** *** 1593,1598 **** --- 1608,1621 ---- "Face used for level 8 headlines." :group 'org-faces) + (defface org-special-keyword ;; font-lock-string-face + '((((type tty) (class color)) (:foreground "green")) + (((class color) (background light)) (:foreground "RosyBrown")) + (((class color) (background dark)) (:foreground "LightSalmon")) + (t (:italic t))) + "Face used for level 8 headlines." + :group 'org-faces) + (defface org-warning ;; font-lock-warning-face '((((type tty) (class color)) (:foreground "red")) (((class color) (background light)) (:foreground "Red" :bold t)) *************** *** 1919,1935 **** '(org-activate-dates (0 'org-link)) (list (concat "^\\*+[ \t]*" org-not-done-regexp) '(1 'org-warning t)) ! (list (concat "\\[#[A-Z]\\]") '(0 'org-warning t)) ! (list (concat "\\<" org-deadline-string) '(0 'org-warning t)) ! (list (concat "\\<" org-scheduled-string) '(0 'org-warning t)) ;; '("\\(\\s-\\|^\\)\\(\\*\\([a-zA-Z]+\\)\\*\\)\\([^a-zA-Z*]\\|$\\)" ;; (3 'bold)) ;; '("\\(\\s-\\|^\\)\\(/\\([a-zA-Z]+\\)/\\)\\([^a-zA-Z*]\\|$\\)" ;; (3 'italic)) ;; '("\\(\\s-\\|^\\)\\(_\\([a-zA-Z]+\\)_\\)\\([^a-zA-Z*]\\|$\\)" ;; (3 'underline)) ! (list (concat "^\\*+[ \t]*\\<\\(" org-comment-string "\\)\\>") ! '(1 'org-warning t)) '("^#.*" (0 'font-lock-comment-face t)) (if org-fontify-done-headline (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\(.*\\)\\>") --- 1942,1963 ---- '(org-activate-dates (0 'org-link)) (list (concat "^\\*+[ \t]*" org-not-done-regexp) '(1 'org-warning t)) ! (list (concat "\\[#[A-Z]\\]") '(0 'org-special-keyword t)) ! ; (list (concat "\\<" org-deadline-string) '(0 'org-warning t)) ! ; (list (concat "\\<" org-scheduled-string) '(0 'org-warning t)) ! (list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t)) ! (list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t)) ;; '("\\(\\s-\\|^\\)\\(\\*\\([a-zA-Z]+\\)\\*\\)\\([^a-zA-Z*]\\|$\\)" ;; (3 'bold)) ;; '("\\(\\s-\\|^\\)\\(/\\([a-zA-Z]+\\)/\\)\\([^a-zA-Z*]\\|$\\)" ;; (3 'italic)) ;; '("\\(\\s-\\|^\\)\\(_\\([a-zA-Z]+\\)_\\)\\([^a-zA-Z*]\\|$\\)" ;; (3 'underline)) ! ; (list (concat "^\\*+[ \t]*\\<\\(" org-comment-string "\\)\\>") ! ; '(1 'org-warning t)) ! (list (concat "^\\*+[ \t]*\\<\\(" org-comment-string ! "\\|" org-quote-string "\\)\\>") ! '(1 'org-special-keyword t)) '("^#.*" (0 'font-lock-comment-face t)) (if org-fontify-done-headline (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\(.*\\)\\>") *************** *** 2216,2222 **** (shrink-window-if-larger-than-buffer (get-buffer-window "*Help*")) (setq buffer-read-only nil) (erase-buffer) ! (insert-buffer buf) (let ((org-startup-truncated t) (org-startup-folded t) (org-startup-with-deadline-check nil)) --- 2244,2250 ---- (shrink-window-if-larger-than-buffer (get-buffer-window "*Help*")) (setq buffer-read-only nil) (erase-buffer) ! (insert-buffer-substring buf) (let ((org-startup-truncated t) (org-startup-folded t) (org-startup-with-deadline-check nil)) *************** *** 4013,4019 **** (get-text-property (point) 'org-marker)) (org-agenda-show))) ! (defvar org-disable-diary nil) ;Dynamically-scoped param. (defun org-get-entries-from-diary (date) "Get the (Emacs Calendar) diary entries for DATE." --- 4041,4047 ---- (get-text-property (point) 'org-marker)) (org-agenda-show))) ! (defvar org-disable-agenda-to-diary nil) ;Dynamically-scoped param. (defun org-get-entries-from-diary (date) "Get the (Emacs Calendar) diary entries for DATE." *************** *** 4021,4028 **** (diary-display-hook '(fancy-diary-display)) (list-diary-entries-hook (cons 'org-diary-default-entry list-diary-entries-hook)) entries ! (org-disable-diary t)) (save-excursion (save-window-excursion (list-diary-entries date 1))) --- 4049,4058 ---- (diary-display-hook '(fancy-diary-display)) (list-diary-entries-hook (cons 'org-diary-default-entry list-diary-entries-hook)) + (diary-file-name-prefix-function nil) ; turn this feature off + (diary-modify-entry-list-string-function 'org-modify-diary-entry-string) entries ! (org-disable-agenda-to-diary t)) (save-excursion (save-window-excursion (list-diary-entries date 1))) *************** *** 4076,4110 **** (if (re-search-forward "^Org-mode dummy\n?" nil t) (replace-match ""))) ! ;; Advise the add-to-diary-list function to allow org to jump to ! ;; diary entries. Wrapped into eval-after-load to avoid loading ! ;; advice unnecessarily (eval-after-load "diary-lib" ! '(defadvice add-to-diary-list (before org-mark-diary-entry activate) ! "Make the position visible." ! (if (and org-disable-diary ;; called from org-agenda ! (stringp string) ! (buffer-file-name)) ! (add-text-properties ! 0 (length string) ! (list 'mouse-face 'highlight ! 'keymap org-agenda-keymap ! 'help-echo ! (format ! "mouse-2 or RET jump to diary file %s" ! (abbreviate-file-name (buffer-file-name))) ! 'org-agenda-diary-link t ! 'org-marker (org-agenda-new-marker (point-at-bol))) ! string)))) (defun org-diary-default-entry () "Add a dummy entry to the diary. Needed to avoid empty dates which mess up holiday display." ;; Catch the error if dealing with the new add-to-diary-alist ! (condition-case nil ! (add-to-diary-list original-date "Org-mode dummy" "") ! (error ! (add-to-diary-list original-date "Org-mode dummy" "" nil)))) (defun org-add-file (&optional file) "Add current file to the list of files in variable `org-agenda-files'. --- 4106,4148 ---- (if (re-search-forward "^Org-mode dummy\n?" nil t) (replace-match ""))) ! ;; Make sure entries from the diary have the right text properties. (eval-after-load "diary-lib" ! '(if (boundp 'diary-modify-entry-list-string-function) ! ;; We can rely on the hook, nothing to do ! nil ! ;; Hook not avaiable, must use advice to make this work ! (defadvice add-to-diary-list (before org-mark-diary-entry activate) ! "Make the position visible." ! (if (and org-disable-agenda-to-diary ;; called from org-agenda ! (stringp string) ! (buffer-file-name)) ! (setq string (org-modify-diary-entry-string string)))))) ! ! (defun org-modify-diary-entry-string (string) ! "Add text properties to string, allowing org-mode to act on it." ! (add-text-properties ! 0 (length string) ! (list 'mouse-face 'highlight ! 'keymap org-agenda-keymap ! 'help-echo ! (format ! "mouse-2 or RET jump to diary file %s" ! (abbreviate-file-name (buffer-file-name))) ! 'org-agenda-diary-link t ! 'org-marker (org-agenda-new-marker (point-at-bol))) ! string) ! string) (defun org-diary-default-entry () "Add a dummy entry to the diary. Needed to avoid empty dates which mess up holiday display." ;; Catch the error if dealing with the new add-to-diary-alist ! (when org-disable-agenda-to-diary ! (condition-case nil ! (add-to-diary-list original-date "Org-mode dummy" "") ! (error ! (add-to-diary-list original-date "Org-mode dummy" "" nil))))) (defun org-add-file (&optional file) "Add current file to the list of files in variable `org-agenda-files'. *************** *** 4238,4248 **** file rtn results) ;; If this is called during org-agenda, don't return any entries to ;; the calendar. Org Agenda will list these entries itself. ! (if org-disable-diary (setq files nil)) (while (setq file (pop files)) (setq rtn (apply 'org-agenda-get-day-entries file date args)) (setq results (append results rtn))) ! (concat (org-finalize-agenda-entries results) "\n"))) (defun org-agenda-get-day-entries (file date &rest args) "Does the work for `org-diary' and `org-agenda'. --- 4276,4287 ---- file rtn results) ;; If this is called during org-agenda, don't return any entries to ;; the calendar. Org Agenda will list these entries itself. ! (if org-disable-agenda-to-diary (setq files nil)) (while (setq file (pop files)) (setq rtn (apply 'org-agenda-get-day-entries file date args)) (setq results (append results rtn))) ! (if results ! (concat (org-finalize-agenda-entries results) "\n")))) (defun org-agenda-get-day-entries (file date &rest args) "Does the work for `org-diary' and `org-agenda'. *************** *** 6270,6276 **** (progn (if (and org-table-copy-increment (string-match "^[0-9]+$" txt)) ! (setq txt (format "%d" (+ (string-to-int txt) 1)))) (insert txt) (org-table-maybe-recalculate-line) (org-table-align)) --- 6309,6315 ---- (progn (if (and org-table-copy-increment (string-match "^[0-9]+$" txt)) ! (setq txt (format "%d" (+ (string-to-number txt) 1)))) (insert txt) (org-table-maybe-recalculate-line) (org-table-align)) *************** *** 6997,7005 **** (t n)))) (defun org-table-get-vertical-vector (desc &optional tbeg col) ! "Get a calc vector from a column, according to descriptor DESC. ! Optional arguments TBEG and COL can give the beginning of the table ! and the current column, to avoid unnecessary parsing." (save-excursion (or tbeg (setq tbeg (org-table-begin))) (or col (setq col (org-table-current-column))) --- 7036,7044 ---- (t n)))) (defun org-table-get-vertical-vector (desc &optional tbeg col) ! "Get a calc vector from a column, accorting to desctiptor DESC. ! Optional arguments TBEG and COL can give the beginning of the table and ! the current column, to avoid unnecessary parsing." (save-excursion (or tbeg (setq tbeg (org-table-begin))) (or col (setq col (org-table-current-column))) *************** *** 7047,7053 **** l ",") "]")) ((string-match "\\([0-9]+\\)" desc) (beginning-of-line 1) ! (when (re-search-backward org-table-dataline-regexp tbeg t (string-to-number (match-string 0 desc))) (org-table-goto-column col) (org-trim (org-table-get-field)))))))) --- 7086,7092 ---- l ",") "]")) ((string-match "\\([0-9]+\\)" desc) (beginning-of-line 1) ! (when (re-search-backward org-table-dataline-regexp tbeg t (string-to-number (match-string 0 desc))) (org-table-goto-column col) (org-trim (org-table-get-field)))))))) *************** *** 7143,7149 **** ACTION can be `remove', `insert', `swap'. For `swap', two column numbers are expected, for the other action only a single column number is needed." (let ((list (org-table-get-stored-formulas)) ! (nmax (length (org-split-string (buffer-substring (point-at-bol) (point-at-eol)) "|"))) col col1 col2 scol si sc1 sc2) --- 7182,7188 ---- ACTION can be `remove', `insert', `swap'. For `swap', two column numbers are expected, for the other action only a single column number is needed." (let ((list (org-table-get-stored-formulas)) ! (nmax (length (org-split-string (buffer-substring (point-at-bol) (point-at-eol)) "|"))) col col1 col2 scol si sc1 sc2) *************** *** 7222,7228 **** fields (org-split-string (match-string 2) " *| *")) (save-excursion (beginning-of-line (if (equal c "_") 2 0)) ! (setq line (org-current-line) col 1) (and (looking-at "^[ \t]*|[^|]*\\(|.*\\)") (setq fields1 (org-split-string (match-string 1) " *| *")))) (while (and fields1 (setq field (pop fields))) --- 7261,7267 ---- fields (org-split-string (match-string 2) " *| *")) (save-excursion (beginning-of-line (if (equal c "_") 2 0)) ! (setq line (org-current-line) col 1) (and (looking-at "^[ \t]*|[^|]*\\(|.*\\)") (setq fields1 (org-split-string (match-string 1) " *| *")))) (while (and fields1 (setq field (pop fields))) *************** *** 7440,7446 **** ;; Insert the references to fields in same row (while (string-match "\\$\\([0-9]+\\)?" form) (setq n (if (match-beginning 1) ! (string-to-int (match-string 1 form)) n0) x (nth (1- n) fields)) (unless x (error "Invalid field specifier \"%s\"" --- 7479,7485 ---- ;; Insert the references to fields in same row (while (string-match "\\$\\([0-9]+\\)?" form) (setq n (if (match-beginning 1) ! (string-to-number (match-string 1 form)) n0) x (nth (1- n) fields)) (unless x (error "Invalid field specifier \"%s\"" *************** *** 7539,7545 **** (setq eql eqlnum) (while (setq entry (pop eql)) (goto-line org-last-recalc-line) ! (org-table-goto-column (string-to-int (car entry)) nil 'force) (org-table-eval-formula nil (cdr entry) 'noalign 'nocst 'nostore)))) (goto-line thisline) (org-table-goto-column thiscol) --- 7578,7584 ---- (setq eql eqlnum) (while (setq entry (pop eql)) (goto-line org-last-recalc-line) ! (org-table-goto-column (string-to-number (car entry)) nil 'force) (org-table-eval-formula nil (cdr entry) 'noalign 'nocst 'nostore)))) (goto-line thisline) (org-table-goto-column thiscol) *************** *** 7622,7628 **** (set (make-local-variable 'org-pos) pos) (set (make-local-variable 'org-window-configuration) wc) (use-local-map org-edit-formulas-map) ! (setq s "# Edit formulas and finish with `C-c C-c'. # Use `C-u C-c C-c' to also appy them immediately to the entire table. # Use `C-c ?' to get information about $name at point. # To cancel editing, press `C-c C-q'.\n") --- 7661,7667 ---- (set (make-local-variable 'org-pos) pos) (set (make-local-variable 'org-window-configuration) wc) (use-local-map org-edit-formulas-map) ! (setq s "# Edit formulas and finish with `C-c C-c'. # Use `C-u C-c C-c' to also appy them immediately to the entire table. # Use `C-c ?' to get information about $name at point. # To cancel editing, press `C-c C-q'.\n") *************** *** 7660,7666 **** (switch-to-buffer-other-window (marker-buffer pos)) (goto-char pos) (goto-char (org-table-begin)) ! (if (re-search-forward (concat "^[ \t]*| *! *.*?| *\\(" var "\\) *|") (org-table-end) t) (progn (goto-char (match-beginning 1)) --- 7699,7705 ---- (switch-to-buffer-other-window (marker-buffer pos)) (goto-char pos) (goto-char (org-table-begin)) ! (if (re-search-forward (concat "^[ \t]*| *! *.*?| *\\(" var "\\) *|") (org-table-end) t) (progn (goto-char (match-beginning 1)) *************** *** 7715,7721 **** (org-table-store-formulas eql) (move-marker pos nil) (kill-buffer "*Edit Formulas*") ! (if arg (org-table-recalculate 'all) (message "New formulas installed - press C-u C-c C-c to apply.")))) --- 7754,7760 ---- (org-table-store-formulas eql) (move-marker pos nil) (kill-buffer "*Edit Formulas*") ! (if arg (org-table-recalculate 'all) (message "New formulas installed - press C-u C-c C-c to apply.")))) *************** *** 7801,7807 **** (and c (setq minor-mode-map-alist (cons c (delq c minor-mode-map-alist))))) (set (make-local-variable (quote org-table-may-need-update)) t) ! (make-local-hook (quote before-change-functions)) (add-hook 'before-change-functions 'org-before-change-function nil 'local) (set (make-local-variable 'org-old-auto-fill-inhibit-regexp) --- 7840,7846 ---- (and c (setq minor-mode-map-alist (cons c (delq c minor-mode-map-alist))))) (set (make-local-variable (quote org-table-may-need-update)) t) ! (make-local-hook (quote before-change-functions)) ; needed for XEmacs (add-hook 'before-change-functions 'org-before-change-function nil 'local) (set (make-local-variable 'org-old-auto-fill-inhibit-regexp) *************** *** 8620,8633 **** (insert s))) (defun org-toggle-fixed-width-section (arg) ! "Toggle the fixed-width indicator at the beginning of lines in the region. ! If there is no active region, only acts on the current line. ! If the first non-white character in the first line of the region is a ! vertical bar \"|\", then the command removes the bar from all lines in ! the region. If the first character is not a bar, the command adds a ! bar to all lines, in the column given by the beginning of the region. ! ! If there is a numerical prefix ARG, create ARG new lines starting with \"|\"." (interactive "P") (let* ((cc 0) (regionp (org-region-active-p)) --- 8659,8671 ---- (insert s))) (defun org-toggle-fixed-width-section (arg) ! "Toggle the fixed-width export. ! If there is no active region, the QUOTE keyword at the current headline is ! inserted or removed. When present, it causes the text between this headline ! and the next to be exported as fixed-width text, and unmodified. ! If there is an active region, this command adds or removes a colon as the ! first character of this line. If the first character of a line is a colon, ! this line is also exported in fixed-width font." (interactive "P") (let* ((cc 0) (regionp (org-region-active-p)) *************** *** 8636,8658 **** (nlines (or arg (if (and beg end) (count-lines beg end) 1))) (re "[ \t]*\\(:\\)") off) ! (save-excursion ! (goto-char beg) ! (setq cc (current-column)) ! (beginning-of-line 1) ! (setq off (looking-at re)) ! (while (> nlines 0) ! (setq nlines (1- nlines)) ! (beginning-of-line 1) ! (cond ! (arg ! (move-to-column cc t) ! (insert ":\n") ! (forward-line -1)) ! ((and off (looking-at re)) ! (replace-match "" t t nil 1)) ! ((not off) (move-to-column cc t) (insert ":"))) ! (forward-line 1))))) (defun org-export-as-html-and-open (arg) "Export the outline as HTML and immediately open it with a browser. --- 8674,8706 ---- (nlines (or arg (if (and beg end) (count-lines beg end) 1))) (re "[ \t]*\\(:\\)") off) ! (if regionp ! (save-excursion ! (goto-char beg) ! (setq cc (current-column)) ! (beginning-of-line 1) ! (setq off (looking-at re)) ! (while (> nlines 0) ! (setq nlines (1- nlines)) ! (beginning-of-line 1) ! (cond ! (arg ! (move-to-column cc t) ! (insert ":\n") ! (forward-line -1)) ! ((and off (looking-at re)) ! (replace-match "" t t nil 1)) ! ((not off) (move-to-column cc t) (insert ":"))) ! (forward-line 1))) ! (save-excursion ! (org-back-to-heading) ! (if (looking-at (concat outline-regexp ! "\\( +\\<" org-quote-string "\\>\\)")) ! (replace-match "" t t nil 1) ! (if (looking-at outline-regexp) ! (progn ! (goto-char (match-end 0)) ! (insert " " org-quote-string)))))))) (defun org-export-as-html-and-open (arg) "Export the outline as HTML and immediately open it with a browser. *************** *** 8681,8708 **** (setq-default org-deadline-line-regexp org-deadline-line-regexp) (setq-default org-done-string org-done-string) (let* ((region-p (org-region-active-p)) ! (region ! (buffer-substring ! (if region-p (region-beginning) (point-min)) ! (if region-p (region-end) (point-max)))) ! (all_lines ! (org-skip-comments (org-split-string region "[\r\n]"))) ! (lines (org-export-find-first-heading-line all_lines)) ! (level 0) (line "") (origline "") txt todo ! (umax nil) ! (filename (concat (file-name-sans-extension (buffer-file-name)) ! ".html")) ! (buffer (find-file-noselect filename)) ! (levels-open (make-vector org-level-max nil)) ! (date (format-time-string "%Y/%m/%d" (current-time))) (time (format-time-string "%X" (current-time))) ! (author user-full-name) (title (buffer-name)) ! (options nil) (email user-mail-address) ! (language org-export-default-language) (text nil) ! (lang-words nil) (head-count 0) cnt (start 0) table-open type --- 8729,8758 ---- (setq-default org-deadline-line-regexp org-deadline-line-regexp) (setq-default org-done-string org-done-string) (let* ((region-p (org-region-active-p)) ! (region ! (buffer-substring ! (if region-p (region-beginning) (point-min)) ! (if region-p (region-end) (point-max)))) ! (all_lines ! (org-skip-comments (org-split-string region "[\r\n]"))) ! (lines (org-export-find-first-heading-line all_lines)) ! (level 0) (line "") (origline "") txt todo ! (umax nil) ! (filename (concat (file-name-sans-extension (buffer-file-name)) ! ".html")) ! (buffer (find-file-noselect filename)) ! (levels-open (make-vector org-level-max nil)) ! (date (format-time-string "%Y/%m/%d" (current-time))) (time (format-time-string "%X" (current-time))) ! (author user-full-name) (title (buffer-name)) ! (options nil) ! (quote-re (concat "^\\*+[ \t]*" org-quote-string "\\>")) ! (inquote nil) (email user-mail-address) ! (language org-export-default-language) (text nil) ! (lang-words nil) (head-count 0) cnt (start 0) table-open type *************** *** 8716,8737 **** ;; Search for the export key lines (org-parse-key-lines) (setq lang-words (or (assoc language org-export-language-setup) ! (assoc "en" org-export-language-setup))) ;; Switch to the output buffer (if (or hidden (not org-export-html-show-new-buffer)) ! (set-buffer buffer) (switch-to-buffer-other-window buffer)) (erase-buffer) (fundamental-mode) (let ((case-fold-search nil)) (if options (org-parse-export-options options)) (setq umax (if arg (prefix-numeric-value arg) ! org-export-headline-levels)) ;; File header (insert (format ! "<html lang=\"%s\"><head> <title>%s</title> <meta http-equiv=\"Content-Type\" content=\"text/html\"> <meta name=generator content=\"Org-mode\"> --- 8766,8787 ---- ;; Search for the export key lines (org-parse-key-lines) (setq lang-words (or (assoc language org-export-language-setup) ! (assoc "en" org-export-language-setup))) ;; Switch to the output buffer (if (or hidden (not org-export-html-show-new-buffer)) ! (set-buffer buffer) (switch-to-buffer-other-window buffer)) (erase-buffer) (fundamental-mode) (let ((case-fold-search nil)) (if options (org-parse-export-options options)) (setq umax (if arg (prefix-numeric-value arg) ! org-export-headline-levels)) ;; File header (insert (format ! "<html lang=\"%s\"><head> <title>%s</title> <meta http-equiv=\"Content-Type\" content=\"text/html\"> <meta name=generator content=\"Org-mode\"> *************** *** 8739,8753 **** <meta name=author content=\"%s\"> </head><body> " ! language (org-html-expand title) date time author)) (if title (insert (concat "<H1 align=\"center\">" (org-html-expand title) "</H1>\n"))) (if author (insert (concat (nth 1 lang-words) ": " author "\n"))) (if email (insert (concat "<a href=\"mailto:"; email "\"><" ! email "></a>\n"))) (if (or author email) (insert "<br>\n")) (if (and date time) (insert (concat (nth 2 lang-words) ": " ! date " " time "<br>\n"))) (if text (insert (concat "<p>\n" (org-html-expand text)))) (if org-export-with-toc (progn --- 8789,8803 ---- <meta name=author content=\"%s\"> </head><body> " ! language (org-html-expand title) date time author)) (if title (insert (concat "<H1 align=\"center\">" (org-html-expand title) "</H1>\n"))) (if author (insert (concat (nth 1 lang-words) ": " author "\n"))) (if email (insert (concat "<a href=\"mailto:"; email "\"><" ! email "></a>\n"))) (if (or author email) (insert "<br>\n")) (if (and date time) (insert (concat (nth 2 lang-words) ": " ! date " " time "<br>\n"))) (if text (insert (concat "<p>\n" (org-html-expand text)))) (if org-export-with-toc (progn *************** *** 8802,8925 **** )) (setq head-count 0) (org-init-section-numbers) (while (setq line (pop lines) origline line) ! ;; Protect the links ! (setq start 0) ! (while (string-match org-link-maybe-angles-regexp line start) ! (setq start (match-end 0)) ! (setq line (replace-match ! (concat "\000" (match-string 1 line) "\000") ! t t line))) ! ! ;; replace "<" and ">" by "<" and ">" ! ;; handle @<..> HTML tags (replace "@>..<" by "<..>") ! (setq line (org-html-expand line)) ! ! ;; Verbatim lines ! (if (and org-export-with-fixed-width ! (string-match "^[ \t]*:\\(.*\\)" line)) (progn ! (let ((l (match-string 1 line))) ! (while (string-match " " l) ! (setq l (replace-match " " t t l))) ! (insert "\n<span style='font-family:Courier'>" ! l "</span>" ! (if (and lines ! (not (string-match "^[ \t]+\\(:.*\\)" ! (car lines)))) ! "<br>\n" "\n")))) (setq start 0) ! (while (string-match org-protected-link-regexp line start) ! (setq start (- (match-end 0) 2)) ! (setq type (match-string 1 line)) ! (cond ! ((member type '("http" "https" "ftp" "mailto" "news")) ! ;; standard URL ! (setq line (replace-match ! ; "<a href=\"\\1:\\2\"><\\1:\\2></a>" ! "<a href=\"\\1:\\2\">\\1:\\2</a>" ! nil nil line))) ! ((string= type "file") ! ;; FILE link ! (let* ((filename (match-string 2 line)) ! (abs-p (file-name-absolute-p filename)) ! (thefile (if abs-p (expand-file-name filename) filename)) ! (thefile (save-match-data ! (if (string-match ":[0-9]+$" thefile) ! (replace-match "" t t thefile) ! thefile))) ! (file-is-image-p ! (save-match-data ! (string-match (org-image-file-name-regexp) thefile)))) (setq line (replace-match ! (if (and org-export-html-inline-images ! file-is-image-p) ! (concat "<img src=\"" thefile "\"/>") ! (concat "<a href=\"" thefile "\">\\1:\\2</a>")) ! nil nil line)))) ! ! ((member type '("bbdb" "vm" "wl" "rmail" "gnus" "shell")) ! (setq line (replace-match ! "<i><\\1:\\2></i>" nil nil line))))) ! ! ;; TODO items ! (if (and (string-match org-todo-line-regexp line) ! (match-beginning 2)) ! (if (equal (match-string 2 line) org-done-string) (setq line (replace-match ! "<span style='color:green'>\\2</span>" ! nil nil line 2)) ! (setq line (replace-match "<span style='color:red'>\\2</span>" ! nil nil line 2)))) ! ;; DEADLINES ! (if (string-match org-deadline-line-regexp line) ! (progn ! (if (save-match-data ! (string-match "<a href" ! (substring line 0 (match-beginning 0)))) ! nil ; Don't do the replacement - it is inside a link ! (setq line (replace-match "<span style='color:red'>\\&</span>" ! nil nil line 1))))) ! (cond ! ((string-match "^\\(\\*+\\)[ \t]*\\(.*\\)" line) ! ;; This is a headline ! (setq level (- (match-end 1) (match-beginning 1)) ! txt (match-string 2 line)) ! (if (<= level umax) (setq head-count (+ head-count 1))) ! (org-html-level-start level txt umax ! (and org-export-with-toc (<= level umax)) ! head-count)) ! ! ((and org-export-with-tables ! (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line)) ! (if (not table-open) ! ;; New table starts ! (setq table-open t table-buffer nil table-orig-buffer nil)) ! ;; Accumulate lines ! (setq table-buffer (cons line table-buffer) ! table-orig-buffer (cons origline table-orig-buffer)) ! (when (or (not lines) ! (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" ! (car lines)))) ! (setq table-open nil ! table-buffer (nreverse table-buffer) ! table-orig-buffer (nreverse table-orig-buffer)) ! (insert (org-format-table-html table-buffer table-orig-buffer)))) ! (t ! ;; Normal lines ! ;; Lines starting with "-", and empty lines make new paragraph. ! ;; FIXME: Should we add + and *? ! (if (string-match "^ *-\\|^[ \t]*$" line) (insert "<p>")) ! (insert line (if org-export-preserve-breaks "<br>\n" "\n")))) ! )) ! (if org-export-html-with-timestamp ! (insert org-export-html-html-helper-timestamp)) ! (insert "</body>\n</html>\n") ! (normal-mode) ! (save-buffer) ! (goto-char (point-min))))) (defun org-format-table-html (lines olines) "Find out which HTML converter to use and return the HTML code." --- 8852,8992 ---- )) (setq head-count 0) (org-init-section-numbers) + (while (setq line (pop lines) origline line) ! ;; end of quote? ! (when (and inquote (string-match "^\\*+" line)) ! (insert "</pre>\n") ! (setq inquote nil)) ! ;; inquote ! (if inquote (progn ! (insert line "\n") ! (setq line (org-html-expand line))) ;;????? FIXME: not needed? ! ! ;; Protect the links (setq start 0) ! (while (string-match org-link-maybe-angles-regexp line start) ! (setq start (match-end 0)) ! (setq line (replace-match ! (concat "\000" (match-string 1 line) "\000") ! t t line))) ! ! ;; replace "<" and ">" by "<" and ">" ! ;; handle @<..> HTML tags (replace "@>..<" by "<..>") ! (setq line (org-html-expand line)) ! ! ;; Verbatim lines ! (if (and org-export-with-fixed-width ! (string-match "^[ \t]*:\\(.*\\)" line)) ! (progn ! (let ((l (match-string 1 line))) ! (while (string-match " " l) ! (setq l (replace-match " " t t l))) ! (insert "\n<span style='font-family:Courier'>" ! l "</span>" ! (if (and lines ! (not (string-match "^[ \t]+\\(:.*\\)" ! (car lines)))) ! "<br>\n" "\n")))) ! ! (setq start 0) ! (while (string-match org-protected-link-regexp line start) ! (setq start (- (match-end 0) 2)) ! (setq type (match-string 1 line)) ! (cond ! ((member type '("http" "https" "ftp" "mailto" "news")) ! ;; standard URL (setq line (replace-match ! ; "<a href=\"\\1:\\2\"><\\1:\\2></a>" ! "<a href=\"\\1:\\2\">\\1:\\2</a>" ! nil nil line))) ! ((string= type "file") ! ;; FILE link ! (let* ((filename (match-string 2 line)) ! (abs-p (file-name-absolute-p filename)) ! (thefile (if abs-p (expand-file-name filename) filename)) ! (thefile (save-match-data ! (if (string-match ":[0-9]+$" thefile) ! (replace-match "" t t thefile) ! thefile))) ! (file-is-image-p ! (save-match-data ! (string-match (org-image-file-name-regexp) thefile)))) (setq line (replace-match ! (if (and org-export-html-inline-images ! file-is-image-p) ! (concat "<img src=\"" thefile "\"/>") ! (concat "<a href=\"" thefile "\">\\1:\\2</a>")) ! nil nil line)))) ! ((member type '("bbdb" "vm" "wl" "rmail" "gnus" "shell")) ! (setq line (replace-match ! "<i><\\1:\\2></i>" nil nil line))))) ! ;; TODO items ! (if (and (string-match org-todo-line-regexp line) ! (match-beginning 2)) ! (if (equal (match-string 2 line) org-done-string) ! (setq line (replace-match ! "<span style='color:green'>\\2</span>" ! nil nil line 2)) ! (setq line (replace-match "<span style='color:red'>\\2</span>" ! nil nil line 2)))) ! ! ;; DEADLINES ! (if (string-match org-deadline-line-regexp line) ! (progn ! (if (save-match-data ! (string-match "<a href" ! (substring line 0 (match-beginning 0)))) ! nil ; Don't do the replacement - it is inside a link ! (setq line (replace-match "<span style='color:red'>\\&</span>" ! nil nil line 1))))) ! ! ! (cond ! ((string-match "^\\(\\*+\\)[ \t]*\\(.*\\)" line) ! ;; This is a headline ! (setq level (- (match-end 1) (match-beginning 1)) ! txt (match-string 2 line)) ! (if (<= level umax) (setq head-count (+ head-count 1))) ! (org-html-level-start level txt umax ! (and org-export-with-toc (<= level umax)) ! head-count) ! ;; QUOTES ! (when (string-match quote-re line) ! (insert "<pre>") ! (setq inquote t))) ! ! ((and org-export-with-tables ! (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line)) ! (if (not table-open) ! ;; New table starts ! (setq table-open t table-buffer nil table-orig-buffer nil)) ! ;; Accumulate lines ! (setq table-buffer (cons line table-buffer) ! table-orig-buffer (cons origline table-orig-buffer)) ! (when (or (not lines) ! (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" ! (car lines)))) ! (setq table-open nil ! table-buffer (nreverse table-buffer) ! table-orig-buffer (nreverse table-orig-buffer)) ! (insert (org-format-table-html table-buffer table-orig-buffer)))) ! (t ! ;; Normal lines ! ;; Lines starting with "-", and empty lines make new paragraph. ! ;; FIXME: Should we add + and *? ! (if (string-match "^ *-\\|^[ \t]*$" line) (insert "<p>")) ! (insert line (if org-export-preserve-breaks "<br>\n" "\n")))) ! ))) ! (if org-export-html-with-timestamp ! (insert org-export-html-html-helper-timestamp)) ! (insert "</body>\n</html>\n") ! (normal-mode) ! (save-buffer) ! (goto-char (point-min))))) (defun org-format-table-html (lines olines) "Find out which HTML converter to use and return the HTML code." *************** *** 9229,9235 **** (if (string-match "\\`[A-Z]\\'" number-string) (aset org-section-numbers i (- (string-to-char number-string) ?A -1)) ! (aset org-section-numbers i (string-to-int number-string))) (pop numbers)) (setq i (1- i))))) --- 9296,9302 ---- (if (string-match "\\`[A-Z]\\'" number-string) (aset org-section-numbers i (- (string-to-char number-string) ?A -1)) ! (aset org-section-numbers i (string-to-number number-string))) (pop numbers)) (setq i (1- i))))) *************** *** 9998,10011 **** "\\):[ \t]*" (if org-noutline-p "\\(.+\\)" "\\([^\n\r]+\\)"))) ! ;; Advise the bookmark-jump function to make jump position visible ! ;; Wrapped into eval-after-load to avoid loading advice unnecessarily (eval-after-load "bookmark" ! '(defadvice bookmark-jump (after org-make-visible activate) ! "Make the position visible." ! (and (eq major-mode 'org-mode) ! (org-invisible-p) ! (org-show-hierarchy-above)))) ;;; Finish up --- 10065,10087 ---- "\\):[ \t]*" (if org-noutline-p "\\(.+\\)" "\\([^\n\r]+\\)"))) ! ;; Make `bookmark-jump' show the jump location if it was hidden. (eval-after-load "bookmark" ! '(if (boundp 'bookmark-after-jump-hook) ! ;; We can use the hook ! (add-hook 'bookmark-after-jump-hook 'org-bookmark-jump-unhide) ! ;; Hook not available, use advice ! (defadvice bookmark-jump (after org-make-visible activate) ! "Make the position visible." ! (org-bookmark-jump-unhide)))) ! ! (defun org-bookmark-jump-unhide () ! "Unhide the current position, to show the bookmark location." ! (and (eq major-mode 'org-mode) ! (or (org-invisible-p) ! (save-excursion (goto-char (max (point-min) (1- (point)))) ! (org-invisible-p))) ! (org-show-hierarchy-above))) ;;; Finish up
_______________________________________________ Emacs-diffs mailing list [email protected] http://lists.gnu.org/mailman/listinfo/emacs-diffs
