emacs: lisp/textmodes/org.el comparison

comparison lisp/textmodes/org.el @ 65243:d0087dcb8981

(org-special-keyword): New face. (org-table-copy-down, org-table-eval-formula) (org-table-recalculate, org-init-section-numbers): Use `string-to-number' instead of `string-to-int'. (org-get-location): Use `insert-buffer-substring' instead of `insert-buffer'. (org-modify-diary-entry-string): New function. (org-get-entries-from-diary): Set the hook for `add-to-diary-list'. (org-disable-agenda-to-diary): renamed from `org-disable-diary'. (org-toggle-fixed-width-section): Use QUOTE keyword if there is no active region. (org-export-as-html): Handle QUOTE keyword. (org-quote-string): New option. (org-bookmark-jump-unhide): New function, used for `bookmark-after-jump-hook'. (org-diary-default-entry): Apply only when not called through `org-agenda'.

author	Carsten Dominik <dominik@science.uva.nl>
date	Tue, 30 Aug 2005 12:06:14 +0000
parents	5b1a238fcbb4
children	a95981ee377b

comparison

equal deleted inserted replaced

-:5ebb62612b85
+:d0087dcb8981
-;; org.el --- Outline-based notes management and organizer
+;;; org.el --- Outline-based notes management and organizer
 ;; Carstens outline-mode for keeping track of everything.
+;; Copyright (c) 2004, 2005 Free Software Foundation
-;; 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
+;; Version: 3.15
 ;;
 ;; This file is part of GNU Emacs.
 ;;
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 ;; Org-mode, you can read the same text online as HTML.  There is also an
 ;; excellent reference card made by Philip Rooke.
 ;;
 ;; 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.
 ;;    - Named fields and columns in tables.
 ;;    - Fixed bug with calling `org-archive' several times in a row.
 (require 'time-date)
 (require 'easymenu)
 ;;; Customization variables
-(defvar org-version "3.14"
+(defvar org-version "3.15"
 "The version number of the file org.el.")
 (defun org-version ()
 (interactive)
 (message "Org-mode version %s" org-version))
 (defcustom org-comment-string "COMMENT"
 "Entries starting with this keyword will never be exported.
 An entry can be toggled between COMMENT and normal with
 \\[org-toggle-comment].
 Changes become only effective after restarting Emacs."
+: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.
 (((class color) (background dark)) (:foreground "LightSalmon"))
 (t (:italic t)))
 "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))
 (((class color) (background dark)) (:foreground "Red1" :bold t))
 ;    (((class color) (background dark)) (:foreground "Pink" :bold t))
 	 (list
 	  '(org-activate-links (0 'org-link))
 	  '(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 "\\[#[A-Z]\\]") '(0 'org-special-keyword t))
-	  (list (concat "\\<" org-deadline-string) '(0 'org-warning t))
+;	  (list (concat "\\<" org-deadline-string) '(0 'org-warning t))
-	  (list (concat "\\<" org-scheduled-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 "\\)\\>")
+;	  (list (concat "^\\*+[ \t]*\\<\\(" org-comment-string "\\)\\>")
-		'(1 'org-warning t))
+;		'(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 "\\)\\(.*\\)\\>")
 		    '(1 'org-done t) '(2 'org-headline-done t))
 	    (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\>")
 	(with-output-to-temp-buffer "*Help*"
 	  (princ help))
 	(shrink-window-if-larger-than-buffer (get-buffer-window "*Help*"))
 	(setq buffer-read-only nil)
 	(erase-buffer)
-	(insert-buffer buf)
+	(insert-buffer-substring buf)
 	(let ((org-startup-truncated t)
 	      (org-startup-folded t)
 	      (org-startup-with-deadline-check nil))
 	  (org-mode))
 	(setq buffer-read-only t)
 (and (eolp) (not (bolp)) (backward-char 1))
 (if (and org-agenda-follow-mode
 	   (get-text-property (point) 'org-marker))
 (org-agenda-show)))
-(defvar org-disable-diary nil)          ;Dynamically-scoped param.
+(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."
 (let* ((fancy-diary-buffer "*temporary-fancy-diary-buffer*")
 	 (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-diary t))
+	 (org-disable-agenda-to-diary t))
 (save-excursion
 (save-window-excursion
 	(list-diary-entries date 1)))
 (if (not (get-buffer fancy-diary-buffer))
 	(setq entries nil)
 (replace-match ""))
 (goto-char (point-min))
 (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
+;; Make sure entries from the diary have the right text properties.
-;; 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)
+'(if (boundp 'diary-modify-entry-list-string-function)
-"Make the position visible."
+;; We can rely on the hook, nothing to do
-(if (and org-disable-diary  ;; called from org-agenda
+nil
-	      (stringp string)
+;; Hook not avaiable, must use advice to make this work
-	      (buffer-file-name))
+(defadvice add-to-diary-list (before org-mark-diary-entry activate)
-	 (add-text-properties
+"Make the position visible."
-	  0 (length string)
+(if (and org-disable-agenda-to-diary  ;; called from org-agenda
-	  (list 'mouse-face 'highlight
+		(stringp string)
-		'keymap org-agenda-keymap
+		(buffer-file-name))
-		'help-echo
+	   (setq string (org-modify-diary-entry-string string))))))
-		(format
-		 "mouse-2 or RET jump to diary file %s"
+(defun org-modify-diary-entry-string (string)
-		 (abbreviate-file-name (buffer-file-name)))
+"Add text properties to string, allowing org-mode to act on it."
-		'org-agenda-diary-link t
+(add-text-properties
-		'org-marker (org-agenda-new-marker (point-at-bol)))
+0 (length string)
-	  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
-(condition-case nil
+(when org-disable-agenda-to-diary
-(add-to-diary-list original-date "Org-mode dummy" "")
+(condition-case nil
-(error
+	(add-to-diary-list original-date "Org-mode dummy" "")
-(add-to-diary-list original-date  "Org-mode dummy" "" nil))))
+(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'.
 These are the files which are being checked for agenda entries.
 Optional argument FILE means, use this file instead of the current.
 		    (list entry)
 		  org-agenda-files))
 	 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))
+(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)))
-(concat (org-finalize-agenda-entries results) "\n")))
+(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'.
 FILE is the path to a file to be checked for entries.  DATE is date like
 the one returned by `calendar-current-date'.  ARGS are symbols indicating
 		      (throw 'exit (match-string 1))))))))
 (if txt
 	(progn
 	  (if (and org-table-copy-increment
 		   (string-match "^[0-9]+$" txt))
-	      (setq txt (format "%d" (+ (string-to-int txt) 1))))
+	      (setq txt (format "%d" (+ (string-to-number txt) 1))))
 	  (insert txt)
 	  (org-table-maybe-recalculate-line)
 	  (org-table-align))
 (error "No non-empty field found"))))
 	(* 1.0 (+ h (/ m 60.0) (/ s 3600.0)))))
 ((equal n 0)                             nil)
 (t n))))
 (defun org-table-get-vertical-vector (desc &optional tbeg col)
-"Get a calc vector from a column, according to descriptor DESC.
+"Get a calc vector from a column, accorting to desctiptor DESC.
-Optional arguments TBEG and COL can give the beginning of the table
+Optional arguments TBEG and COL can give the beginning of the table and
-and the current column, to avoid unnecessary parsing."
+the current column, to avoid unnecessary parsing."
 (save-excursion
 (or tbeg (setq tbeg (org-table-begin)))
 (or col (setq col (org-table-current-column)))
 (let (beg end nn n n1 n2 l (thisline (org-current-line)) hline-list)
 (cond
 		     (lambda (x) (setq x (org-trim x))
 		       (if (equal x "") "0" x))
 		     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))))))))
 (defvar org-table-formula-history nil)
 (defun org-table-modify-formulas (action &rest columns)
 "Modify the formulas stored below the current table.
 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)
 (cond
 ((null list))   ; No action needed if there are no stored formulas
 (while (re-search-forward "^[ \t]*| *\\([_^]\\) *\\(|.*\\)" end t)
 	(setq c (match-string 1)
 	      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)))
 	  (setq v (pop fields1) col (1+ col))
 	  (when (and (stringp field) (stringp v)
 (setq ndown (1- ndown))
 (setq form (copy-sequence formula))
 ;; 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))
+		    (string-to-number (match-string 1 form))
 		  n0)
 	      x (nth (1- n) fields))
 	(unless x (error "Invalid field specifier \"%s\""
 			 (match-string 0 form)))
 	(if (equal x "") (setq x "0"))
 			  (setq cnt (1+ cnt))))
 	(setq org-last-recalc-line (org-current-line))
 	(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-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)
 (or noalign (and org-table-may-need-update (org-table-align))
 	(and all (message "Re-applying formulas to %d lines...done" cnt)))
 (erase-buffer)
 (fundamental-mode)
 (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")
 (put-text-property 0 (length s) 'face 'font-lock-comment-face s)
 (insert s)
 (message "Named field, column %d of line %d" (nth 2 e) (nth 1 e)))
 ((setq e (assoc var org-table-column-names))
 (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))
 	    (message "Named column (column %s)" (cdr e)))
 	(error "Column name not found"))
 (unless (org-at-table-p)
 (error "Lost table position - cannot install formulae"))
 (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."))))
 (defun org-abort-edit-formulas ()
 "Abort editing formulas, without installing the changes."
 	  ;; Make sure we are first in minor-mode-map-alist
 	  (let ((c (assq 'orgtbl-mode minor-mode-map-alist)))
 	    (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))
+	  (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)
 	       auto-fill-inhibit-regexp)
 	  (set (make-local-variable 'auto-fill-inhibit-regexp)
 (and (string-match "#\\+CATEGORY" s)
 	 (setq s (substring s 0 (match-beginning 0))))
 (insert s)))
 (defun org-toggle-fixed-width-section (arg)
-"Toggle the fixed-width indicator at the beginning of lines in the region.
+"Toggle the fixed-width export.
-If there is no active region, only acts on the current line.
+If there is no active region, the QUOTE keyword at the current headline is
-If the first non-white character in the first line of the region is a
+inserted or removed.  When present, it causes the text between this headline
-vertical bar \"|\", then the command removes the bar from all lines in
+and the next to be exported as fixed-width text, and unmodified.
-the region.  If the first character is not a bar, the command adds a
+If there is an active region, this command adds or removes a colon as the
-bar to all lines, in the column given by the beginning of the region.
+first character of this line.  If the first character of a line is a colon,
+this line is also exported in fixed-width font."
-If there is a numerical prefix ARG, create ARG new lines starting with \"|\"."
 (interactive "P")
 (let* ((cc 0)
 	 (regionp (org-region-active-p))
 	 (beg (if regionp (region-beginning) (point)))
 	 (end (if regionp (region-end)))
 	 (nlines (or arg (if (and beg end) (count-lines beg end) 1)))
 	 (re "[ \t]*\\(:\\)")
 	 off)
-(save-excursion
+(if regionp
-(goto-char beg)
+	(save-excursion
-(setq cc (current-column))
+	  (goto-char beg)
-(beginning-of-line 1)
+	  (setq cc (current-column))
-(setq off (looking-at re))
+	  (beginning-of-line 1)
-(while (> nlines 0)
+	  (setq off (looking-at re))
-	(setq nlines (1- nlines))
+	  (while (> nlines 0)
-	(beginning-of-line 1)
+	    (setq nlines (1- nlines))
-	(cond
+	    (beginning-of-line 1)
-	 (arg
+	    (cond
-	  (move-to-column cc t)
+	     (arg
-	  (insert ":\n")
+	      (move-to-column cc t)
-	  (forward-line -1))
+	      (insert ":\n")
-	 ((and off (looking-at re))
+	      (forward-line -1))
-	  (replace-match "" t t nil 1))
+	     ((and off (looking-at re))
-	 ((not off) (move-to-column cc t) (insert ":")))
+	      (replace-match "" t t nil 1))
-	(forward-line 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.
 If there is an active region, export only the region.
 The prefix ARG specifies how many levels of the outline should become
 (interactive "P")
 (setq-default org-todo-line-regexp org-todo-line-regexp)
 (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
+(region
-	  (buffer-substring
+(buffer-substring
-	   (if region-p (region-beginning) (point-min))
+(if region-p (region-beginning) (point-min))
-	   (if region-p (region-end) (point-max))))
+(if region-p (region-end) (point-max))))
-	 (all_lines
+(all_lines
-	  (org-skip-comments (org-split-string region "[\r\n]")))
+(org-skip-comments (org-split-string region "[\r\n]")))
-	 (lines (org-export-find-first-heading-line all_lines))
+(lines (org-export-find-first-heading-line all_lines))
-	 (level 0) (line "") (origline "") txt todo
+(level 0) (line "") (origline "") txt todo
-	 (umax nil)
+(umax nil)
-	 (filename (concat (file-name-sans-extension (buffer-file-name))
+(filename (concat (file-name-sans-extension (buffer-file-name))
-			   ".html"))
+".html"))
-	 (buffer (find-file-noselect filename))
+(buffer (find-file-noselect filename))
-	 (levels-open (make-vector org-level-max nil))
+(levels-open (make-vector org-level-max nil))
-	 (date  (format-time-string "%Y/%m/%d" (current-time)))
+	 (date (format-time-string "%Y/%m/%d" (current-time)))
 	 (time  (format-time-string "%X" (current-time)))
-	 (author      user-full-name)
+(author      user-full-name)
 	 (title       (buffer-name))
-	 (options     nil)
+(options     nil)
+	 (quote-re    (concat "^\\*+[ \t]*" org-quote-string "\\>"))
+	 (inquote     nil)
 	 (email       user-mail-address)
-	 (language    org-export-default-language)
+(language    org-export-default-language)
 	 (text        nil)
-	 (lang-words  nil)
+(lang-words  nil)
 	 (head-count  0) cnt
 	 (start       0)
 	 table-open type
 	 table-buffer table-orig-buffer
 	 )
 (org-init-section-numbers)
 ;; 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)))
+(assoc "en" org-export-language-setup)))
 ;; Switch to the output buffer
 (if (or hidden (not org-export-html-show-new-buffer))
-	(set-buffer 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))
+org-export-headline-levels))
 ;; File header
 (insert (format
-	       "<html lang=\"%s\"><head>
+"<html lang=\"%s\"><head>
 <title>%s</title>
 <meta http-equiv=\"Content-Type\" content=\"text/html\">
 <meta name=generator content=\"Org-mode\">
 <meta name=generated content=\"%s %s\">
 <meta name=author content=\"%s\">
 </head><body>
 "
-	 language (org-html-expand title) date time author))
+	       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 "\">&lt;"
-				  email "&gt;</a>\n")))
+email "&gt;</a>\n")))
 (if (or author email) (insert "<br>\n"))
 (if (and date time) (insert (concat (nth 2 lang-words) ": "
-					  date " " time "<br>\n")))
+date " " time "<br>\n")))
 (if text      (insert (concat "<p>\n" (org-html-expand text))))
 (if org-export-with-toc
 	  (progn
 	    (insert (format "<H2>%s</H2>\n" (nth 3 lang-words)))
 	    (insert "<ul>\n")
 	      (setq org-last-level (1- org-last-level))
 	      (insert "</ul>\n"))
 	    ))
 (setq head-count 0)
 (org-init-section-numbers)
 (while (setq line (pop lines) origline line)
-	;; Protect the links
+	;; end of quote?
-	(setq start 0)
+	(when (and inquote (string-match "^\\*+" line))
-	(while (string-match org-link-maybe-angles-regexp line start)
+	  (insert "</pre>\n")
-	  (setq start (match-end 0))
+	  (setq inquote nil))
-	  (setq line (replace-match
+	;; inquote
-		      (concat "\000" (match-string 1 line) "\000")
+	(if inquote
-		      t t line)))
-	;; replace "<" and ">" by "&lt;" and "&gt;"
-	;; handle @<..> HTML tags (replace "@&gt;..&lt;" 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)))
+	      (insert line "\n")
-		(while (string-match " " l)
+	      (setq line (org-html-expand line))) ;;????? FIXME: not needed?
-		  (setq l (replace-match "&nbsp;" t t l)))
-		(insert "\n<span style='font-family:Courier'>"
+	  ;; Protect the links
-			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)
+	  (while (string-match org-link-maybe-angles-regexp line start)
-	    (setq start (- (match-end 0) 2))
+	    (setq start (match-end 0))
-	    (setq type (match-string 1 line))
+	    (setq line (replace-match
+			(concat "\000" (match-string 1 line) "\000")
+			t t line)))
+	  ;; replace "<" and ">" by "&lt;" and "&gt;"
+	  ;; handle @<..> HTML tags (replace "@&gt;..&lt;" 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 "&nbsp;" 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\">&lt;\\1:\\2&gt;</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>&lt;\\1:\\2&gt;</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
-	     ((member type '("http" "https" "ftp" "mailto" "news"))
+	     ((string-match "^\\(\\*+\\)[ \t]*\\(.*\\)" line)
-	      ;; standard URL
+	      ;; This is a headline
-	      (setq line (replace-match
+	      (setq level (- (match-end 1) (match-beginning 1))
-;                          "<a href=\"\\1:\\2\">&lt;\\1:\\2&gt;</a>"
+		    txt (match-string 2 line))
-			  "<a href=\"\\1:\\2\">\\1:\\2</a>"
+	      (if (<= level umax) (setq head-count (+ head-count 1)))
-			  nil nil line)))
+	      (org-html-level-start level txt umax
-	     ((string= type "file")
+				    (and org-export-with-toc (<= level umax))
-	      ;; FILE link
+				    head-count)
-	      (let* ((filename (match-string 2 line))
+	      ;; QUOTES
-		     (abs-p (file-name-absolute-p filename))
+	      (when (string-match quote-re line)
-		     (thefile (if abs-p (expand-file-name filename) filename))
+		(insert "<pre>")
-		     (thefile (save-match-data
+		(setq inquote t)))
-				(if (string-match ":[0-9]+$" thefile)
-				    (replace-match "" t t thefile)
+	     ((and org-export-with-tables
-				  thefile)))
+		   (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line))
-		     (file-is-image-p
+	      (if (not table-open)
-		      (save-match-data
+		  ;; New table starts
-			(string-match (org-image-file-name-regexp) thefile))))
+		  (setq table-open t table-buffer nil table-orig-buffer nil))
-		(setq line (replace-match
+	      ;; Accumulate lines
-			    (if (and org-export-html-inline-images
+	      (setq table-buffer (cons line table-buffer)
-				     file-is-image-p)
+		    table-orig-buffer (cons origline table-orig-buffer))
-				(concat "<img src=\"" thefile "\"/>")
+	      (when (or (not lines)
-			      (concat "<a href=\"" thefile "\">\\1:\\2</a>"))
+			(not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)"
-			    nil nil line))))
+					   (car lines))))
+		(setq table-open nil
-	     ((member type '("bbdb" "vm" "wl" "rmail" "gnus" "shell"))
+		      table-buffer (nreverse table-buffer)
-	      (setq line (replace-match
+		      table-orig-buffer (nreverse table-orig-buffer))
-			  "<i>&lt;\\1:\\2&gt;</i>" nil nil line)))))
+		(insert (org-format-table-html table-buffer table-orig-buffer))))
+	     (t
-	  ;; TODO items
+	      ;; Normal lines
-	  (if (and (string-match org-todo-line-regexp line)
+	      ;; Lines starting with "-", and empty lines make new paragraph.
-		   (match-beginning 2))
+	      ;; FIXME: Should we add + and *?
-	      (if (equal (match-string 2 line) org-done-string)
+	      (if (string-match "^ *-\\|^[ \t]*$" line) (insert "<p>"))
-		  (setq line (replace-match
+	      (insert line (if org-export-preserve-breaks "<br>\n" "\n"))))
-			      "<span style='color:green'>\\2</span>"
+	    )))
-			      nil nil line 2))
+	(if org-export-html-with-timestamp
-		(setq line (replace-match "<span style='color:red'>\\2</span>"
+	    (insert org-export-html-html-helper-timestamp))
-					  nil nil line 2))))
+	(insert "</body>\n</html>\n")
+	(normal-mode)
-	  ;; DEADLINES
+	(save-buffer)
-	  (if (string-match org-deadline-line-regexp line)
+	(goto-char (point-min)))))
-	      (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."
 (if (string-match "^[ \t]*|" (car lines))
 ;; A normal org table
 	  (aset org-section-numbers i 0)
 	(setq number-string (or (car numbers) "0"))
 	(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)))
+	    (aset org-section-numbers i (string-to-number number-string)))
 	(pop numbers))
 (setq i (1- i)))))
 (defun org-section-number (&optional level)
 "Return a string with the current section number.
 "#?[ \t]*\\+\\("
 (mapconcat 'regexp-quote kwds "\\|")
 "\\):[ \t]*"
 (if org-noutline-p "\\(.+\\)" "\\([^\n\r]+\\)")))
-;; Advise the bookmark-jump function to make jump position visible
+;; Make `bookmark-jump' show the jump location if it was hidden.
-;; Wrapped into eval-after-load to avoid loading advice unnecessarily
 (eval-after-load "bookmark"
-'(defadvice bookmark-jump (after org-make-visible activate)
+'(if (boundp 'bookmark-after-jump-hook)
-"Make the position visible."
+;; We can use the hook
-(and (eq major-mode 'org-mode)
+(add-hook 'bookmark-after-jump-hook 'org-bookmark-jump-unhide)
-	  (org-invisible-p)
+;; Hook not available, use advice
-	  (org-show-hierarchy-above))))
+(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
 (provide 'org)

Mercurial > emacs

comparison lisp/textmodes/org.el @ 65243:d0087dcb8981