emacs: lisp/textmodes/org.el comparison

comparison lisp/textmodes/org.el @ 71096:d26859871d39

(org-agenda-highlight-todo): Make sure regexp does only match in the right place. (org-upcoming-deadline): New face. (org-agenda-get-deadlines): Use new face `org-upcoming-deadline'. (org-export-ascii-underline): Renamed and made an option (was constant `org-ascii-underline'). (org-export-ascii-bullets): New option. (org-export-as-html): Many changes to emit valid XHTML. (org-par-open): New variable. (org-open-par, org-close-par-maybe, org-close-li-maybe): New functions. (org-html-do-expand, org-section-number): Fixedcase in `replace-match'. (org-timeline): Pass `org-timeline-show-empty-dates' to `org-get-all-dates'. Interpret empty dates returned by `org-get-all-dates'. (org-get-all-dates): New argument EMPTY. Add dates without entries to the list, mark large ranges of empty dates. (org-point-in-group, org-context): New functions.

author	Carsten Dominik <dominik@science.uva.nl>
date	Tue, 30 May 2006 16:29:02 +0000
parents	971aad463b69
children	11ad1dbc7d45

comparison

equal deleted inserted replaced

-:92e88635d2f4
+:d26859871d39
 ;; Copyright (C) 2004, 2005, 2006 Free Software Foundation, Inc.
 ;;
 ;; Author: Carsten Dominik <dominik at science dot uva dot nl>
 ;; Keywords: outlines, hypermedia, calendar, wp
 ;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/
-;; Version: 4.34
+;; Version: 4.35
 ;;
 ;; 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
 ;; excellent reference card made by Philip Rooke.  This card can be found
 ;; in the etc/ directory of Emacs 22.
 ;;
 ;; Recent changes
 ;; --------------
+;; Version 4.35
+;;    - HTML export is now valid XHTML.
+;;    - Timeline can also show dates without entries.  See new option
+;;      `org-timeline-show-empty-dates'.
+;;    - The bullets created by the ASCII exporter can now be configured.
+;;      See the new option `org-export-ascii-bullets'.
+;;    - New face `org-upcoming-deadline' (was `org-scheduled-previously').
+;;    - New function `org-context' to allow testing for local context.
+;;
 ;; Version 4.34
 ;;    - Bug fixes.
 ;;
 ;; Version 4.33
 ;;    - New commands to move through plain lists: S-up and S-down.
 (require 'time-date)
 (require 'easymenu)
 ;;; Customization variables
-(defvar org-version "4.34"
+(defvar org-version "4.35"
 "The version number of the file org.el.")
 (defun org-version ()
 (interactive)
 (message "Org-mode version %s" org-version))
 (defcustom org-agenda-start-with-follow-mode nil
 "The initial value of follwo-mode in a newly created agenda window."
 :group 'org-agenda-setup
 :type 'boolean)
-(defcustom org-select-timeline-window t
-"Non-nil means, after creating a timeline, move cursor into Timeline window.
-When nil, cursor will remain in the current window."
-:group 'org-agenda-setup
-:type 'boolean)
 (defcustom org-select-agenda-window t
 "Non-nil means, after creating an agenda, move cursor into Agenda window.
 When nil, cursor will remain in the current window."
 :group 'org-agenda-setup
 :type 'boolean)
 (setq org-agenda-prefix-format \"  %-11:c% s\")
 See also the variables `org-agenda-remove-times-when-in-prefix' and
 `org-agenda-remove-tags-when-in-prefix'."
-:type 'string
-:group 'org-agenda-prefix)
-(defcustom org-timeline-prefix-format "  % s"
-"Like `org-agenda-prefix-format', but for the timeline of a single file."
 :type 'string
 :group 'org-agenda-prefix)
 (defvar org-prefix-format-compiled nil
 "The compiled version of the most recently used prefix format.
 :group 'org-agenda-prefix
 :type '(choice
 	  (const :tag "Always" t)
 	  (const :tag "Never" nil)
 	  (const :tag "When prefix format contains %T" prefix)))
+(defgroup org-agenda-timeline nil
+"Options concerning the timeline buffer in Org Mode."
+:tag "Org Agenda Timeline"
+:group 'org-agenda)
+(defcustom org-timeline-prefix-format "  % s"
+"Like `org-agenda-prefix-format', but for the timeline of a single file."
+:type 'string
+:group 'org-agenda-timeline)
+(defcustom org-select-timeline-window t
+"Non-nil means, after creating a timeline, move cursor into Timeline window.
+When nil, cursor will remain in the current window."
+:group 'org-agenda-timeline
+:type 'boolean)
+(defcustom org-timeline-show-empty-dates 3
+"Non-nil means, `org-timeline' also shows dates without an entry.
+When nil, only the days which actually have entries are shown.
+When t, all days between the first and the last date are shown.
+When an integer, show also empty dates, but if there is a gap of more than
+N days, just insert a special line indicating the size of the gap."
+:group 'org-agenda-timeline
+:type '(choice
+	  (const :tag "None" nil)
+	  (const :tag "All" t)
+	  (number :tag "at most")))
 (defgroup org-export nil
 "Options for exporting org-listings."
 :tag "Org Export"
 :group 'org)
 (defgroup org-export-ascii nil
 "Options specific for ASCII export of Org-mode files."
 :tag "Org Export ASCII"
 :group 'org-export)
+(defcustom org-export-ascii-underline '(?\$ ?\# ?^ ?\~ ?\= ?\-)
+"Characters for underlining headings in ASCII export.
+In the given sequence, these characters will be used for level 1, 2, ..."
+:group 'org-export-ascii
+:type '(repeat character))
+(defcustom org-export-ascii-bullets '(?* ?o ?-)
+"Bullet characters for headlines converted to lists in ASCII export.
+The first character is is used for the first lest level generated in this
+way, and so on.  If there are more levels than characters given here,
+the list will be repeated.
+Note that plain lists will keep the same bullets as the have in the
+Org-mode file."
+:group 'org-export-ascii
+:type '(repeat character))
 (defcustom org-export-ascii-show-new-buffer t
 "Non-nil means, popup buffer containing the exported ASCII text.
 Otherwise the buffer will just be saved to a file and stay hidden."
 :group 'org-export-ascii
 This option can also be set with the +OPTIONS line, e.g. \"@:nil\"."
 :group 'org-export-html
 :type 'boolean)
 (defcustom org-export-html-table-tag
-"<table border=1 cellspacing=0 cellpadding=6>"
+"<table border=\"1\" cellspacing=\"0\" cellpadding=\"6\">"
 "The HTML tag used to start a table.
 This must be a <table> tag, but you may change the options like
 borders and spacing."
 :group 'org-export-html
 :type 'string)
 into the exported HTML text.  Otherwise, the buffer will just be saved
 to a file."
 :group 'org-export-html
 :type 'boolean)
+;; FIXME: <br><br> is not pretty.
 (defcustom org-export-html-html-helper-timestamp
-"<br><br><hr><p><!-- hhmts start --> <!-- hhmts end -->\n"
+"<br/><br/><hr><p><!-- hhmts start --> <!-- hhmts end --></p>\n"
 "The HTML tag used as timestamp delimiter for HTML-helper-mode."
 :group 'org-export-html
 :type 'string)
 (defcustom org-export-html-show-new-buffer nil
 (((class color) (min-colors 8)  (background dark)) (:foreground "red" :bold t))
 (t (:bold t))))
 "Face for items scheduled previously, and not yet done."
 :group 'org-faces)
+(defface org-upcoming-deadline
+(org-compatible-face
+'((((class color) (min-colors 88) (background light)) (:foreground "Firebrick"))
+(((class color) (min-colors 88) (background dark)) (:foreground "chocolate1"))
+(((class color) (min-colors 8)  (background light)) (:foreground "red"))
+(((class color) (min-colors 8)  (background dark)) (:foreground "red" :bold t))
+(t (:bold t))))
+"Face for items scheduled previously, and not yet done."
+:group 'org-faces)
 (defface org-time-grid ;; font-lock-variable-name-face
 (org-compatible-face
 '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod"))
 (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod"))
 (((class color) (min-colors 8)) (:foreground "yellow" :weight light))))
 "Matches any of the TODO state keywords except the last one.")
 (make-variable-buffer-local 'org-not-done-regexp)
 (defvar org-todo-line-regexp nil
 "Matches a headline and puts TODO state into group 2 if present.")
 (make-variable-buffer-local 'org-todo-line-regexp)
+(defvar org-todo-line-tags-regexp nil
+"Matches a headline and puts TODO state into group 2 if present.
+Also put tags into group 4 if tags are present.")
+(make-variable-buffer-local 'org-todo-line-tags-regexp)
 (defvar org-nl-done-regexp nil
 "Matches newline followed by a headline with the DONE keyword.")
 (make-variable-buffer-local 'org-nl-done-regexp)
 (defvar org-looking-at-done-regexp nil
 "Matches the DONE keyword a point.")
 	  (concat "^\\(\\*+\\)[ \t]*\\("
 		  (mapconcat 'regexp-quote org-todo-keywords "\\|")
 		  "\\)? *\\(.*\\)")
 	  org-nl-done-regexp
 	  (concat "[\r\n]\\*+[ \t]+" org-done-string "\\>")
+	  org-todo-line-tags-regexp
+	  (concat "^\\(\\*+\\)[ \t]*\\("
+		  (mapconcat 'regexp-quote org-todo-keywords "\\|")
+		  "\\)? *\\(.*?\\([ \t]:[a-zA-Z0-9:_@]+:[ \t]*\\)?$\\)")
 	  org-looking-at-done-regexp (concat "^" org-done-string "\\>")
 	  org-deadline-regexp (concat "\\<" org-deadline-string)
 	  org-deadline-time-regexp
 	  (concat "\\<" org-deadline-string " *<\\([^>]+\\)>")
 	  org-deadline-line-regexp
 	 (win (selected-window))
 	 (pos1 (point))
 	 (beg (if (org-region-active-p) (region-beginning) (point-min)))
 	 (end (if (org-region-active-p) (region-end) (point-max)))
 	 (day-numbers (org-get-all-dates beg end 'no-ranges
-					 t doclosed)) ; always include today
+					 t doclosed ; always include today
+					 org-timeline-show-empty-dates))
 	 (today (time-to-days (current-time)))
 	 (org-respect-restriction t)
 	 (past t)
 	 args
-	 s e rtn d)
+	 s e rtn d emptyp)
 (setq org-agenda-redo-command
 	  (list 'progn
 		(list 'switch-to-buffer-other-window (current-buffer))
 		(list 'org-timeline (list 'quote include-all) t)))
 (if (not dopast)
 (set (make-local-variable 'org-agenda-type) 'timeline)
 (if doclosed (push :closed args))
 (push :timestamp args)
 (if dotodo (push :todo args))
 (while (setq d (pop day-numbers))
-(if (and (>= d today)
+(if (and (listp d) (eq (car d) :omitted))
-	       dopast
-	       past)
 	  (progn
-	    (setq past nil)
+	    (setq s (point))
-	    (insert (make-string 79 ?-) "\n")))
+	    (insert (format "\n[... %d empty days omitted]\n\n" (cdr d)))
-(setq date (calendar-gregorian-from-absolute d))
+	    (put-text-property s (1- (point)) 'face 'org-level-3))
-(setq s (point))
+	(if (listp d) (setq d (car d) emptyp t) (setq emptyp nil))
-(setq rtn (apply 'org-agenda-get-day-entries
+	(if (and (>= d today)
-		       entry date args))
+		 dopast
-(if (or rtn (equal d today))
+		 past)
-	  (progn
+	    (progn
-	    (insert (calendar-day-name date) " "
+	      (setq past nil)
-		    (number-to-string (extract-calendar-day date)) " "
+	      (insert (make-string 79 ?-) "\n")))
-		    (calendar-month-name (extract-calendar-month date)) " "
+	(setq date (calendar-gregorian-from-absolute d))
-		    (number-to-string (extract-calendar-year date)) "\n")
+	(setq s (point))
-	    (put-text-property s (1- (point)) 'face
+	(setq rtn (and (not emptyp)
-			       'org-level-3)
+		       (apply 'org-agenda-get-day-entries
-	    (if (equal d today)
+			      entry date args)))
-		(put-text-property s (1- (point)) 'org-today t))
+	(if (or rtn (equal d today) org-timeline-show-empty-dates)
-	    (insert (org-finalize-agenda-entries rtn) "\n")
+	    (progn
-	    (put-text-property s (1- (point)) 'day d))))
+	      (insert (calendar-day-name date) " "
+		      (number-to-string (extract-calendar-day date)) " "
+		      (calendar-month-name (extract-calendar-month date)) " "
+		      (number-to-string (extract-calendar-year date)) "\n")
+	      (put-text-property s (1- (point)) 'face
+				 'org-level-3)
+	      (if (equal d today)
+		  (put-text-property s (1- (point)) 'org-today t))
+	      (and rtn (insert (org-finalize-agenda-entries rtn) "\n"))
+	      (put-text-property s (1- (point)) 'day d)))))
 (goto-char (point-min))
 (setq buffer-read-only t)
 (goto-char (or (text-property-any (point-min) (point-max) 'org-today t)
 		   (point-min)))
 (when (not org-select-timeline-window)
 (message "File was not in list: %s" afile))))
 (defun org-file-menu-entry (file)
 (vector file (list 'find-file file) t))
-(defun org-get-all-dates (beg end &optional no-ranges force-today inactive)
+(defun org-get-all-dates (beg end &optional no-ranges force-today inactive empty)
 "Return a list of all relevant day numbers from BEG to END buffer positions.
 If NO-RANGES is non-nil, include only the start and end dates of a range,
 not every single day in the range.  If FORCE-TODAY is non-nil, make
 sure that TODAY is included in the list.  If INACTIVE is non-nil, also
-inactive time stamps (those in square brackets) are included."
+inactive time stamps (those in square brackets) are included.
+When EMPTY is non-nil, also include days without any entries."
 (let ((re (if inactive org-ts-regexp-both org-ts-regexp))
-	 dates date day day1 day2 ts1 ts2)
+	 dates dates1 date day day1 day2 ts1 ts2)
 (if force-today
 	(setq dates (list (time-to-days (current-time)))))
 (save-excursion
 (goto-char beg)
 (while (re-search-forward re end t)
 		ts2 (substring (match-string 2) 0 10)
 		day1 (time-to-days (org-time-string-to-time ts1))
 		day2 (time-to-days (org-time-string-to-time ts2)))
 	  (while (< (setq day1 (1+ day1)) day2)
 	    (or (memq day1 dates) (push day1 dates)))))
-(sort dates '<))))
+(setq dates (sort dates '<))
+(when empty
+	(while (setq day (pop dates))
+	  (setq day2 (car dates))
+	  (push day dates1)
+	  (when (and day2 empty)
+	    (if (or (eq empty t)
+		    (and (numberp empty) (<= (- day2 day) empty)))
+		(while (< (setq day (1+ day)) day2)
+		  (push (list day) dates1))
+	      (push (cons :omitted (- day2 day)) dates1))))
+	(setq dates (nreverse dates1)))
+dates)))
 ;;;###autoload
 (defun org-diary (&rest args)
 "Return diary information from org-files.
 This function can be used in a \"sexp\" diary entry in the Emacs calendar.
 			      (abbreviate-file-name buffer-file-name))))
 	 (regexp org-deadline-time-regexp)
 	 (todayp (equal date (calendar-current-date))) ; DATE bound by calendar
 	 (d1 (calendar-absolute-from-gregorian date))  ; DATE bound by calendar
 	 d2 diff pos pos1 category tags
-	 ee txt head)
+	 ee txt head face)
 (goto-char (point-min))
 (while (re-search-forward regexp nil t)
 (setq pos (1- (match-beginning 1))
 	    d2 (time-to-days
 		(org-time-string-to-time (match-string 1)))
 		  (if (string-match org-looking-at-done-regexp head)
 		      (setq txt nil)
 		    (setq txt (org-format-agenda-item
 			       (format "In %3d d.: " diff) head category tags))))
 	      (setq txt org-agenda-no-heading-message))
 	    (when txt
+	      (setq face (cond ((<= diff 0) 'org-warning)
+			       ((<= diff 5) 'org-upcoming-deadline)
+			       (t nil)))
 	      (org-add-props txt props
 		'org-marker (org-agenda-new-marker pos)
 		'org-hd-marker (org-agenda-new-marker pos1)
 		'priority (+ (- 10 diff) (org-get-priority txt))
 		'category category
-		'face (cond ((<= diff 0) 'org-warning)
+		'face face 'undone-face face 'done-face 'org-done)
-			    ((<= diff 5) 'org-scheduled-previously)
-			    (t nil))
-		'undone-face (cond
-			      ((<= diff 0) 'org-warning)
-			      ((<= diff 5) 'org-scheduled-previously)
-			      (t nil))
-		'done-face 'org-done)
 	      (push txt ee)))))
 ee))
 (defun org-agenda-get-scheduled ()
 "Return the scheduled information for agenda display."
 "Sort and concatenate the agenda items."
 (setq list (mapcar 'org-agenda-highlight-todo list))
 (mapconcat 'identity (sort list 'org-entries-lessp) "\n"))
 (defun org-agenda-highlight-todo (x)
-(let (re)
+(let (re pl)
 (if (eq x 'line)
 	(save-excursion
 	  (beginning-of-line 1)
 	  (setq re (get-text-property (point) 'org-not-done-regexp))
 	  (goto-char (+ (point) (get-text-property (point) 'prefix-length)))
 	  (and (looking-at (concat "[ \t]*" re))
 	       (add-text-properties (match-beginning 0) (match-end 0)
 				    '(face org-todo))))
-(setq re (get-text-property 0 'org-not-done-regexp x))
+(setq re (get-text-property 0 'org-not-done-regexp x)
-(and re (string-match re x)
+	    pl (get-text-property 0 'prefix-length x))
+(and re (equal (string-match re x pl) pl)
 	   (add-text-properties (match-beginning 0) (match-end 0)
 				'(face org-todo) x))
 x)))
 (defsubst org-cmp-priority (a b)
 	  (setq txt (cond
 		     ((org-on-heading-p) nil)
 		     ((org-region-active-p)
 		      (buffer-substring (region-beginning) (region-end)))
 		     (t (buffer-substring (point-at-bol) (point-at-eol)))))
-	  (when (string-match "\\S-" txt)
+	  (when (or (null txt) (string-match "\\S-" txt))
 	    (setq cpltxt
 		  (concat cpltxt "::"
 			  (if org-file-link-context-use-camel-case
 			      (org-make-org-heading-camel txt)
 			    (org-make-org-heading-search-string txt)))
 	)
 (t (setq rtn (cons line rtn)))))
 (nreverse rtn)))
 ;; ASCII
-(defconst org-ascii-underline '(?\$ ?\# ?^ ?\~ ?\= ?\-)
-"Characters for underlining headings in ASCII export.")
 (defconst org-html-entities
 '(("nbsp")
 ("iexcl")
 ("cent")
 (defun org-tr-level (n)
 "Make N odd if required."
 (if org-odd-levels-only (1+ (/ n 2)) n))
 (defvar org-last-level nil) ; dynamically scoped variable
+(defvar org-ascii-current-indentation nil) ; For communication
+;; FIXME: change indentation???/
 (defun org-export-as-ascii (arg)
 "Export the outline as a pretty ASCII file.
 If there is an active region, export only the region.
 The prefix ARG specifies how many levels of the outline should become
 	 (lines (org-export-find-first-heading-line
 		 (org-skip-comments
 		  (org-split-string
 		   (org-cleaned-string-for-export region)
 		   "[\r\n]"))))
+	 (org-ascii-current-indentation "")
 	 (org-startup-with-deadline-check nil)
 	 (level 0) line txt
 	 (umax nil)
 	 (case-fold-search nil)
 (filename (concat (file-name-as-directory
 (cond
 ((string-match "^\\(\\*+\\)[ \t]*\\(.*\\)" line)
 	;; a Headline
 	(setq level (org-tr-level (- (match-end 1) (match-beginning 1)))
 	      txt (match-string 2 line))
-	(org-ascii-level-start level txt umax))
+	(org-ascii-level-start level txt umax lines))
-(t (insert line "\n"))))
+(t
+	;; FIXME: do we need to do something about the indention when items are
+	;; converted to lists?
+	(insert org-ascii-current-indentation line "\n"))))
 (normal-mode)
 (save-buffer)
 ;; remove display and invisible chars
 (let (beg end s)
 (goto-char (point-min))
 (if underline
 	(insert (make-string ind ?\ )
 		(make-string (string-width s) underline)
 		"\n"))))
-(defun org-ascii-level-start (level title umax)
+(defun org-ascii-level-start (level title umax &optional lines)
 "Insert a new level in ASCII export."
-(let (char)
+(let (char (n (- level umax 1)) (ind 0))
 (if (> level umax)
-	(insert (make-string (* 2 (- level umax 1)) ?\ ) "* " title "\n")
+	(progn
+	  (insert (make-string (* 2 n) ?\ )
+		  (char-to-string (nth (% n (length org-export-ascii-bullets))
+				       org-export-ascii-bullets))
+		  " " title "\n")
+	  ;; find the indentation of the next non-empty line
+	  (catch 'stop
+	    (while lines
+	      (if (string-match "^\\*" (car lines)) (throw 'stop nil))
+	      (if (string-match "^\\([ \t]*\\)\\S-" (car lines))
+		  (throw 'stop (setq ind (match-end 1))))
+	      (pop lines)))
+	  (setq org-ascii-current-indentation
+		(make-string (max (- (* 2 (1+ n)) ind) 0) ?\ )))
 (if (or (not (equal (char-before) ?\n))
 	      (not (equal (char-before (1- (point))) ?\n)))
 	  (insert "\n"))
-(setq char (nth (- umax level) (reverse org-ascii-underline)))
+(setq char (nth (- umax level) (reverse org-export-ascii-underline)))
 (if org-export-with-section-numbers
 	  (setq title (concat (org-section-number level) " " title)))
-(insert title "\n" (make-string (string-width title) char) "\n"))))
+(insert title "\n" (make-string (string-width title) char) "\n")
+(setq org-ascii-current-indentation ""))))
 (defun org-export-visible (type arg)
 "Create a copy of the visible part of the current buffer, and export it.
 The copy is created in a temporary buffer and removed after use.
 TYPE is the final key (as a string) of the `C-c C-x' key sequence that will
 (setq umax (if arg (prefix-numeric-value arg)
 org-export-headline-levels))
 ;; File header
 (insert (format
-"<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\"
+"<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
-\"http://www.w3.org/TR/REC-html40/loose.dtd\">
+\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">
-<html lang=\"%s\"><head>
+<html xmlns=\"http://www.w3.org/1999/xhtml\"
+lang=\"%s\" xml:lang=\"%s\">
+<head>
 <title>%s</title>
-<meta http-equiv=\"Content-Type\" content=\"text/html;charset=%s\">
+<meta http-equiv=\"Content-Type\" content=\"text/html;charset=%s\"/>
-<meta name=generator content=\"Org-mode\">
+<meta name=\"generator\" content=\"Org-mode\"/>
-<meta name=generated content=\"%s %s\">
+<meta name=\"generated\" content=\"%s %s\"/>
-<meta name=author content=\"%s\">
+<meta name=\"author\" content=\"%s\"/>
 %s
 </head><body>
 "
-	       language (org-html-expand title) (or charset "iso-8859-1")
+	       language language (org-html-expand title) (or charset "iso-8859-1")
 	       date time author style))
 (insert (or (plist-get opt-plist :preamble) ""))
 (when (plist-get opt-plist :auto-preamble)
-	(if title     (insert (concat "<H1 class=\"title\">"
+	(if title     (insert (concat "<h1 class=\"title\">"
-				      (org-html-expand title) "</H1>\n")))
+				      (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;"
+	(if text      (insert "<p>\n" (org-html-expand text) "</p>")))
-;					  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")))
-	(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 (format "<h2>%s</h2>\n" (nth 3 lang-words)))
-	    (insert "<ul>\n")
+	    (insert "<ul>\n<li>")
 	    (setq lines
 	    (mapcar '(lambda (line)
 		       (if (string-match org-todo-line-regexp line)
 			   ;; This is a headline
 			   (progn
 				   (setq head-count (+ head-count 1))
 				   (if (> level org-last-level)
 				       (progn
 					 (setq cnt (- level org-last-level))
 					 (while (>= (setq cnt (1- cnt)) 0)
-					   (insert "<ul>"))
+					   (insert "\n<ul>\n<li>"))
 					 (insert "\n")))
 				   (if (< level org-last-level)
 				       (progn
 					 (setq cnt (- org-last-level level))
 					 (while (>= (setq cnt (1- cnt)) 0)
-					   (insert "</ul>"))
+					   (insert "</li>\n</ul>"))
 					 (insert "\n")))
 				   ;; Check for targets
 				   (while (string-match org-target-regexp line)
 				     (setq tg (match-string 1 line)
 					   line (replace-match
 				   (while (string-match "&lt;\\(&lt;\\)+\\|&gt;\\(&gt;\\)+" txt)
 				     (setq txt (replace-match "" t t txt)))
 				   (insert
 				    (format
 				     (if todo
-					 "<li><a href=\"#sec-%d\"><span class=\"todo\">%s</span></a>\n"
+					 "</li>\n<li><a href=\"#sec-%d\"><span class=\"todo\">%s</span></a>"
-				       "<li><a href=\"#sec-%d\">%s</a>\n")
+				       "</li>\n<li><a href=\"#sec-%d\">%s</a>")
 				     head-count txt))
 				   (setq org-last-level level))
 			       )))
 		       line)
 		    lines))
 	    (while (> org-last-level 0)
 	      (setq org-last-level (1- org-last-level))
-	      (insert "</ul>\n"))
+	      (insert "</li>\n</ul>\n"))
 	    ))
 (setq head-count 0)
 (org-init-section-numbers)
 (while (setq line (pop lines) origline line)
 		     (abs-p (file-name-absolute-p filename))
 		     thefile file-is-image-p search)
 		(save-match-data
 		  (if (string-match "::\\(.*\\)" filename)
 		      (setq search (match-string 1 filename)
-			    filename (replace-match "" nil nil filename)))
+			    filename (replace-match "" t nil filename)))
 		  (setq file-is-image-p
 			(string-match (org-image-file-name-regexp) filename))
 		  (setq thefile (if abs-p (expand-file-name filename) filename))
 		  (when (and org-export-html-link-org-files-as-html
 			     (string-match "\\.org$" thefile))
 	  (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 class=\"done\">\\2</span>"
-			      nil nil line 2))
+			      t nil line 2))
 		(setq line (replace-match "<span class=\"todo\">\\2</span>"
-					  nil nil line 2))))
+					  t nil line 2))))
 	  (cond
 	   ((string-match "^\\(\\*+\\)[ \t]*\\(.*\\)" line)
 	    ;; This is a headline
 	    (setq level (org-tr-level (- (match-end 1) (match-beginning 1)))
 		(setq txt (replace-match "" t t txt)))
 	    (if (<= level umax) (setq head-count (+ head-count 1)))
 	    (when in-local-list
 	      ;; Close any local lists before inserting a new header line
 	      (while local-list-num
+		(org-close-li)
 		(insert (if (car local-list-num) "</ol>\n" "</ul>"))
 		(pop local-list-num))
 	      (setq local-list-indent nil
 		    in-local-list nil))
 	    (org-html-level-start level txt umax
 		      (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)"
 					 (car lines))))
 	      (setq table-open nil
 		    table-buffer (nreverse table-buffer)
 		    table-orig-buffer (nreverse table-orig-buffer))
+	      (org-close-par-maybe)
 	      (insert (org-format-table-html table-buffer table-orig-buffer))))
 	   (t
 	    ;; Normal lines
 	    (when (string-match
 		   (cond
 		(setq ind (1+ (or (car local-list-indent) 1))))
 	      (while (and in-local-list
 			  (or (and (= ind (car local-list-indent))
 				   (not starter))
 			      (< ind (car local-list-indent))))
+		(org-close-li)
 		(insert (if (car local-list-num) "</ol>\n" "</ul>"))
 		(pop local-list-num) (pop local-list-indent)
 		(setq in-local-list local-list-indent))
 	      (cond
 	       ((and starter
 		     (or (not in-local-list)
 			 (> ind (car local-list-indent))))
 		;; Start new (level of ) list
+		(org-close-par-maybe)
 		(insert (if start-is-num "<ol>\n<li>\n" "<ul>\n<li>\n"))
 		(push start-is-num local-list-num)
 		(push ind local-list-indent)
 		(setq in-local-list t))
 	       (starter
 		;; continue current list
+		(org-close-li)
 		(insert "<li>\n")))
 	      (if (string-match "^[ \t]*\\[\\([X ]\\)\\]" line)
 		  (setq line
 			(replace-match
 			 (if (equal (match-string 1 line) "X")
 			   t t line))))
 	    ;; Empty lines start a new paragraph.  If hand-formatted lists
 	    ;; are not fully interpreted, lines starting with "-", "+", "*"
 	    ;; also start a new paragraph.
-	    (if (string-match "^ [-+*]-\\|^[ \t]*$" line) (insert "<p>"))
+	    (if (string-match "^ [-+*]-\\|^[ \t]*$" line) (org-open-par))
-	    (insert line (if org-export-preserve-breaks "<br>\n" "\n"))))
-	  ))
+	    ;; Check if the line break needs to be conserved
+	    ;; FIXME: document \\ at end of line.
+	    (cond
+	     ((string-match "\\\\\\\\[ \t]*$" line)
+	      (setq line (replace-match "<br/>" t t line)))
+	     (org-export-preserve-breaks
+	      (setq line (concat line "<br/>"))))
+	    (insert line "\n")))))
 ;; Properly close all local lists and other lists
 (when inquote (insert "</pre>\n"))
 (when in-local-list
 	;; Close any local lists before inserting a new header line
 	(while local-list-num
-	  (insert (if (car local-list-num) "</ol>\n" "</ul>"))
+	  (org-close-li)
+	  (insert (if (car local-list-num) "</ol>\n" "</ul>\n"))
 	  (pop local-list-num))
 	(setq local-list-indent nil
 	      in-local-list nil))
 (org-html-level-start 1 nil umax
 			    (and org-export-with-toc (<= level umax))
 			    head-count)
 (when (plist-get opt-plist :auto-postamble)
-	(insert "<p>")
+	(when author
-	(if author    (insert (concat (nth 1 lang-words) ": " author "\n")))
+	  (insert "<p class=\"author\"> "
-	(if email	  (insert (concat "<a href=\"mailto:" email "\">&lt;"
+		  (nth 1 lang-words) ": " author "\n")
-					  email "&gt;</a>\n")))
+	  (when email
-	(if (or author email) (insert "<br>\n"))
+	    (insert "<a href=\"mailto:" email "\">&lt;"
-	(if (and date time) (insert (concat (nth 2 lang-words) ": "
+		    email "&gt;</a>\n"))
-					    date " " time "<br>\n"))))
+	  (insert "</p>\n"))
+	(when (and date time)
+	  (insert "<p class=\"date\"> "
+		  (nth 2 lang-words) ": "
+		  date " " time "</p>\n")))
 (if org-export-html-with-timestamp
 	  (insert org-export-html-html-helper-timestamp))
 (insert (or (plist-get opt-plist :postamble) ""))
 (insert "</body>\n</html>\n")
 (normal-mode)
+;; remove empty paragraphs and lists
+(goto-char (point-min))
+(while (re-search-forward "<p>[ \r\n\t]*</p>" nil t)
+	(replace-match ""))
+(goto-char (point-min))
+(while (re-search-forward "<li>[ \r\n\t]*</li>\n?" nil t)
+	(replace-match ""))
 (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."
 	;; Break the line into fields and store the fields
 	(setq fields (org-split-string line "[ \t]*|[ \t]*"))
 	(if field-buffer
 	    (setq field-buffer (mapcar
 				(lambda (x)
-				  (concat x "<br>" (pop fields)))
+				  (concat x "<br/>" (pop fields)))
 				field-buffer))
 	  (setq field-buffer fields))))
 (setq html (concat html "</table>\n"))
 html))
 ;; Line break of line started and ended with time stamp stuff
 (if (not r)
 	s
 (setq r (concat r s))
 (unless (string-match "\\S-" (concat b s))
-	(setq r (concat r "@<br>")))
+	(setq r (concat r "@<br/>")))
 r)))
 (defun org-html-protect (s)
 ;; convert & to &amp;, < to &lt; and > to &gt;
 (let ((start 0))
 (defun org-html-do-expand (s)
 "Apply all active conversions to translate special ASCII to HTML."
 (setq s (org-html-protect s))
 (if org-export-html-expand
 (while (string-match "@&lt;\\([^&]*\\)&gt;" s)
-	(setq s (replace-match "<\\1>" nil nil s))))
+	(setq s (replace-match "<\\1>" t nil s))))
 (if org-export-with-emphasize
 (setq s (org-export-html-convert-emphasize s)))
 (if org-export-with-sub-superscripts
 (setq s (org-export-html-convert-sub-super s)))
 (if org-export-with-TeX-macros
 (setq string (replace-match "\\1<b>\\3</b>\\4" t nil string)))
 (while (string-match org-underline-re string)
 (setq string (replace-match "\\1<u>\\3</u>\\4" t nil string)))
 string)
+(defvar org-par-open nil)
+(defun org-open-par ()
+"Insert <p>, but first close previous paragraph if any."
+(org-close-par-maybe)
+(insert "\n<p>")
+(setq org-par-open t))
+(defun org-close-par-maybe ()
+"Close paragraph if there is one open."
+(when org-par-open
+(insert "</p>")
+(setq org-par-open nil)))
+(defun org-close-li ()
+"Close <li> if necessary."
+(org-close-par-maybe)
+(insert "</li>\n"))
+;  (when (save-excursion
+;	  (re-search-backward "</?\\(ul\\|ol\\|li\\|[hH][0-9]\\)>" nil t))
+;    (if (member (match-string 0) '("</ul>" "</ol>" "<li>"))
+;	(insert "</li>"))))
 (defun org-html-level-start (level title umax with-toc head-count)
 "Insert a new level in HTML export.
 When TITLE is nil, just close all open levels."
+(org-close-par-maybe)
 (let ((l (1+ (max level umax))))
 (while (<= l org-level-max)
 (if (aref levels-open (1- l))
 	  (progn
 	    (org-html-level-close l)
 ;; If title is nil, this means this function is called to close
 ;; all levels, so the rest is done only if title is given
 (if (> level umax)
 	  (progn
 	    (if (aref levels-open (1- level))
-		(insert "<li>" title "<p>\n")
+		(progn
+		  (org-close-li)
+		  (insert "<li>" title "<br/>\n"))
 	      (aset levels-open (1- level) t)
-	      (insert "<ul><li>" title "<p>\n")))
+	      (org-close-par-maybe)
+	      (insert "<ul>\n<li>" title "<br/>\n")))
 	(if org-export-with-section-numbers
 	    (setq title (concat (org-section-number level) " " title)))
 	(setq level (+ level 1))
 	(when (string-match "\\(:[a-zA-Z0-9_@:]+:\\)[ \t]*$" title)
 	  (setq title (replace-match
 					 "&nbsp;")
 			      "</span>"))
 			 "")
 		       t t title)))
 	(if with-toc
-	    (insert (format "\n<H%d><a name=\"sec-%d\">%s</a></H%d>\n"
+	    (insert (format "\n<h%d><a name=\"sec-%d\">%s</a></h%d>\n"
 			    level head-count title level))
-	  (insert (format "\n<H%d>%s</H%d>\n" level title level)))))))
+	  (insert (format "\n<h%d>%s</h%d>\n" level title level)))
+	(org-open-par)))))
 (defun org-html-level-close (&rest args)
 "Terminate one level in HTML export."
+(org-close-li)
 (insert "</ul>"))
 ;; Variable holding the vector with section numbers
 (defvar org-section-numbers (make-vector org-level-max 0))
 (setq string (concat string (if (not (string= string "")) "." "")
 			   (int-to-string n)))
 (setq idx (1+ idx)))
 (save-match-data
 (if (string-match "\\`\\([@0]\\.\\)+" string)
-	  (setq string (replace-match "" nil nil string)))
+	  (setq string (replace-match "" t nil string)))
 (if (string-match "\\(\\.0\\)+\\'" string)
-	  (setq string (replace-match "" nil nil string))))
+	  (setq string (replace-match "" t nil string))))
 string))
 (defun org-export-icalendar-this-file ()
 "Export current file as an iCalendar file.
 	(message "\"Org\"-menu now contains full customization menu"))
 (error "Cannot expand menu (outdated version of cus-edit.el)")))
 ;;; Miscellaneous stuff
+(defun org-context ()
+"Return a list of contexts of the current cursor position.
+If several contexts apply, all are returned.
+Each context entry is a list with a symbol naming the context, and
+two positions indicating start and end of the context.  Possible
+contexts are:
+:headline         anywhere in a headline
+:headline-stars   on the leading stars in a headline
+:todo-keyword     on a TODO keyword (including DONE) in a headline
+:tags             on the TAGS in a headline
+:priority         on the priority cookie in a headline
+:item             on the first line of a plain list item
+:checkbox         on the checkbox in a plain list item
+:table            in an org-mode table
+:table-special    on a special filed in a table
+:table-table      in a table.el table
+:link             on a hyperline
+:keyword          on a keyword: SCHEDULED, DEADLINE, CLOSE,COMMENT, QUOTE.
+:target           on a <<target>>
+:radio-target     on a <<<radio-target>>>
+This function expects the position to be visible because it uses font-lock
+faces as a help to recognize the following contexts: :table-special, :link,
+and :keyword."
+(let* ((f (get-text-property (point) 'face))
+	 (faces (if (listp f) f (list f)))
+	 (p (point)) clist)
+;; First the large context
+(cond
+((org-on-heading-p)
+(push (list :headline (point-at-bol) (point-at-eol)) clist)
+(when (progn
+	      (beginning-of-line 1)
+	      (looking-at org-todo-line-tags-regexp))
+	(push (org-point-in-group p 1 :headline-stars) clist)
+	(push (org-point-in-group p 2 :todo-keyword) clist)
+	(push (org-point-in-group p 4 :tags) clist))
+(goto-char p)
+(skip-chars-backward "^[\n\r \t") (or (eobp) (backward-char 1))
+(if (looking-at "\\[#[A-Z]\\]")
+	  (push (org-point-in-group p 0 :priority) clist)))
+((org-at-item-p)
+(push (list :item (point-at-bol)
+		  (save-excursion (org-end-of-item) (point)))
+	    clist)
+(and (org-at-item-checkbox-p)
+	   (push (org-point-in-group p 0 :checkbox) clist)))
+((org-at-table-p)
+(push (list :table (org-table-begin) (org-table-end)) clist)
+(if (memq 'org-formula faces)
+	  (push (list :table-special
+		      (previous-single-property-change p 'face)
+		      (next-single-property-change p 'face)) clist)))
+((org-at-table-p 'any)
+(push (list :table-table) clist)))
+(goto-char p)
+;; Now the small context
+(cond
+((org-at-timestamp-p)
+(push (org-point-in-group p 0 :timestamp) clist))
+((memq 'org-link faces)
+(push (list :link
+		  (previous-single-property-change p 'face)
+		  (next-single-property-change p 'face)) clist))
+((memq 'org-special-keyword faces)
+(push (list :keyword
+		  (previous-single-property-change p 'face)
+		  (next-single-property-change p 'face)) clist))
+((org-on-target-p)
+(push (org-point-in-group p 0 :target) clist)
+(goto-char (1- (match-beginning 0)))
+(if (looking-at org-radio-target-regexp)
+	  (push (org-point-in-group p 0 :radio-target) clist))
+(goto-char p)))
+(setq clist (nreverse (delq nil clist)))
+clist))
+(defun org-point-in-group (point group &optional context)
+"Check if POINT is in match-group GROUP.
+If CONTEXT is non-nil, return a list with CONTEXT and the boundaries of the
+match.  If the match group does ot exist or point is not inside it,
+return nil."
+(and (match-beginning group)
+(>= point (match-beginning group))
+(<= point (match-end group))
+(if context
+	   (list context (match-beginning group) (match-end group))
+	 t)))
 (defun org-move-line-down (arg)
 "Move the current line down.  With prefix argument, move it past ARG lines."
 (interactive "p")
 (let ((col (current-column))
 	beg end pos)
 (provide 'org)
 (run-hooks 'org-load-hook)
 ;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd
 ;;; org.el ends here

Mercurial > emacs

comparison lisp/textmodes/org.el @ 71096:d26859871d39