emacs: lisp/textmodes/org.el comparison

comparison lisp/textmodes/org.el @ 69454:d60237bf3ccc

(org-link-search): Avoid self-matching of links, allow target text to be distributed over several lines. (org-search-not-link): New function. (org-set-regexps-and-options, org-get-current-options): New startup options. (org-export-as-html): Take odd-level setting from local variable. (org-fontify-emphasized-text): New option. (org-set-font-lock-defaults): Include emphasized text. (org-follow-mhe-link): Allow folder-only links, fix folder name. (org-font-lock): Customize group renamed from `org-faces'.

author	Carsten Dominik <dominik@science.uva.nl>
date	Mon, 13 Mar 2006 07:08:15 +0000
parents	7aecee7bf0d9
children	a305f07816a9 a802c5505156

comparison

equal deleted inserted replaced

-:91b04387dd58
+:d60237bf3ccc
 ;; 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.08
+;; Version: 4.09
 ;;
 ;; 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.
 ;;
 ;; Changes since version 4.00:
 ;; ---------------------------
+;; Version 4.09
+;;    - Bug fixes.
+;;    - Small improvements to font-lock support.
+;;    - MHE support finalized.
+;;
 ;; Version 4.08
-;;
+;;    - Bug fixes.
+;;    - Improved MHE support
 ;;
 ;; Version 4.07
 ;;    - Bug fixes.
 ;;    - Leading stars in headlines can be hidden, so make the outline look
 ;;      cleaner.
 (defvar calc-embedded-open-formula)
 (defvar font-lock-unfontify-region-function)
 ;;; Customization variables
-(defvar org-version "4.08"
+(defvar org-version "4.09"
 "The version number of the file org.el.")
 (defun org-version ()
 (interactive)
 (message "Org-mode version %s" org-version))
 This can be used to recenter the window to show as much of the structure
 as possible."
 :group 'org-structure
 :type 'hook)
-(defcustom org-level-color-stars-only nil
-"Non-nil means fontify only the stars in each headline.
-When nil, the entire headline is fontified.
-Changing it requires restart of `font-lock-mode' to become effective."
-:group 'org-structure
-:type 'boolean)
-(defcustom org-hide-leading-stars nil
-"Non-nil means, hide the first N-1 stars in a headline.
-This works by using the face `org-hide' for these stars.  This
-face is white for a light background, and black for a dark
-background.  You may have to customize the face `org-hide' to
-make this work.
-Changing it requires restart of `font-lock-mode' to become effective."
-:group 'org-structure
-:type 'boolean)
 (defcustom org-odd-levels-only nil
 "Non-nil means, skip even levels and only use odd levels for the outline.
 This has the effect that two stars are being added/taken away in
 promotion/demotion commands.  It also influences how levels are
 handled by the exporters.
 Changing it requires restart of `font-lock-mode' to become effective
-for fontification."
+for fontification also in regions already fontified."
 :group 'org-structure
+:group 'org-font-lock
 :type 'boolean)
 (defcustom org-adapt-indentation t
 "Non-nil means, adapt indentation when promoting and demoting.
 When this is set and the *entire* text in an entry is indented, the
 (defcustom org-icalendar-combined-name "OrgMode"
 "Calendar name for the combined iCalendar representing all agenda files."
 :group 'org-export
 :type 'string)
-(defgroup org-faces nil
+(defgroup org-font-lock nil
-"Faces for highlighting in Org-mode."
+"Faces and settings for highlighting in Org-mode."
-:tag "Org Faces"
+:tag "Org Font Lock"
 :group 'org)
+(defcustom org-level-color-stars-only nil
+"Non-nil means fontify only the stars in each headline.
+When nil, the entire headline is fontified.
+Changing it requires restart of `font-lock-mode' to become effective
+also in regions already fontified."
+:group 'org-font-lock
+:type 'boolean)
+(defcustom org-hide-leading-stars nil
+"Non-nil means, hide the first N-1 stars in a headline.
+This works by using the face `org-hide' for these stars.  This
+face is white for a light background, and black for a dark
+background.  You may have to customize the face `org-hide' to
+make this work.
+Changing it requires restart of `font-lock-mode' to become effective
+also in regions already fontified."
+:group 'org-font-lock
+:type 'boolean)
+(defcustom org-fontify-done-headline nil
+"Non-nil means, change the face of a headline if it is marked DONE.
+Normally, only the TODO/DONE keyword indicates the state of a headline.
+When this is non-nil, the headline after the keyword is set to the
+`org-headline-done' as an additional indication."
+:group 'org-font-lock
+:type 'boolean)
+(defcustom org-fontify-emphasized-text t
+"Non-nil means fontify *bold*, /italic/ and _underlined_ text.
+Changing this variable requires a restart of Emacs to take effect."
+:group 'org-font-lock
+:type 'boolean)
 (defface org-hide
 '((((type tty) (class color)) (:foreground "blue" :weight bold))
 (((class color) (background light)) (:foreground "white"))
 (((class color) (background dark)) (:foreground "black"))
 ;    (((class color) (background light)) (:foreground "grey90"))
 ;    (((class color) (background dark)) (:foreground "grey10"))
 (t (:inverse-video nil)))
 "Face used for level 1 headlines."
-:group 'org-faces)
+:group 'org-font-lock)
 (defface org-level-1 ;; font-lock-function-name-face
 '((((type tty) (class color)) (:foreground "blue" :weight bold))
 (((class color) (background light)) (:foreground "Blue"))
 (((class color) (background dark)) (:foreground "LightSkyBlue"))
 (t (:inverse-video t :bold t)))
 "Face used for level 1 headlines."
-:group 'org-faces)
+:group 'org-font-lock)
 (defface org-level-2 ;; font-lock-variable-name-face
 '((((type tty) (class color)) (:foreground "yellow" :weight light))
 (((class color) (background light)) (:foreground "DarkGoldenrod"))
 (((class color) (background dark)) (:foreground "LightGoldenrod"))
 (t (:bold t :italic t)))
 "Face used for level 2 headlines."
-:group 'org-faces)
+:group 'org-font-lock)
 (defface org-level-3 ;; font-lock-keyword-face
 '((((type tty) (class color)) (:foreground "cyan" :weight bold))
 (((class color) (background light)) (:foreground "Purple"))
 (((class color) (background dark)) (:foreground "Cyan"))
 (t (:bold t)))
 "Face used for level 3 headlines."
-:group 'org-faces)
+:group 'org-font-lock)
 (defface org-level-4   ;; font-lock-comment-face
 '((((type tty pc) (class color) (background light)) (:foreground "red"))
 (((type tty pc) (class color) (background dark)) (:foreground "red1"))
 (((class color) (background light)) (:foreground "Firebrick"))
 (((class color) (background dark)) (:foreground "chocolate1"))
 (t (:bold t :italic t)))
 "Face used for level 4 headlines."
-:group 'org-faces)
+:group 'org-font-lock)
 (defface org-level-5 ;; font-lock-type-face
 '((((type tty) (class color)) (:foreground "green"))
 (((class color) (background light)) (:foreground "ForestGreen"))
 (((class color) (background dark)) (:foreground "PaleGreen"))
 (t (:bold t :underline t)))
 "Face used for level 5 headlines."
-:group 'org-faces)
+:group 'org-font-lock)
 (defface org-level-6 ;; font-lock-constant-face
 '((((type tty) (class color)) (:foreground "magenta"))
 (((class color) (background light)) (:foreground "CadetBlue"))
 (((class color) (background dark)) (:foreground "Aquamarine"))
 (t (:bold t :underline t)))
 "Face used for level 6 headlines."
-:group 'org-faces)
+:group 'org-font-lock)
 (defface org-level-7 ;; font-lock-builtin-face
 '((((type tty) (class color)) (:foreground "blue" :weight light))
 (((class color) (background light)) (:foreground "Orchid"))
 (((class color) (background dark)) (:foreground "LightSteelBlue"))
 (t (:bold t)))
 "Face used for level 7 headlines."
-:group 'org-faces)
+:group 'org-font-lock)
 (defface org-level-8 ;; 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)
+:group 'org-font-lock)
 (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 special keywords."
-:group 'org-faces)
+:group 'org-font-lock)
 (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))
 (t (:inverse-video t :bold t)))
 "Face for deadlines and TODO keywords."
-:group 'org-faces)
+:group 'org-font-lock)
-(defcustom org-fontify-done-headline nil
-"Non-nil means, change the face of a headline if it is marked DONE.
-Normally, only the TODO/DONE keyword indicates the state of a headline.
-When this is non-nil, the headline after the keyword is set to the
-`org-headline-done' as an additional indication."
-:group 'org-faces
-:type 'boolean)
 (defface org-headline-done ;; 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 to indicate that a headline is DONE.  See also the variable
 `org-fontify-done-headline'."
-:group 'org-faces)
+:group 'org-font-lock)
 ;; Inheritance does not yet work for xemacs. So we just copy...
 (defface org-deadline-announce
 '((((type tty) (class color)) (:foreground "blue" :weight bold))
 (((class color) (background light)) (:foreground "Blue"))
 (((class color) (background dark)) (:foreground "LightSkyBlue"))
 (t (:inverse-video t :bold t)))
 "Face for upcoming deadlines."
-:group 'org-faces)
+:group 'org-font-lock)
 (defface org-scheduled-today
 '((((type tty) (class color)) (:foreground "green"))
 (((class color) (background light)) (:foreground "DarkGreen"))
 (((class color) (background dark)) (:foreground "PaleGreen"))
 (t (:bold t :underline t)))
 "Face for items scheduled for a certain day."
-:group 'org-faces)
+:group 'org-font-lock)
 (defface org-scheduled-previously
 '((((type tty pc) (class color) (background light)) (:foreground "red"))
 (((type tty pc) (class color) (background dark)) (:foreground "red1"))
 (((class color) (background light)) (:foreground "Firebrick"))
 (((class color) (background dark)) (:foreground "chocolate1"))
 (t (:bold t :italic t)))
 "Face for items scheduled previously, and not yet done."
-:group 'org-faces)
+:group 'org-font-lock)
 (defface org-formula
 '((((type tty pc) (class color) (background light)) (:foreground "red"))
 (((type tty pc) (class color) (background dark)) (:foreground "red1"))
 (((class color) (background light)) (:foreground "Firebrick"))
 (((class color) (background dark)) (:foreground "chocolate1"))
 (t (:bold t :italic t)))
 "Face for formulas."
-:group 'org-faces)
+:group 'org-font-lock)
 (defface org-link
 '((((type tty) (class color)) (:foreground "cyan" :weight bold))
 (((class color) (background light)) (:foreground "Purple"))
 (((class color) (background dark)) (:foreground "Cyan"))
 (t (:bold t)))
 "Face for links."
-:group 'org-faces)
+:group 'org-font-lock)
 (defface org-tag
 '((((type tty) (class color)) (:foreground "cyan" :weight bold))
 (((class color) (background light)) (:foreground "Purple" :weight bold))
 (((class color) (background dark)) (:foreground "Cyan" :weight bold))
 (t (:bold t)))
-"Face for links."
+"Face for tags."
-:group 'org-faces)
+:group 'org-font-lock)
 (defface org-done ;; font-lock-type-face
 '((((type tty) (class color)) (:foreground "green"))
 (((class color) (background light)) (:foreground "ForestGreen" :bold t))
 (((class color) (background dark)) (:foreground "PaleGreen" :bold t))
 (t (:bold t :underline t)))
 "Face used for DONE."
-:group 'org-faces)
+:group 'org-font-lock)
 (defface org-table ;; font-lock-function-name-face
 '((((type tty) (class color)) (:foreground "blue" :weight bold))
 (((class color) (background light)) (:foreground "Blue"))
 (((class color) (background dark)) (:foreground "LightSkyBlue"))
 (t (:inverse-video t :bold t)))
 "Face used for tables."
-:group 'org-faces)
+:group 'org-font-lock)
 (defface org-time-grid ;; font-lock-variable-name-face
 '((((type tty) (class color)) (:foreground "yellow" :weight light))
 (((class color) (background light)) (:foreground "DarkGoldenrod"))
 (((class color) (background dark)) (:foreground "LightGoldenrod"))
 (t (:bold t :italic t)))
 "Face used for time grids."
-:group 'org-faces)
+:group 'org-font-lock)
 (defvar org-level-faces
 '(org-level-1 org-level-2 org-level-3 org-level-4
 org-level-5 org-level-6 org-level-7 org-level-8
 ))
 	     ((equal key "STARTUP")
 	      (let ((opts (org-split-string value splitre))
 		    (set '(("fold" org-startup-folded t)
 			   ("nofold" org-startup-folded nil)
 			   ("content" org-startup-folded content)
+			   ("hidestars" org-hide-leading-stars t)
+			   ("showstars" org-hide-leading-stars nil)
+			   ("odd" org-odd-levels-only t)
+			   ("oddeven" org-odd-levels-only nil)
 			   ("dlcheck" org-startup-with-deadline-check t)
 			   ("nodlcheck" org-startup-with-deadline-check nil)))
 		    l var val)
 		(while (setq l (assoc (pop opts) set))
 		  (setq var (nth 1 l) val (nth 2 l))
 (- (match-end 0) (match-beginning 0)))))
 (defvar org-font-lock-keywords nil)
 (defun org-set-font-lock-defaults ()
-(let ((org-font-lock-extra-keywords
+(let* ((em org-fontify-emphasized-text)
-	 (list
+	 (org-font-lock-extra-keywords
-	  '("^\\(\\**\\)\\(\\*\\)\\(.*\\)" (1 (org-get-level-face 1))
+	  (list
-	    (2 (org-get-level-face 2)) (3 (org-get-level-face 3)))
+	   '("^\\(\\**\\)\\(\\*\\)\\(.*\\)" (1 (org-get-level-face 1))
-	  '(org-activate-links (0 'org-link t))
+	     (2 (org-get-level-face 2)) (3 (org-get-level-face 3)))
-	  '(org-activate-links2 (0 'org-link t))
+	   '(org-activate-links (0 'org-link t))
-	  '(org-activate-target-links (0 'org-link t))
+	   '(org-activate-links2 (0 'org-link t))
-	  '(org-activate-dates (0 'org-link t))
+	   '(org-activate-target-links (0 'org-link t))
-	  '(org-activate-camels (0 'org-link t))
+	   '(org-activate-dates (0 'org-link t))
-	  '(org-activate-tags (1 'org-tag t))
+	   '(org-activate-camels (0 'org-link t))
-	  (list (concat "^\\*+[ \t]*" org-not-done-regexp)
+	   '(org-activate-tags (1 'org-tag t))
-		'(1 'org-warning t))
+	   (list (concat "^\\*+[ \t]*" org-not-done-regexp)
-	  (list (concat "\\[#[A-Z]\\]") '(0 'org-special-keyword t))
+		 '(1 'org-warning t))
-	  (list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t))
+	   (list (concat "\\[#[A-Z]\\]") '(0 'org-special-keyword t))
-	  (list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t))
+	   (list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t))
-	  (list (concat "\\<" org-closed-string) '(0 'org-special-keyword t))
+	   (list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t))
-	  ;; '("\\(\\s-\\|^\\)\\(\\*\\([a-zA-Z]+\\)\\*\\)\\([^a-zA-Z*]\\|$\\)"
+	   (list (concat "\\<" org-closed-string) '(0 'org-special-keyword t))
-	  ;; (3 'bold))
+;	   (if em '("\\(\\s-\\|^\\)\\(\\*\\([a-zA-Z]+\\)\\*\\)\\([^a-zA-Z*]\\|$\\)" (3 'bold)))
-	  ;; '("\\(\\s-\\|^\\)\\(/\\([a-zA-Z]+\\)/\\)\\([^a-zA-Z*]\\|$\\)"
+;	   (if em '("\\(\\s-\\|^\\)\\(/\\([a-zA-Z]+\\)/\\)\\([^a-zA-Z*]\\|$\\)" (3 'italic)))
-	  ;; (3 'italic))
+;	   (if em '("\\(\\s-\\|^\\)\\(_\\([a-zA-Z]+\\)_\\)\\([^a-zA-Z*]\\|$\\)" (3 'underline)))
-	  ;; '("\\(\\s-\\|^\\)\\(_\\([a-zA-Z]+\\)_\\)\\([^a-zA-Z*]\\|$\\)"
+	   (if em '("\\*[a-zA-Z]+\\*" 0 'bold))
-	  ;; (3 'underline))
+	   (if em '("/*[a-zA-Z]+/" 0 'italic))
-	  (list (concat "^\\*+[ \t]*\\<\\(" org-comment-string
+	   (if em '("_[a-zA-Z]+_" 0 'underline))
-			"\\|" org-quote-string "\\)\\>")
+	   (list (concat "^\\*+[ \t]*\\<\\(" org-comment-string
-		'(1 'org-special-keyword t))
+			 "\\|" org-quote-string "\\)\\>")
-	  '("^#.*" (0 'font-lock-comment-face t))
+		 '(1 'org-special-keyword t))
-	  (if org-fontify-done-headline
+	   '("^#.*" (0 'font-lock-comment-face t))
-	      (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\(.*\\)\\>")
+	   (if org-fontify-done-headline
-		    '(1 'org-done t) '(2 'org-headline-done t))
+	       (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\(.*\\)\\>")
-	    (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\>")
+		     '(1 'org-done t) '(2 'org-headline-done t))
-		  '(1 'org-done t)))
+	     (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\>")
-	  '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)"
+		   '(1 'org-done t)))
-	    (1 'org-table t))
+	   '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)"
-	  '("^[ \t]*\\(:.*\\)" (1 'org-table t))
+	     (1 'org-table t))
-	  '("| *\\(:?=[^|\n]*\\)" (1 'org-formula t))
+	   '("^[ \t]*\\(:.*\\)" (1 'org-table t))
-	  '("^[ \t]*| *\\([#!$*_^]\\) *|" (1 'org-formula t))
+	   '("| *\\(:?=[^|\n]*\\)" (1 'org-formula t))
-	  )))
+	   '("^[ \t]*| *\\([#!$*_^]\\) *|" (1 'org-formula t))
+	   )))
+(setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords))
 ;; Now set the full font-lock-keywords
 (set (make-local-variable 'org-font-lock-keywords)
 	 org-font-lock-extra-keywords)
 (set (make-local-variable 'font-lock-defaults)
 	 '(org-font-lock-keywords t nil nil backward-paragraph))
 in all files."
 (let ((case-fold-search t)
 	(s0 (mapconcat 'identity (org-split-string s "[ \t\r\n]+") " "))
 	(pos (point))
 	(pre "") (post "")
-	words re0 re1 re2 re3 re4 re5 reall camel)
+	words re0 re1 re2 re3 re4 re5 re2a reall camel)
 (cond ((save-excursion
 	     (goto-char (point-min))
 	     (and
 	      (re-search-forward
 	       (concat "<<" (regexp-quote s0) ">>") nil t)
 		 (if camel
 		     (org-camel-to-words s)
 		   (org-split-string s "[ \n\r\t]+"))
 		 re0 (concat "<<" (regexp-quote s0) ">>")
 		 re2 (concat "\\<" (mapconcat 'downcase words "[ \t]+") "\\>")
+		 re2a (concat "\\<" (mapconcat 'downcase words "[ \t\r\n]+") "\\>")
 		 re4 (concat "\\<" (mapconcat 'downcase words "[^a-zA-Z_\r\n]+") "\\>")
 		 re1 (concat pre re2 post)
 		 re3 (concat pre re4 post)
 		 re5 (concat pre ".*" re4)
 		 re2 (concat pre re2)
+		 re2a (concat pre re2a)
 		 re4 (concat pre re4)
 		 reall (concat "\\(" re0 "\\)\\|\\(" re1 "\\)\\|\\(" re2
 			       "\\)\\|\\(" re3 "\\)\\|\\(" re4 "\\)\\|\\("
 			       re5 "\\)"
 			       ))
 	   (cond
 	    ((eq type 'org-occur) (org-occur reall))
 	    ((eq type 'occur) (org-do-occur (downcase reall) 'cleanup))
 	    (t (goto-char (point-min))
-	       (if (or (re-search-forward re0 nil t)
+	       (if (or (org-search-not-link re0 nil t)
-		       (re-search-forward re1 nil t)
+		       (org-search-not-link re1 nil t)
-		       (re-search-forward re2 nil t)
+		       (org-search-not-link re2 nil t)
-		       (re-search-forward re3 nil t)
+		       (org-search-not-link re2a nil t) ;; FIXME: Right place???
-		       (re-search-forward re4 nil t)
+		       (org-search-not-link re3 nil t)
-		       (re-search-forward re5 nil t))
+		       (org-search-not-link re4 nil t)
+		       (org-search-not-link re5 nil t)
+		       )
 		   (goto-char (match-beginning 0))
 		 (goto-char pos)
 		 (error "No match")))))
 	  (t
 	   ;; Normal string-search
 	   (goto-char (point-min))
 	   (if (search-forward s nil t)
 	       (goto-char (match-beginning 0))
 	     (error "No match"))))
 (and (eq major-mode 'org-mode) (org-show-hierarchy-above))))
+(defun org-search-not-link (&rest args)
+"Execute `re-search-forward', but only accept matches that are not a link."
+(catch 'exit
+(let ((pos (point)) p1)
+(while (apply 're-search-forward args)
+	(setq p1 (point))
+	(if (not (save-match-data
+		   (and (re-search-backward "\\[\\[" nil t)
+			(looking-at org-bracket-link-regexp)
+			(<= (match-beginning 0) p1)
+			(>= (match-end 0) p1))))
+	    (progn (goto-char (match-end 0))
+		   (throw 'exit (point)))
+	  (goto-char (match-end 0)))))))
 (defun org-do-occur (regexp &optional cleanup)
 "Call the Emacs command `occur'.
 If CLEANUP is non-nil, remove the printout of the regular expression
 in the *Occur* buffer.  This is useful if the regex is long and not useful
 (mh-show)
 (mh-show-show))
 header-field)))
 (defun org-follow-mhe-link (folder article)
-"Follow an MHE link to FOLDER and ARTICLE."
+"Follow an MHE link to FOLDER and ARTICLE.
-(setq article (org-add-angle-brackets article))
+If ARTICLE is nil FOLDER is shown.  If the configuration variable
+`org-mhe-search-all-folders' is t and `mh-searcher' is pick,
+ARTICLE is searched in all folders.  Indexed searches (swish++,
+namazu, and others supported by MH-E) will always search in all
+folders."
 (require 'mh-e)
 (require 'mh-search)
+(require 'mh-utils)
 (mh-find-path)
-(mh-search-choose)
+(if (not article)
-(if (equal mh-searcher 'pick)
+(mh-visit-folder (mh-normalize-folder-name folder))
-(progn
+(setq article (org-add-angle-brackets article))
-(mh-search folder (list "--message-id" article))
+(mh-search-choose)
-(when (and org-mhe-search-all-folders
+(if (equal mh-searcher 'pick)
-(not (org-mhe-get-message-real-folder)))
+(progn
-(kill-this-buffer)
+(mh-search folder (list "--message-id" article))
-(mh-search "+" (list "--message-id" article))))
+(when (and org-mhe-search-all-folders
-(mh-search "+" article))
+(not (org-mhe-get-message-real-folder)))
-(if (org-mhe-get-message-real-folder)
+(kill-this-buffer)
-(mh-show-msg 1)
+(mh-search "+" (list "--message-id" article))))
-(kill-this-buffer)
+(mh-search "+" article))
-(error "Message not found")))
+(if (org-mhe-get-message-real-folder)
+(mh-show-msg 1)
+(kill-this-buffer)
+(error "Message not found"))))
 (defun org-open-file (path &optional in-emacs line search)
 "Open the file at PATH.
 First, this expands any special file name abbreviations.  Then the
 configuration variable `org-file-apps' is checked if it contains an
 (defun org-convert-to-odd-levels ()
 "Convert an org-mode file with all levels allowed to one with odd levels.
 This will leave level 1 alone, convert level 2 to level 3, level 3 to
 level 5 etc."
 (interactive)
-(when (yes-or-no-p "Are you sure you want to globally change levels? ")
+(when (yes-or-no-p "Are you sure you want to globally change levels to odd? ")
 (let ((org-odd-levels-only nil) n)
 (save-excursion
 	(goto-char (point-min))
 	(while (re-search-forward "^\\*\\*+" nil t)
 	  (setq n (1- (length (match-string 0))))
 	  (while (>= (setq n (1- n)) 0)
 	    (org-demote))
+	  (end-of-line 1))))))
+(defun org-convert-to-oddeven-levels ()
+"Convert an org-mode file with only odd levels to one with odd and even levels.
+This promotes level 3 to level 2, level 5 to level 3 etc.  If the file contains a
+section with an even level, conversion would destroy the structure of the file.  An error
+is signaled in this case."
+(interactive)
+(goto-char (point-min))
+;; First check if there are no even levels
+(when (re-search-forward "^\\(\\*\\*\\)+[^*]" nil t)
+(org-show-hierarchy-above)
+(error "Not all levels are odd in this file.  Conversion not possible."))
+(when (yes-or-no-p "Are you sure you want to globally change levels to odd-even? ")
+(let ((org-odd-levels-only nil) n)
+(save-excursion
+	(goto-char (point-min))
+	(while (re-search-forward "^\\*\\*+" nil t)
+	  (setq n (/ (length (match-string 0)) 2))
+	  (while (>= (setq n (1- n)) 0)
+	    (org-promote))
 	  (end-of-line 1))))))
 (defun org-tr-level (n)
 "Make N odd if required."
 (if org-odd-levels-only (1+ (/ n 2)) n))
 #+TEXT:      Some descriptive text to be emitted.  Several lines OK.
 #+OPTIONS:   H:%d num:%s toc:%s \\n:%s @:%s ::%s |:%s ^:%s *:%s TeX:%s
 #+CATEGORY:  %s
 #+SEQ_TODO:  %s
 #+TYP_TODO:  %s
-#+STARTUP:   %s %s
+#+STARTUP:   %s %s %s %s
 #+ARCHIVE:   %s
 "
 (buffer-name) (user-full-name) user-mail-address org-export-default-language
 org-export-headline-levels
 org-export-with-section-numbers
 (mapconcat 'identity org-todo-keywords " ")
 "Me Jason Marie DONE")
 (cdr (assoc org-startup-folded
 	       '((nil . "nofold")(t . "fold")(content . "content"))))
 (if org-startup-with-deadline-check "dlcheck" "nodlcheck")
+(if org-odd-levels-only "odd" "oddeven")
+(if org-hide-leading-stars "hidestars" "showstars")
 org-archive-location
 ))
 (defun org-insert-export-options-template ()
 "Insert into the buffer a template with information for exporting."
 (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* ((style org-export-html-style)
+	 (odd org-odd-levels-only)
 	 (region-p (org-region-active-p))
 (region
 (buffer-substring
 (if region-p (region-beginning) (point-min))
 (if region-p (region-end) (point-max))))
 (if (or hidden (not org-export-html-show-new-buffer))
 (set-buffer buffer)
 (switch-to-buffer-other-window buffer))
 (erase-buffer)
 (fundamental-mode)
-(let ((case-fold-search nil))
+(let ((case-fold-search nil)
+	  (org-odd-levels-only odd))
 (if options (org-parse-export-options options))
 (setq umax (if arg (prefix-numeric-value arg)
 org-export-headline-levels))
 ;; File header
 ["Demote Heading"  org-metaright (not (org-at-table-p))]
 ["Demote Subtree"  org-shiftmetaright (not (org-at-table-p))]
 "--"
 ["Archive Subtree" org-archive-subtree t]
 "--"
-["Convert file to odd levels" org-convert-to-odd-levels t])
+["Convert to odd levels" org-convert-to-odd-levels t]
+["Convert to odd/even levels" org-convert-to-oddeven-levels t])
 "--"
 ("TODO Lists"
 ["TODO/DONE/-" org-todo t]
 ["Show TODO Tree" org-show-todo-tree t]
 ["Global TODO list" org-todo-list t]
 (run-hooks 'org-load-hook)
 ;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd
 ;;; org.el ends here

Mercurial > emacs

comparison lisp/textmodes/org.el @ 69454:d60237bf3ccc