comparison lisp/textmodes/org.el @ 70064:28d6f65fa9e6

(org-insert-heading): Insert heading before current if at beginning of line. (org-todo, org-date): New faces. (org-table-align): Make sure tooltip window contains full text. (org-no-properties): New defsubst. (org-set-font-lock-defaults): Use new faces.

70063:be502e8c29ea

;; 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.23
;;
;; 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.23
;;    - Bug fixes.
;;
;; Version 4.22
;;    - Bug fixes.

(defvar calc-embedded-open-formula)   ; defined by the calc package
(defvar font-lock-unfontify-region-function) ; defined by font-lock.el

;;; Customization variables

(defvar org-version "4.23"
  "The version number of the file org.el.")
(defun org-version ()
  (interactive)
  (message "Org-mode version %s" org-version))

  :type 'boolean)

(defcustom org-startup-align-all-tables nil
  "Non-nil means, align all tables when visiting a file.
This is useful when the column width in tables is forced with <N> cookies
in table fields.  Such tables will look correct only after the first re-align."
  :group 'org-startup
  :type 'boolean)

(defcustom org-startup-with-deadline-check nil
  "Non-nil means, entering Org-mode will run the deadline check.
This means, if you start editing an org file, you will get an
immediate reminder of any due deadlines.
This can also be configured on a per-file basis by adding one of
the following lines anywhere in the buffer:

   #+STARTUP: dlcheck
   #+STARTUP: nodlcheck"
  :group 'org-startup
  :type 'boolean)

  "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 also in regions already fontified."
  :group 'org-edit-structure
  :group 'org-font-lock
  :type 'boolean)

(defcustom org-adapt-indentation t

closing date."
  :group 'org-todo
  :type 'boolean)

(defgroup org-priorities nil
  "Keywords in Org-mode."
  :tag "Org Priorities"
  :group 'org-todo)

(defcustom org-default-priority ?B
  "The default priority of TODO items.

moved to the new date."
  :group 'org-time
  :type 'boolean)

(defgroup org-tags nil
  "Options concerning startup of Org-mode."
  :tag "Org Tags"
  :group 'org)

(defcustom org-tags-column 48
  "The column to which tags should be indented 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.

    (((class color) (background dark)) (:foreground "Cyan" :underline t))
    (t (:bold t)))
  "Face for links."
  :group 'org-faces)

(defface org-tag
  '((((type tty) (class color)) (:weight bold))
    (((class color) (background light)) (:weight bold))
    (((class color) (background dark)) (:weight bold))
    (t (:bold t)))
  "Face for tags."
  :group 'org-faces)

(defface org-done ;; font-lock-type-face
  '((((type tty) (class color)) (:foreground "green"))
    (((class color) (background light)) (:foreground "ForestGreen" :bold t))

      (let ((s (match-string num string)))
	(remove-text-properties 0 (length s) org-rm-props s)
	s)
    (match-string-no-properties num string)))

(defun org-current-time ()
  "Current time, possibly rounded to `org-time-stamp-rounding-minutes'."
  (if (> org-time-stamp-rounding-minutes 0)
      (let ((r org-time-stamp-rounding-minutes)
	    (time (decode-time)))

	t)))

(defun org-activate-bracket-links (limit)
  "Run through the buffer and add overlays to bracketed links."
  (if (re-search-forward org-bracket-link-regexp limit t)
      (let* ((help (concat "LINK: " (org-match-string-no-properties 1)))
	     (ip (list 'invisible 'org-link 'intangible t 'rear-nonsticky t
		       'keymap org-mouse-map 'mouse-face 'highlight
		       'help-echo help))
	     (vp (list 'rear-nonsticky t
		       'keymap org-mouse-map 'mouse-face 'highlight

	     (1 'org-table))
	   (if (memq 'angle lk) '(org-activate-angle-links (0 'org-link t)))
	   (if (memq 'plain lk) '(org-activate-plain-links (0 'org-link t)))
	   (if (memq 'bracket lk) '(org-activate-bracket-links (0 'org-link t)))
	   (if (memq 'radio lk) '(org-activate-target-links (0 'org-link t)))
	   (if (memq 'date lk) '(org-activate-dates (0 'org-link t)))
	   (if (memq 'camel lk) '(org-activate-camels (0 'org-link t)))
	   (if (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend)))
	   (if org-table-limit-column-width
	       '(org-hide-wide-columns (0 nil append)))
	   (list (concat "^\\*+[ \t]*" org-not-done-regexp)
		 '(1 'org-warning t))
	   (list (concat "\\[#[A-Z]\\]") '(0 'org-special-keyword t))
	   (list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t))
	   (list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t))
	   (list (concat "\\<" org-closed-string) '(0 'org-special-keyword t))
	   (if em '("\\(\\W\\|^\\)\\(\\*\\w+\\*\\)\\(\\W\\|$\\)" 2 'bold prepend))

		   '(1 'org-done t)))
	   '("^[ \t]*\\(:.*\\)" (1 'org-table t))
	   '("| *\\(:?=[^|\n]*\\)" (1 'org-formula t))
	   '("^[ \t]*| *\\([#!$*_^]\\) *|" (1 'org-formula t))
	   (if org-format-transports-properties-p
	       '("| *\\(<[0-9]+>\\) *|" (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)

		   (condition-case nil
		       (org-back-to-heading)
		     (error (outline-next-heading)))
		   (prog1 (match-string 0)
		     (funcall outline-level)))))
      (unless (bolp) (newline))
      (insert head)
      (if (looking-at "[ \t]*")
	  (replace-match " "))
      (run-hooks 'org-insert-heading-hook))))

			 (if buffer-file-name
			     (file-name-sans-extension
			      (file-name-nondirectory buffer-file-name))
			   "")))
	   (tag (if tags (nth (1- (length tags)) tags) ""))
	   ;;(tag (or (nth (1- (or (length tags) 0)) tags) ""))  FIXME: rm
	   time              ;; needed for the eval of the prefix format
	   (ts (if dotime (concat (if (stringp dotime) dotime "") txt)))
	   (time-of-day (and dotime (org-get-time-of-day ts)))
	   stamp plain s0 s1 s2 rtn)
      (when (and dotime time-of-day org-prefix-has-time)

	  (if (or (not org-confirm-shell-links)
		  (funcall org-confirm-shell-links
			   (format "Execute \"%s\" in shell? "
				   (org-add-props cmd nil
				     'face 'org-warning))))
	      (shell-command cmd)
	    (error "Abort"))))

       (t
	(browse-url-at-point))))))

	  (loop for xx in column do
		(when (and (stringp xx)
			   (> (org-string-width xx) fmax))
		  (org-add-props xx nil
		    'help-echo
		    (concat "Clipped table field, use C-c ` to edit. Full value is:\n" (copy-sequence xx)))
		  (setq f1 (min fmax (or (string-match org-bracket-link-regexp xx) fmax)))
		  (unless (> f1 1)
		    (error "Cannot narrow field starting with wide link \"%s\""
			   (match-string 0 xx)))
		  (add-text-properties f1 (length xx) (list 'org-cwidth t) xx)

		(setq rpl (if (and org-export-html-inline-images
				   file-is-image-p)
			      (concat "<img src=\"" thefile "\"/>")
			    (concat "<a href=\"" thefile "\">" desc "</a>")))))
	     ((member type '("bbdb" "vm" "wl" "mhe" "rmail" "gnus" "shell"))
	      (setq rpl (concat "<i>&lt;" type ":" path "&gt;</i>"))))
	    ;; FIXME: We get to see the escaped links!!!!!
	    (setq line (replace-match rpl t t line)
		  start (+ start (length rpl))))
	  ;; TODO items
	  (if (and (string-match org-todo-line-regexp line)
		   (match-beginning 2))

70064:28d6f65fa9e6

;; 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.24
;;
;; 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.24
;;    - Bug fixes.
;;
;; Version 4.23
;;    - Bug fixes.
;;
;; Version 4.22
;;    - Bug fixes.

(defvar calc-embedded-open-formula)   ; defined by the calc package
(defvar font-lock-unfontify-region-function) ; defined by font-lock.el

;;; Customization variables

(defvar org-version "4.24"
  "The version number of the file org.el.")
(defun org-version ()
  (interactive)
  (message "Org-mode version %s" org-version))

  :type 'boolean)

(defcustom org-startup-align-all-tables nil
  "Non-nil means, align all tables when visiting a file.
This is useful when the column width in tables is forced with <N> cookies
in table fields.  Such tables will look correct only after the first re-align.
This can also be configured on a per-file basis by adding one of
the following lines anywhere in the buffer:
   #+STARTUP: align
   #+STARTUP: noalign"
  :group 'org-startup
  :type 'boolean)

(defcustom org-startup-with-deadline-check nil
  "Non-nil means, entering Org-mode will run the deadline check.
This means, if you start editing an org file, you will get an
immediate reminder of any due deadlines.
This can also be configured on a per-file basis by adding one of
the following lines anywhere in the buffer:
   #+STARTUP: dlcheck
   #+STARTUP: nodlcheck"
  :group 'org-startup
  :type 'boolean)

  "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 also in regions already fontified.
You may also set this on a per-file basis by adding one of the following
lines to the buffer:

   #+STARTUP: odd
   #+STARTUP: oddeven"
  :group 'org-edit-structure
  :group 'org-font-lock
  :type 'boolean)

(defcustom org-adapt-indentation t

closing date."
  :group 'org-todo
  :type 'boolean)

(defgroup org-priorities nil
  "Priorities in Org-mode."
  :tag "Org Priorities"
  :group 'org-todo)

(defcustom org-default-priority ?B
  "The default priority of TODO items.

moved to the new date."
  :group 'org-time
  :type 'boolean)

(defgroup org-tags nil
  "Options concerning tags in Org-mode."
  :tag "Org Tags"
  :group 'org)

(defcustom org-tags-column 48
  "The column to which tags should be indented 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.
You may also set this on a per-file basis by adding one of the following
lines to the buffer:

   #+STARTUP: hidestars
   #+STARTUP: showstars"
  :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.

    (((class color) (background dark)) (:foreground "Cyan" :underline t))
    (t (:bold t)))
  "Face for links."
  :group 'org-faces)

(defface org-date
  '((((type tty) (class color)) (:foreground "cyan" :weight bold))
    (((class color) (background light)) (:foreground "Purple" :underline t))
    (((class color) (background dark)) (:foreground "Cyan" :underline t))
    (t (:bold t)))
  "Face for links."
  :group 'org-faces)

(defface org-tag
  '((((type tty) (class color)) (:weight bold))
    (((class color) (background light)) (:weight bold))
    (((class color) (background dark)) (:weight bold))
    (t (:bold t)))
  "Face for tags."
  :group 'org-faces)

(defface org-todo ;; 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 TODO keywords."
  :group 'org-faces)

(defface org-done ;; font-lock-type-face
  '((((type tty) (class color)) (:foreground "green"))
    (((class color) (background light)) (:foreground "ForestGreen" :bold t))

      (let ((s (match-string num string)))
	(remove-text-properties 0 (length s) org-rm-props s)
	s)
    (match-string-no-properties num string)))

(defsubst org-no-properties (s)
  (remove-text-properties 0 (length s) org-rm-props s)
  s)

(defun org-current-time ()
  "Current time, possibly rounded to `org-time-stamp-rounding-minutes'."
  (if (> org-time-stamp-rounding-minutes 0)
      (let ((r org-time-stamp-rounding-minutes)
	    (time (decode-time)))

	t)))

(defun org-activate-bracket-links (limit)
  "Run through the buffer and add overlays to bracketed links."
  (if (re-search-forward org-bracket-link-regexp limit t)
      (let* ((help (concat "LINK: "
			   (org-match-string-no-properties 1)))
	     ;; FIXME: above we should remove the escapes.
	     (ip (list 'invisible 'org-link 'intangible t 'rear-nonsticky t
		       'keymap org-mouse-map 'mouse-face 'highlight
		       'help-echo help))
	     (vp (list 'rear-nonsticky t
		       'keymap org-mouse-map 'mouse-face 'highlight

	     (1 'org-table))
	   (if (memq 'angle lk) '(org-activate-angle-links (0 'org-link t)))
	   (if (memq 'plain lk) '(org-activate-plain-links (0 'org-link t)))
	   (if (memq 'bracket lk) '(org-activate-bracket-links (0 'org-link t)))
	   (if (memq 'radio lk) '(org-activate-target-links (0 'org-link t)))
	   (if (memq 'date lk) '(org-activate-dates (0 'org-date t)))
	   (if (memq 'camel lk) '(org-activate-camels (0 'org-link t)))
	   (if (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend)))
	   (if org-table-limit-column-width
	       '(org-hide-wide-columns (0 nil append)))
	   (list (concat "^\\*+[ \t]*" org-not-done-regexp)
		 '(1 'org-todo t))
	   (list (concat "\\[#[A-Z]\\]") '(0 'org-special-keyword t))
	   (list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t))
	   (list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t))
	   (list (concat "\\<" org-closed-string) '(0 'org-special-keyword t))
	   (if em '("\\(\\W\\|^\\)\\(\\*\\w+\\*\\)\\(\\W\\|$\\)" 2 'bold prepend))

		   '(1 'org-done t)))
	   '("^[ \t]*\\(:.*\\)" (1 'org-table t))
	   '("| *\\(:?=[^|\n]*\\)" (1 'org-formula t))
	   '("^[ \t]*| *\\([#!$*_^]\\) *|" (1 'org-formula t))
	   (if org-format-transports-properties-p
	       '("| *\\(<[0-9]+>\\) *" (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)

		   (condition-case nil
		       (org-back-to-heading)
		     (error (outline-next-heading)))
		   (prog1 (match-string 0)
		     (funcall outline-level)))))
      (if (and (bolp) 
	       (save-excursion (backward-char 1) (not (org-invisible-p))))
	  (open-line 1)
	(newline))
      (insert head)
      (if (looking-at "[ \t]*")
	  (replace-match " "))
      (run-hooks 'org-insert-heading-hook))))

			 (if buffer-file-name
			     (file-name-sans-extension
			      (file-name-nondirectory buffer-file-name))
			   "")))
	   (tag (if tags (nth (1- (length tags)) tags) ""))
	   time              ;; needed for the eval of the prefix format
	   (ts (if dotime (concat (if (stringp dotime) dotime "") txt)))
	   (time-of-day (and dotime (org-get-time-of-day ts)))
	   stamp plain s0 s1 s2 rtn)
      (when (and dotime time-of-day org-prefix-has-time)

	  (if (or (not org-confirm-shell-links)
		  (funcall org-confirm-shell-links
			   (format "Execute \"%s\" in shell? "
				   (org-add-props cmd nil
				     'face 'org-warning))))
	      (progn
		(message "Executing %s..." cmd)
		(shell-command cmd)
		(message "Executing %s...done" cmd))
	    (error "Abort"))))

       (t
	(browse-url-at-point))))))

	  (loop for xx in column do
		(when (and (stringp xx)
			   (> (org-string-width xx) fmax))
		  (org-add-props xx nil
		    'help-echo
		    (concat "Clipped table field, use C-c ` to edit. Full value is:\n" (org-no-properties (copy-sequence xx))))
		  (setq f1 (min fmax (or (string-match org-bracket-link-regexp xx) fmax)))
		  (unless (> f1 1)
		    (error "Cannot narrow field starting with wide link \"%s\""
			   (match-string 0 xx)))
		  (add-text-properties f1 (length xx) (list 'org-cwidth t) xx)

		(setq rpl (if (and org-export-html-inline-images
				   file-is-image-p)
			      (concat "<img src=\"" thefile "\"/>")
			    (concat "<a href=\"" thefile "\">" desc "</a>")))))
	     ((member type '("bbdb" "vm" "wl" "mhe" "rmail" "gnus" "shell"))
	      (setq rpl (concat "<i>&lt;" type ":"
				(save-match-data (org-link-unescape path))
				"&gt;</i>"))))
	    (setq line (replace-match rpl t t line)
		  start (+ start (length rpl))))
	  ;; TODO items
	  (if (and (string-match org-todo-line-regexp line)
		   (match-beginning 2))