# HG changeset patch # User Carsten Dominik # Date 1149006542 0 # Node ID d26859871d39bb2f7e7333aca6962ffc3225f58b # Parent 92e88635d2f470513fe7c257bdc515df8452007d (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. diff -r 92e88635d2f4 -r d26859871d39 lisp/textmodes/org.el --- a/lisp/textmodes/org.el Tue May 30 16:12:59 2006 +0000 +++ b/lisp/textmodes/org.el Tue May 30 16:29:02 2006 +0000 @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik ;; 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. ;; @@ -90,6 +90,15 @@ ;; ;; 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. ;; @@ -156,7 +165,7 @@ ;;; Customization variables -(defvar org-version "4.34" +(defvar org-version "4.35" "The version number of the file org.el.") (defun org-version () (interactive) @@ -1430,12 +1439,6 @@ :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." @@ -1616,11 +1619,6 @@ :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. Depending on which command was used last, this may be the compiled version @@ -1654,6 +1652,34 @@ (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" @@ -1890,6 +1916,22 @@ :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." @@ -1997,7 +2039,7 @@ :type 'boolean) (defcustom org-export-html-table-tag - "" + "
" "The HTML tag used to start a table. This must be a
tag, but you may change the options like borders and spacing." @@ -2011,8 +2053,9 @@ :group 'org-export-html :type 'boolean) +;; FIXME:

is not pretty. (defcustom org-export-html-html-helper-timestamp - "

\n" + "

\n" "The HTML tag used as timestamp delimiter for HTML-helper-mode." :group 'org-export-html :type 'string) @@ -2304,6 +2347,16 @@ "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")) @@ -2347,6 +2400,10 @@ (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) @@ -2499,6 +2556,10 @@ "\\)? *\\(.*\\)") 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 @@ -5565,12 +5626,13 @@ (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)) @@ -5590,28 +5652,35 @@ (push :timestamp args) (if dotodo (push :todo args)) (while (setq d (pop day-numbers)) - (if (and (>= d today) - dopast - past) + (if (and (listp d) (eq (car d) :omitted)) (progn - (setq past nil) - (insert (make-string 79 ?-) "\n"))) - (setq date (calendar-gregorian-from-absolute d)) - (setq s (point)) - (setq rtn (apply 'org-agenda-get-day-entries - entry date args)) - (if (or rtn (equal d today)) - (progn - (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)) - (insert (org-finalize-agenda-entries rtn) "\n") - (put-text-property s (1- (point)) 'day d)))) + (setq s (point)) + (insert (format "\n[... %d empty days omitted]\n\n" (cdr d))) + (put-text-property s (1- (point)) 'face 'org-level-3)) + (if (listp d) (setq d (car d) emptyp t) (setq emptyp nil)) + (if (and (>= d today) + dopast + past) + (progn + (setq past nil) + (insert (make-string 79 ?-) "\n"))) + (setq date (calendar-gregorian-from-absolute d)) + (setq s (point)) + (setq rtn (and (not emptyp) + (apply 'org-agenda-get-day-entries + entry date args))) + (if (or rtn (equal d today) org-timeline-show-empty-dates) + (progn + (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) @@ -6174,14 +6243,15 @@ (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 @@ -6199,7 +6269,19 @@ 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) @@ -6544,7 +6626,7 @@ (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)) @@ -6571,20 +6653,16 @@ (setq txt (org-format-agenda-item (format "In %3d d.: " diff) head category tags)))) (setq txt org-agenda-no-heading-message)) - (when txt + (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) - ((<= 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) + 'face face 'undone-face face 'done-face 'org-done) (push txt ee))))) ee)) @@ -6886,7 +6964,7 @@ (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) @@ -6895,8 +6973,9 @@ (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)) - (and re (string-match re x) + (setq re (get-text-property 0 'org-not-done-regexp 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))) @@ -8720,7 +8799,7 @@ ((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 @@ -11685,9 +11764,6 @@ ;; ASCII -(defconst org-ascii-underline '(?\$ ?\# ?^ ?\~ ?\= ?\-) - "Characters for underlining headings in ASCII export.") - (defconst org-html-entities '(("nbsp") ("iexcl") @@ -12089,6 +12165,9 @@ (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. @@ -12108,6 +12187,7 @@ (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) @@ -12221,8 +12301,11 @@ ;; 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)) - (t (insert line "\n")))) + (org-ascii-level-start level txt umax lines)) + (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 @@ -12276,18 +12359,32 @@ (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. @@ -12572,38 +12669,35 @@ ;; File header (insert (format - " - + " + +%s - - - - + + + + %s " - 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 "

" - (org-html-expand title) "

\n"))) -; (if author (insert (concat (nth 1 lang-words) ": " author "\n"))) -; (if email (insert (concat "<" -; email ">\n"))) -; (if (or author email) (insert "
\n")) -; (if (and date time) (insert (concat (nth 2 lang-words) ": " -; date " " time "
\n"))) - (if text (insert (concat "

\n" (org-html-expand text))))) + (if title (insert (concat "

" + (org-html-expand title) "

\n"))) + + (if text (insert "

\n" (org-html-expand text) "

"))) (if org-export-with-toc (progn - (insert (format "

%s

\n" (nth 3 lang-words))) - (insert "\n")) )) (setq head-count 0) (org-init-section-numbers) @@ -12758,7 +12852,7 @@ (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)) @@ -12797,9 +12891,9 @@ (if (equal (match-string 2 line) org-done-string) (setq line (replace-match "\\2" - nil nil line 2)) + t nil line 2)) (setq line (replace-match "\\2" - nil nil line 2)))) + t nil line 2)))) (cond ((string-match "^\\(\\*+\\)[ \t]*\\(.*\\)" line) @@ -12812,6 +12906,7 @@ (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) "\n" "")) (pop local-list-num)) (setq local-list-indent nil @@ -12838,6 +12933,7 @@ (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 @@ -12860,6 +12956,7 @@ (or (and (= ind (car local-list-indent)) (not starter)) (< ind (car local-list-indent)))) + (org-close-li) (insert (if (car local-list-num) "\n" "")) (pop local-list-num) (pop local-list-indent) (setq in-local-list local-list-indent)) @@ -12868,12 +12965,14 @@ (or (not in-local-list) (> ind (car local-list-indent)))) ;; Start new (level of ) list + (org-close-par-maybe) (insert (if start-is-num "
    \n
  1. \n" "
      \n
    • \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 "
    • \n"))) (if (string-match "^[ \t]*\\[\\([X ]\\)\\]" line) (setq line @@ -12886,16 +12985,25 @@ ;; 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 "

      ")) - (insert line (if org-export-preserve-breaks "
      \n" "\n")))) - )) - + (if (string-match "^ [-+*]-\\|^[ \t]*$" line) (org-open-par)) + + ;; Check if the line break needs to be conserved + ;; FIXME: document \\ at end of line. + (cond + ((string-match "\\\\\\\\[ \t]*$" line) + (setq line (replace-match "
      " t t line))) + (org-export-preserve-breaks + (setq line (concat line "
      ")))) + + (insert line "\n"))))) + ;; Properly close all local lists and other lists (when inquote (insert "\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) "

\n" "")) + (org-close-li) + (insert (if (car local-list-num) "\n" "\n")) (pop local-list-num)) (setq local-list-indent nil in-local-list nil)) @@ -12904,19 +13012,30 @@ head-count) (when (plist-get opt-plist :auto-postamble) - (insert "

") - (if author (insert (concat (nth 1 lang-words) ": " author "\n"))) - (if email (insert (concat "<" - email ">\n"))) - (if (or author email) (insert "
\n")) - (if (and date time) (insert (concat (nth 2 lang-words) ": " - date " " time "
\n")))) + (when author + (insert "

" + (nth 1 lang-words) ": " author "\n") + (when email + (insert "<" + email ">\n")) + (insert "

\n")) + (when (and date time) + (insert "

" + (nth 2 lang-words) ": " + date " " time "

\n"))) (if org-export-html-with-timestamp (insert org-export-html-html-helper-timestamp)) (insert (or (plist-get opt-plist :postamble) "")) (insert "\n\n") (normal-mode) + ;; remove empty paragraphs and lists + (goto-char (point-min)) + (while (re-search-forward "

[ \r\n\t]*

" nil t) + (replace-match "")) + (goto-char (point-min)) + (while (re-search-forward "
  • [ \r\n\t]*
    • \n?" nil t) + (replace-match "")) (save-buffer) (goto-char (point-min))))) @@ -13046,7 +13165,7 @@ (if field-buffer (setq field-buffer (mapcar (lambda (x) - (concat x "
    " (pop fields))) + (concat x "
    " (pop fields))) field-buffer)) (setq field-buffer fields)))) (setq html (concat html "
    \n")) @@ -13090,7 +13209,7 @@ s (setq r (concat r s)) (unless (string-match "\\S-" (concat b s)) - (setq r (concat r "@
    "))) + (setq r (concat r "@
    "))) r))) (defun org-html-protect (s) @@ -13131,7 +13250,7 @@ (setq s (org-html-protect s)) (if org-export-html-expand (while (string-match "@<\\([^&]*\\)>" 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 @@ -13200,9 +13319,30 @@ (setq string (replace-match "\\1\\3\\4" t nil string))) string) +(defvar org-par-open nil) +(defun org-open-par () + "Insert

    , but first close previous paragraph if any." + (org-close-par-maybe) + (insert "\n

    ") + (setq org-par-open t)) +(defun org-close-par-maybe () + "Close paragraph if there is one open." + (when org-par-open + (insert "

    ") + (setq org-par-open nil))) +(defun org-close-li () + "Close
  • if necessary." + (org-close-par-maybe) + (insert "
    • \n")) +; (when (save-excursion +; (re-search-backward "" nil t)) +; (if (member (match-string 0) '("" "" "
  • ")) +; (insert "
    • ")))) + (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)) @@ -13216,9 +13356,12 @@ (if (> level umax) (progn (if (aref levels-open (1- level)) - (insert "
  • " title "

    \n") + (progn + (org-close-li) + (insert "

  • " title "
    \n")) (aset levels-open (1- level) t) - (insert "
    • " title "

      \n"))) + (org-close-par-maybe) + (insert "

        \n
      • " title "
        \n"))) (if org-export-with-section-numbers (setq title (concat (org-section-number level) " " title))) (setq level (+ level 1)) @@ -13235,12 +13378,14 @@ "") t t title))) (if with-toc - (insert (format "\n%s\n" + (insert (format "\n%s\n" level head-count title level)) - (insert (format "\n%s\n" level title level))))))) + (insert (format "\n%s\n" level title level))) + (org-open-par))))) (defun org-html-level-close (&rest args) "Terminate one level in HTML export." + (org-close-li) (insert "
      ")) ;; Variable holding the vector with section numbers @@ -13284,9 +13429,9 @@ (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)) @@ -14282,6 +14427,100 @@ ;;; 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 <> +:radio-target on a <<>> + +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") @@ -14647,5 +14886,7 @@ (run-hooks 'org-load-hook) + ;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd ;;; org.el ends here +