comparison lisp/textmodes/org.el @ 68171:0164d7cc3832

(org-open-file): Use mailcap for selecting an application. (org-file-apps-defaults-gnu): Use mailcap as the default for selecting an application on a UNIX system. (org-agenda-show-tags): New command. (org-table-insert-hline): Keep cursor in current table line. (org-table-convert): Offset effect of modifying `org-table-insert-hline'. (org-format-agenda-item): New optional argument TAG. (org-compile-prefix-format): Handle %T format for the tag. (org-expand-wide-chars): New function. (org-table-insert-row, org-table-insert-hline): Use `org-expand-wide-chars'. (org-open-file): Fixed bug in program launch. (org-get-time-of-day): Fixed bug with times before 1am. (org-agenda-menu): Addes tags commands.

68170:c49519c91e45

;; Copyright (c) 2004, 2005, 2006 Free Software Foundation
;;
;; 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.02
;;
;; 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.02
;;    - Minor bug fixes and improvements around tag searches.
;;    - XEmacs compatibility fixes.
;;
;; Version 4.01

(defvar calc-embedded-open-formula)
(defvar font-lock-unfontify-region-function)

;;; Customization variables

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

  "Format specification for the prefix of items in the agenda buffer.
This format works similar to a printf format, with the following meaning:

  %c   the category of the item, \"Diary\" for entries from the diary, or
       as given by the CATEGORY keyword or derived from the file name.
  %t   the time-of-day specification if one applies to the entry, in the
       format HH:MM
  %s   Scheduling/Deadline information, a short string

All specifiers work basically like the standard `%s' of printf, but may

The default is true, to keep new users from shooting into their own foot."
  :group 'org-link
  :type 'boolean)

(defconst org-file-apps-defaults-gnu
  '((t        . emacs)
    ("jpg"    . "xv %s")
    ("gif"    . "xv %s")
    ("ppm"    . "xv %s")
    ("pgm"    . "xv %s")
    ("pbm"    . "xv %s")
    ("tif"    . "xv %s")
    ("png"    . "xv %s")
    ("ps"     . "gv %s")
    ("ps.gz"  . "gv %s")
    ("eps"    . "gv %s")
    ("eps.gz" . "gv %s")
    ("dvi"    . "xdvi %s")
    ("mpeg"   . "plaympeg %s")
    ("mp3"    . "plaympeg %s")
    ("fig"    . "xfig %s")
    ("pdf"    . "acroread %s")
    ("doc"    . "soffice %s")
    ("ppt"    . "soffice %s")
    ("pps"    . "soffice %s")
    ("html"   . "netscape -remote openURL(%s,new-window)")
    ("htm"    . "netscape -remote openURL(%s,new-window)")
    ("xs"     . "soffice %s"))
  "Default file applications on a UNIX/LINUX system.
See `org-file-apps'.")

(defconst org-file-apps-defaults-macosx
  '((t        . "open %s")

(define-key org-agenda-mode-map "g" 'org-agenda-toggle-time-grid)
(define-key org-agenda-mode-map "r" 'org-agenda-redo)
(define-key org-agenda-mode-map "q" 'org-agenda-quit)
(define-key org-agenda-mode-map "x" 'org-agenda-exit)
(define-key org-agenda-mode-map "P" 'org-agenda-show-priority)
(define-key org-agenda-mode-map "n" 'next-line)
(define-key org-agenda-mode-map "p" 'previous-line)
(define-key org-agenda-mode-map "\C-n" 'org-agenda-next-date-line)
(define-key org-agenda-mode-map "\C-p" 'org-agenda-previous-date-line)
(define-key org-agenda-mode-map "," 'org-agenda-priority)

    ["Go To (one window)" org-agenda-switch-to t]
    ["Follow Mode" org-agenda-follow-mode
     :style toggle :selected org-agenda-follow-mode :active t]
    "--"
    ["Cycle TODO" org-agenda-todo t]
    ["Set Tags" org-agenda-set-tags t]
    ("Reschedule"
     ["Reschedule +1 day" org-agenda-date-later (org-agenda-check-type nil 'agenda 'timeline)]
     ["Reschedule -1 day" org-agenda-date-earlier (org-agenda-check-type nil 'agenda 'timeline)]
     "--"
     ["Reschedule to ..." org-agenda-date-prompt (org-agenda-check-type nil 'agenda 'timeline)])

    (when entries
      (setq entries (org-split-string entries "\n"))
      (setq entries
	    (mapcar
	     (lambda (x)
	       (setq x (org-format-agenda-item "" x "Diary" 'time))
	       ;; Extend the text properties to the beginning of the line
	       (add-text-properties
		0 (length x)
		(text-properties-at (1- (length x)) x)
		x)

			 (if org-select-this-todo-keyword
			     (concat "\\<\\(" org-select-this-todo-keyword
				     "\\)\\>")
			   org-not-done-regexp)
			 "[^\n\r]*\\)"))
	 marker priority category
	 ee txt)
    (goto-char (point-min))
    (while (re-search-forward regexp nil t)
      (goto-char (match-beginning 1))
      (setq marker (org-agenda-new-marker (1+ (match-beginning 0)))
	    category (org-get-category)
	    txt (org-format-agenda-item "" (match-string 1) category)
	    priority
	    (+ (org-get-priority txt)
	       (if org-todo-kwd-priority-p
                   (- org-todo-kwd-max-priority -2
                      (length

		    (car org-time-stamp-formats)
		    (apply 'encode-time  ; DATE bound by calendar
			   (list 0 0 0 (nth 1 date) (car date) (nth 2 date))))
		   0 11)))
	 marker hdmarker deadlinep scheduledp donep tmp priority category
	 ee txt timestr)
    (goto-char (point-min))
    (while (re-search-forward regexp nil t)
      (if (not (save-match-data (org-at-date-range-p)))
	  (progn
	    (setq marker (org-agenda-new-marker (match-beginning 0))

		(setq timestr (substring timestr 0 (match-end 0))))
	    (save-excursion
	      (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t)
		  (progn
		    (goto-char (match-end 1))
		    (setq hdmarker (org-agenda-new-marker))
		    (looking-at "\\*+[ \t]*\\([^\r\n]+\\)")
		    (setq txt (org-format-agenda-item
			       (format "%s%s"
				       (if deadlinep  "Deadline:  " "")
				       (if scheduledp "Scheduled: " ""))
			       (match-string 1) category timestr)))
		(setq txt org-agenda-no-heading-message))
	      (setq priority (org-get-priority txt))
	      (add-text-properties
	       0 (length txt) (append (list 'org-marker marker
					    'org-hd-marker hdmarker) props)

		    (format-time-string
		     (car org-time-stamp-formats)
		     (apply 'encode-time  ; DATE bound by calendar
			    (list 0 0 0 (nth 1 date) (car date) (nth 2 date))))
		    1 11))))
	 marker hdmarker priority category
	 ee txt timestr)
    (goto-char (point-min))
    (while (re-search-forward regexp nil t)
      (if (not (save-match-data (org-at-date-range-p)))
	  (progn

		(setq timestr (substring timestr 0 (match-end 0))))
	    (save-excursion
	      (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t)
		  (progn
		    (goto-char (match-end 1))
		    (setq hdmarker (org-agenda-new-marker))
		    (looking-at "\\*+[ \t]*\\([^\r\n]+\\)")
		    (setq txt (org-format-agenda-item
			       "Closed:    "
			       (match-string 1) category timestr)))
		(setq txt org-agenda-no-heading-message))
	      (setq priority 100000)
	      (add-text-properties
	       0 (length txt) (append (list 'org-marker marker
					    'org-hd-marker hdmarker

		      (format "mouse-2 or RET jump to org file %s"
			      (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
	 ee txt head)
    (goto-char (point-min))
    (while (re-search-forward regexp nil t)
      (setq pos (1- (match-beginning 1))
	    d2 (time-to-days

	    (setq category (org-get-category))
	    (if (re-search-backward "\\(^\\|\r\\)\\*+[ \t]*" nil t)
		(progn
		  (goto-char (match-end 0))
		  (setq pos1 (match-end 1))
		  (setq head (buffer-substring-no-properties
			      (point)
			      (progn (skip-chars-forward "^\r\n")
				     (point))))
		  (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))))
	      (setq txt org-agenda-no-heading-message))
	    (when txt
	      (add-text-properties
	       0 (length txt)
	       (append

		      (format "mouse-2 or RET jump to org file %s"
			      (abbreviate-file-name (buffer-file-name)))))
	 (regexp org-scheduled-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
	 ee txt head)
    (goto-char (point-min))
    (while (re-search-forward regexp nil t)
      (setq pos (1- (match-beginning 1))
	    d2 (time-to-days

	    (setq category (org-get-category))
	    (if (re-search-backward "\\(^\\|\r\\)\\*+[ \t]*" nil t)
		(progn
		  (goto-char (match-end 0))
		  (setq pos1 (match-end 1))
		  (setq head (buffer-substring-no-properties
			      (point)
			      (progn (skip-chars-forward "^\r\n") (point))))
		  (if (string-match org-looking-at-done-regexp head)
		      (setq txt nil)
		    (setq txt (org-format-agenda-item
			       (format "Sched.%2dx: " (- 1 diff)) head 
			       category))))
	      (setq txt org-agenda-no-heading-message))
	    (when txt
	      (add-text-properties
	       0 (length txt)
	       (append (list 'org-marker (org-agenda-new-marker pos)

		      'help-echo
		      (format "mouse-2 or RET jump to org file %s"
			      (abbreviate-file-name (buffer-file-name)))))
	 (regexp org-tr-regexp)
	 (d0 (calendar-absolute-from-gregorian date))
	 marker hdmarker ee txt d1 d2 s1 s2 timestr category)
    (goto-char (point-min))
    (while (re-search-forward regexp nil t)
      (setq timestr (match-string 0)
	    s1 (match-string 1)
	    s2 (match-string 2)

	    (setq category (org-get-category))
	    (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t)
		(progn
		  (setq hdmarker (org-agenda-new-marker (match-end 1)))
		  (goto-char (match-end 1))
		  (looking-at "\\*+[ \t]*\\([^\r\n]+\\)")
		  (setq txt (org-format-agenda-item
			     (format (if (= d1 d2) "" "(%d/%d): ")
				     (1+ (- d0 d1)) (1+ (- d2 d1)))
			     (match-string 1) category
			     (if (= d0 d1) timestr))))
	      (setq txt org-agenda-no-heading-message))
	    (add-text-properties
	     0 (length txt) (append (list 'org-marker marker
					  'org-hd-marker hdmarker

(defvar org-prefix-has-time nil
  "A flag, set by `org-compile-prefix-format'.
The flag is set if the currently compiled format contains a `%t'.")

(defun org-format-agenda-item (extra txt &optional category dotime noprefix)
  "Format TXT to be inserted into the agenda buffer.
In particular, it adds the prefix and corresponding text properties.  EXTRA
must be a string and replaces the `%s' specifier in the prefix format.
CATEGORY (string, symbol or nil) may be used to overule the default
category taken from local variable or file name. It will replace the `%c'
specifier in the format.  DOTIME, when non-nil, indicates that a
time-of-day should be extracted from TXT for sorting of this entry, and for
the `%t' specifier in the format.  When DOTIME is a string, this string is
searched for a time before TXT is.  NOPREFIX is a flag and indicates that
only the correctly processes TXT should be returned - this is used by
`org-agenda-change-all-lines'."
  (save-match-data
    ;; Diary entries sometimes have extra whitespace at the beginning
    (if (string-match "^ +" txt) (setq txt (replace-match "" nil nil txt)))
    (let* ((category (or category
			 org-category
			 (if (buffer-file-name)
			     (file-name-sans-extension
			      (file-name-nondirectory (buffer-file-name)))
			   "")))
	   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)

	(setq rtn (concat (eval org-prefix-format-compiled) txt)))

      ;; And finally add the text properties
      (add-text-properties
       0 (length rtn) (list 'category (downcase category)
			    'prefix-length (- (length rtn) (length txt))
			    'time-of-day time-of-day
			    'dotime dotime)
       rtn)
      rtn)))

	  (throw 'exit list))
      (while (setq time (pop gridtimes))
	(unless (and remove (member time have))
	  (setq time (int-to-string time))
	  (push (org-format-agenda-item
		 nil string "" ;; FIXME: put a category for the grid?
		 (concat (substring time 0 -2) ":" (substring time -2)))
		new)
	  (put-text-property
	   1 (length (car new)) 'face 'org-time-grid (car new))))
      (if (member 'time-up org-agenda-sorting-strategy)

(defun org-compile-prefix-format (format)
  "Compile the prefix format into a Lisp form that can be evaluated.
The resulting form is returned and stored in the variable
`org-prefix-format-compiled'."
  (setq org-prefix-has-time nil)
  (let ((start 0) varform vars var (s format) c f opt)
    (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cts]\\)"
			 s start)
      (setq var (cdr (assoc (match-string 4 s)
			    '(("c" . category) ("t" . time) ("s" . extra))))
	    c (or (match-string 3 s) "")
	    opt (match-beginning 1)
	    start (1+ (match-beginning 0)))
      (if (equal var 'time) (setq org-prefix-has-time t))
      (setq f (concat "%" (match-string 2 s) "s"))

				  (equal (downcase (match-string 4 s)) "pm"))
			     12 0)))
		   (if (match-beginning 3)
		       (string-to-number (match-string 3 s))
		     0)))
	    (t1 (concat " " (int-to-string t0))))
       (if string (concat (substring t1 -4 -2) ":" (substring t1 -2)) t0)))))

(defun org-finalize-agenda-entries (list)
  "Sort and concatenate the agenda items."
  (mapconcat 'identity (sort list 'org-entries-lessp) "\n"))

This priority is composed of the main priority given with the [#A] cookies,
and by additional input from the age of a schedules or deadline entry."
  (interactive)
  (let* ((pri (get-text-property (point-at-bol) 'priority)))
    (message "Priority is %d" (if pri pri -1000))))

(defun org-agenda-goto (&optional highlight)
  "Go to the Org-mode file which contains the item at point."
  (interactive)
  (let* ((marker (or (get-text-property (point) 'org-marker)

The new content of the line will be NEWHEAD (as modified by
`org-format-agenda-item').  HDMARKER is checked with
`equal' against all `org-hd-marker' text properties in the file.
If FIXFACE is non-nil, the face of each item is modified acording to
the new TODO state."
  (let* (props m pl undone-face done-face finish new dotime cat)
;    (setq newhead (org-format-agenda-item "x" newhead "x" nil 'noprefix))
    (save-excursion
      (goto-char (point-max))
      (beginning-of-line 1)
      (while (not finish)

	(when (and (setq m (get-text-property (point) 'org-hd-marker))
		   (equal m hdmarker))
	  (setq props (text-properties-at (point))
		dotime (get-text-property (point) 'dotime)
		cat (get-text-property (point) 'category)
		new (org-format-agenda-item "x" newhead cat dotime 'noprefix)
		pl (get-text-property (point) 'prefix-length)
		undone-face (get-text-property (point) 'undone-face)
		done-face (get-text-property (point) 'done-face))
	  (move-to-column pl)
	  (if (looking-at ".*")

		       ""
		       (concat
			(if org-tags-match-list-sublevels
			    (make-string (1- level) ?.) "")
			(org-get-heading))
		       category))
            (goto-char lspos)
	    (setq marker (org-agenda-new-marker))
	    (add-text-properties
	     0 (length txt) 
	     (append (list 'org-marker marker 'org-hd-marker marker

    (setq apps (append org-file-apps (org-default-apps)))
    (if in-emacs
	(setq cmd 'emacs)
      (setq cmd (or (cdr (assoc ext apps))
		    (cdr (assoc t apps)))))
    (cond
     ((and (stringp cmd) (not (string-match "^\\s-*$" cmd)))
      (setq cmd (format cmd (concat "\"" file "\"")))
      (save-window-excursion
	(shell-command (concat cmd " & &"))))
     ((or (stringp cmd)
	  (eq cmd 'emacs))
      (unless (equal (file-truename file) (file-truename (buffer-file-name)))
	(funcall (cdr (assq 'file org-link-frame-setup)) file))
      (if line (goto-line line)

    ;; for each column
    (setq i -1)
    (while (< (setq i (1+ i)) maxfields)   ;; Loop over all columns
      (setq column (mapcar (lambda (x) (or (nth i x) "")) fields))
      ;; maximum length
      (push (apply 'max 1 (mapcar 'length column)) lengths)
      ;; compute the fraction stepwise, ignoring empty fields
      (setq cnt 0 frac 0.0)
      (mapcar
       (lambda (x)
	 (if (equal x "")

    (skip-chars-backward "^|")
    (backward-char 1)
    (if (looking-at "|[^|\n]+")
	(let* ((pos (match-beginning 0))
	       (match (match-string 0))
	       (len (length match)))
	  (replace-match (concat "|" (make-string (1- len) ?\ )))
	  (goto-char (+ 2 pos))
	  (substring match 1)))))

(defun org-table-get-field (&optional n replace)

  "Insert a new row above the current line into the table.
With prefix ARG, insert below the current line."
  (interactive "P")
  (if (not (org-at-table-p))
      (error "Not at a table"))
  (let* ((line (buffer-substring-no-properties (point-at-bol) (point-at-eol)))
	 new)
    (if (string-match "^[ \t]*|-" line)
	(setq new (mapcar (lambda (x) (if (member x '(?| ?+)) ?| ?\ )) line))
      (setq new (mapcar (lambda (x) (if (equal x ?|) ?| ?\ )) line)))
    ;; Fix the first field if necessary

  "Insert a horizontal-line below the current line into the table.
With prefix ARG, insert above the current line."
  (interactive "P")
  (if (not (org-at-table-p))
      (error "Not at a table"))
  (let ((line (buffer-substring-no-properties (point-at-bol) (point-at-eol)))
	(col (current-column))
	start)
    (if (string-match "^[ \t]*|-" line)
	(setq line
	      (mapcar (lambda (x) (if (member x '(?| ?+))

    (beginning-of-line (if arg 1 2))
    (apply 'insert line)
    (if (equal (char-before (point)) ?+)
	(progn (backward-delete-char 1) (insert "|")))
    (insert "\n")
    (beginning-of-line 0)
    (move-to-column col)))

(defun org-table-kill-row ()
  "Delete the current row or horizontal line from the table."
  (interactive)
  (if (not (org-at-table-p))

	  (while (re-search-forward "^\\([ \t]*\\)|-.*\n" end t)
	    (replace-match ""))
	  ;; insert a hline before first
	  (goto-char beg)
	  (org-table-insert-hline 'above)
	  ;; insert a hline after each line
	  (while (progn (beginning-of-line 2) (< (point) end))
	    (org-table-insert-hline))
	  (goto-char beg)
	  (setq end (move-marker end (org-table-end)))
	  ;; replace "+" at beginning and ending of hlines
	  (while (re-search-forward "^\\([ \t]*\\)|-" end t)

wrapped to the length of that word.
IF WIDTH is nil and LINES is non-nil, the string is forced into at most that
many lines, whatever width that takes.
The return value is a list of lines, without newlines at the end."
  (let* ((words (org-split-string string "[ \t\n]+"))
	 (maxword (apply 'max (mapcar 'length words)))
	 w ll)
    (cond (width
	   (org-do-wrap words (max maxword width)))
	  (lines
	   (setq w maxword)

;;; Key bindings

;; - Bindings in Org-mode map are currently
;;   0123456789abcdefghijklmnopqrstuvwxyz!?@#$%^&-+*/=()_{}[]:;"|,.<>~`'\t  the alphabet
;;             abcd fgh j lmnopqrstuvwxyz ? #$   -+*/=     [] ; |,.<>~  \t  necessary bindings
;;                 e                                                        (?) useful from outline-mode
;;                     i k                 @                                expendable from outline-mode
;;   0123456789                          !    %^&     ()_{}    "      `'    free

;; Make `C-c C-x' a prefix key
(define-key org-mode-map "\C-c\C-x" (make-sparse-keymap))

;; TAB key with modifiers

(run-hooks 'org-load-hook)

;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd
;;; org.el ends here

68171:0164d7cc3832

;; Copyright (c) 2004, 2005, 2006 Free Software Foundation
;;
;; 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.03
;;
;; 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.03
;;    - Table alignment fixed for use with wide characters.
;;    - `C-c -' leaves cursor in current table line.
;;    - The current TAG can be incorporated into the agenda prefix.
;;      See option `org-agenda-prefix-format' for details.
;;
;; Version 4.02
;;    - Minor bug fixes and improvements around tag searches.
;;    - XEmacs compatibility fixes.
;;
;; Version 4.01

(defvar calc-embedded-open-formula)
(defvar font-lock-unfontify-region-function)

;;; Customization variables

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

  "Format specification for the prefix of items in the agenda buffer.
This format works similar to a printf format, with the following meaning:

  %c   the category of the item, \"Diary\" for entries from the diary, or
       as given by the CATEGORY keyword or derived from the file name.
  %T   the first tag of the item.
  %t   the time-of-day specification if one applies to the entry, in the
       format HH:MM
  %s   Scheduling/Deadline information, a short string

All specifiers work basically like the standard `%s' of printf, but may

The default is true, to keep new users from shooting into their own foot."
  :group 'org-link
  :type 'boolean)

(defconst org-file-apps-defaults-gnu
  '((t . mailcap))
  "Default file applications on a UNIX/LINUX system.
See `org-file-apps'.")

(defconst org-file-apps-defaults-macosx
  '((t        . "open %s")

(define-key org-agenda-mode-map "g" 'org-agenda-toggle-time-grid)
(define-key org-agenda-mode-map "r" 'org-agenda-redo)
(define-key org-agenda-mode-map "q" 'org-agenda-quit)
(define-key org-agenda-mode-map "x" 'org-agenda-exit)
(define-key org-agenda-mode-map "P" 'org-agenda-show-priority)
(define-key org-agenda-mode-map "T" 'org-agenda-show-tags)
(define-key org-agenda-mode-map "n" 'next-line)
(define-key org-agenda-mode-map "p" 'previous-line)
(define-key org-agenda-mode-map "\C-n" 'org-agenda-next-date-line)
(define-key org-agenda-mode-map "\C-p" 'org-agenda-previous-date-line)
(define-key org-agenda-mode-map "," 'org-agenda-priority)

    ["Go To (one window)" org-agenda-switch-to t]
    ["Follow Mode" org-agenda-follow-mode
     :style toggle :selected org-agenda-follow-mode :active t]
    "--"
    ["Cycle TODO" org-agenda-todo t]
    ("Tags"
     ["Show all Tags" org-agenda-show-tags t]
     ["Set Tags" org-agenda-set-tags t])
    ("Reschedule"
     ["Reschedule +1 day" org-agenda-date-later (org-agenda-check-type nil 'agenda 'timeline)]
     ["Reschedule -1 day" org-agenda-date-earlier (org-agenda-check-type nil 'agenda 'timeline)]
     "--"
     ["Reschedule to ..." org-agenda-date-prompt (org-agenda-check-type nil 'agenda 'timeline)])

    (when entries
      (setq entries (org-split-string entries "\n"))
      (setq entries
	    (mapcar
	     (lambda (x)
	       (setq x (org-format-agenda-item "" x "Diary" nil 'time))
	       ;; Extend the text properties to the beginning of the line
	       (add-text-properties
		0 (length x)
		(text-properties-at (1- (length x)) x)
		x)

			 (if org-select-this-todo-keyword
			     (concat "\\<\\(" org-select-this-todo-keyword
				     "\\)\\>")
			   org-not-done-regexp)
			 "[^\n\r]*\\)"))
	 marker priority category tags
	 ee txt)
    (goto-char (point-min))
    (while (re-search-forward regexp nil t)
      (goto-char (match-beginning 1))
      (setq marker (org-agenda-new-marker (1+ (match-beginning 0)))
	    category (org-get-category)
	    tags (org-get-tags-at (point))
	    txt (org-format-agenda-item "" (match-string 1) category tags)
	    priority
	    (+ (org-get-priority txt)
	       (if org-todo-kwd-priority-p
                   (- org-todo-kwd-max-priority -2
                      (length

		    (car org-time-stamp-formats)
		    (apply 'encode-time  ; DATE bound by calendar
			   (list 0 0 0 (nth 1 date) (car date) (nth 2 date))))
		   0 11)))
	 marker hdmarker deadlinep scheduledp donep tmp priority category
	 ee txt timestr tags)
    (goto-char (point-min))
    (while (re-search-forward regexp nil t)
      (if (not (save-match-data (org-at-date-range-p)))
	  (progn
	    (setq marker (org-agenda-new-marker (match-beginning 0))

		(setq timestr (substring timestr 0 (match-end 0))))
	    (save-excursion
	      (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t)
		  (progn
		    (goto-char (match-end 1))
		    (setq hdmarker (org-agenda-new-marker)
			  tags (org-get-tags-at))
		    (looking-at "\\*+[ \t]*\\([^\r\n]+\\)")
		    (setq txt (org-format-agenda-item
			       (format "%s%s"
				       (if deadlinep  "Deadline:  " "")
				       (if scheduledp "Scheduled: " ""))
			       (match-string 1) category tags timestr)))
		(setq txt org-agenda-no-heading-message))
	      (setq priority (org-get-priority txt))
	      (add-text-properties
	       0 (length txt) (append (list 'org-marker marker
					    'org-hd-marker hdmarker) props)

		    (format-time-string
		     (car org-time-stamp-formats)
		     (apply 'encode-time  ; DATE bound by calendar
			    (list 0 0 0 (nth 1 date) (car date) (nth 2 date))))
		    1 11))))
	 marker hdmarker priority category tags
	 ee txt timestr)
    (goto-char (point-min))
    (while (re-search-forward regexp nil t)
      (if (not (save-match-data (org-at-date-range-p)))
	  (progn

		(setq timestr (substring timestr 0 (match-end 0))))
	    (save-excursion
	      (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t)
		  (progn
		    (goto-char (match-end 1))
		    (setq hdmarker (org-agenda-new-marker)
			  tags (org-get-tags-at))
		    (looking-at "\\*+[ \t]*\\([^\r\n]+\\)")
		    (setq txt (org-format-agenda-item
			       "Closed:    "
			       (match-string 1) category tags timestr)))
		(setq txt org-agenda-no-heading-message))
	      (setq priority 100000)
	      (add-text-properties
	       0 (length txt) (append (list 'org-marker marker
					    'org-hd-marker hdmarker

		      (format "mouse-2 or RET jump to org file %s"
			      (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)
    (goto-char (point-min))
    (while (re-search-forward regexp nil t)
      (setq pos (1- (match-beginning 1))
	    d2 (time-to-days

	    (setq category (org-get-category))
	    (if (re-search-backward "\\(^\\|\r\\)\\*+[ \t]*" nil t)
		(progn
		  (goto-char (match-end 0))
		  (setq pos1 (match-end 1))
		  (setq tags (org-get-tags-at pos1))
		  (setq head (buffer-substring-no-properties
			      (point)
			      (progn (skip-chars-forward "^\r\n")
				     (point))))
		  (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
	      (add-text-properties
	       0 (length txt)
	       (append

		      (format "mouse-2 or RET jump to org file %s"
			      (abbreviate-file-name (buffer-file-name)))))
	 (regexp org-scheduled-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)
    (goto-char (point-min))
    (while (re-search-forward regexp nil t)
      (setq pos (1- (match-beginning 1))
	    d2 (time-to-days

	    (setq category (org-get-category))
	    (if (re-search-backward "\\(^\\|\r\\)\\*+[ \t]*" nil t)
		(progn
		  (goto-char (match-end 0))
		  (setq pos1 (match-end 1))
		  (setq tags (org-get-tags-at))
		  (setq head (buffer-substring-no-properties
			      (point)
			      (progn (skip-chars-forward "^\r\n") (point))))
		  (if (string-match org-looking-at-done-regexp head)
		      (setq txt nil)
		    (setq txt (org-format-agenda-item
			       (format "Sched.%2dx: " (- 1 diff)) head 
			       category tags))))
	      (setq txt org-agenda-no-heading-message))
	    (when txt
	      (add-text-properties
	       0 (length txt)
	       (append (list 'org-marker (org-agenda-new-marker pos)

		      'help-echo
		      (format "mouse-2 or RET jump to org file %s"
			      (abbreviate-file-name (buffer-file-name)))))
	 (regexp org-tr-regexp)
	 (d0 (calendar-absolute-from-gregorian date))
	 marker hdmarker ee txt d1 d2 s1 s2 timestr category tags)
    (goto-char (point-min))
    (while (re-search-forward regexp nil t)
      (setq timestr (match-string 0)
	    s1 (match-string 1)
	    s2 (match-string 2)

	    (setq category (org-get-category))
	    (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t)
		(progn
		  (setq hdmarker (org-agenda-new-marker (match-end 1)))
		  (goto-char (match-end 1))
		  (setq tags (org-get-tags-at))
		  (looking-at "\\*+[ \t]*\\([^\r\n]+\\)")
		  (setq txt (org-format-agenda-item
			     (format (if (= d1 d2) "" "(%d/%d): ")
				     (1+ (- d0 d1)) (1+ (- d2 d1)))
			     (match-string 1) category tags
			     (if (= d0 d1) timestr))))
	      (setq txt org-agenda-no-heading-message))
	    (add-text-properties
	     0 (length txt) (append (list 'org-marker marker
					  'org-hd-marker hdmarker

(defvar org-prefix-has-time nil
  "A flag, set by `org-compile-prefix-format'.
The flag is set if the currently compiled format contains a `%t'.")

(defun org-format-agenda-item (extra txt &optional category tags dotime noprefix)
  "Format TXT to be inserted into the agenda buffer.
In particular, it adds the prefix and corresponding text properties.  EXTRA
must be a string and replaces the `%s' specifier in the prefix format.
CATEGORY (string, symbol or nil) may be used to overule the default
category taken from local variable or file name. It will replace the `%c'
specifier in the format.  DOTIME, when non-nil, indicates that a
time-of-day should be extracted from TXT for sorting of this entry, and for
the `%t' specifier in the format.  When DOTIME is a string, this string is
searched for a time before TXT is.  NOPREFIX is a flag and indicates that
only the correctly processes TXT should be returned - this is used by
`org-agenda-change-all-lines'. TAG can be the tag of the headline."
  (save-match-data
    ;; Diary entries sometimes have extra whitespace at the beginning
    (if (string-match "^ +" txt) (setq txt (replace-match "" nil nil txt)))
    (let* ((category (or category
			 org-category
			 (if (buffer-file-name)
			     (file-name-sans-extension
			      (file-name-nondirectory (buffer-file-name)))
			   "")))
	   (tag (or (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)

	(setq rtn (concat (eval org-prefix-format-compiled) txt)))

      ;; And finally add the text properties
      (add-text-properties
       0 (length rtn) (list 'category (downcase category)
			    'tags tags
			    'prefix-length (- (length rtn) (length txt))
			    'time-of-day time-of-day
			    'dotime dotime)
       rtn)
      rtn)))

	  (throw 'exit list))
      (while (setq time (pop gridtimes))
	(unless (and remove (member time have))
	  (setq time (int-to-string time))
	  (push (org-format-agenda-item
		 nil string "" nil ;; FIXME: put a category for the grid?
		 (concat (substring time 0 -2) ":" (substring time -2)))
		new)
	  (put-text-property
	   1 (length (car new)) 'face 'org-time-grid (car new))))
      (if (member 'time-up org-agenda-sorting-strategy)

(defun org-compile-prefix-format (format)
  "Compile the prefix format into a Lisp form that can be evaluated.
The resulting form is returned and stored in the variable
`org-prefix-format-compiled'."
  (setq org-prefix-has-time nil)
  (let ((start 0) varform vars var (s format)e c f opt)
    (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cts]\\)"
			 s start)
      (setq var (cdr (assoc (match-string 4 s)
			    '(("c" . category) ("t" . time) ("s" . extra)
			      ("T" . tag))))
	    c (or (match-string 3 s) "")
	    opt (match-beginning 1)
	    start (1+ (match-beginning 0)))
      (if (equal var 'time) (setq org-prefix-has-time t))
      (setq f (concat "%" (match-string 2 s) "s"))

				  (equal (downcase (match-string 4 s)) "pm"))
			     12 0)))
		   (if (match-beginning 3)
		       (string-to-number (match-string 3 s))
		     0)))
	    (t1 (concat " "
			(if (< t0 100) "0" "")
			(int-to-string t0))))
       (if string (concat (substring t1 -4 -2) ":" (substring t1 -2)) t0)))))

(defun org-finalize-agenda-entries (list)
  "Sort and concatenate the agenda items."
  (mapconcat 'identity (sort list 'org-entries-lessp) "\n"))

This priority is composed of the main priority given with the [#A] cookies,
and by additional input from the age of a schedules or deadline entry."
  (interactive)
  (let* ((pri (get-text-property (point-at-bol) 'priority)))
    (message "Priority is %d" (if pri pri -1000))))

(defun org-agenda-show-tags ()
  "Show the tags applicable to the current item."
  (interactive)
  (let* ((tags (get-text-property (point-at-bol) 'tags)))
    (if tags
	(message "Tags are :%s:" (mapconcat 'identity tags ":"))
      (message "No tags associated with this line"))))

(defun org-agenda-goto (&optional highlight)
  "Go to the Org-mode file which contains the item at point."
  (interactive)
  (let* ((marker (or (get-text-property (point) 'org-marker)

The new content of the line will be NEWHEAD (as modified by
`org-format-agenda-item').  HDMARKER is checked with
`equal' against all `org-hd-marker' text properties in the file.
If FIXFACE is non-nil, the face of each item is modified acording to
the new TODO state."
  (let* (props m pl undone-face done-face finish new dotime cat tags)
;    (setq newhead (org-format-agenda-item "x" newhead "x" nil 'noprefix))
    (save-excursion
      (goto-char (point-max))
      (beginning-of-line 1)
      (while (not finish)

	(when (and (setq m (get-text-property (point) 'org-hd-marker))
		   (equal m hdmarker))
	  (setq props (text-properties-at (point))
		dotime (get-text-property (point) 'dotime)
		cat (get-text-property (point) 'category)
		tags (get-text-property (point) 'tags)
		new (org-format-agenda-item "x" newhead cat tags dotime 'noprefix)
		pl (get-text-property (point) 'prefix-length)
		undone-face (get-text-property (point) 'undone-face)
		done-face (get-text-property (point) 'done-face))
	  (move-to-column pl)
	  (if (looking-at ".*")

		       ""
		       (concat
			(if org-tags-match-list-sublevels
			    (make-string (1- level) ?.) "")
			(org-get-heading))
		       category tags-list))
            (goto-char lspos)
	    (setq marker (org-agenda-new-marker))
	    (add-text-properties
	     0 (length txt) 
	     (append (list 'org-marker marker 'org-hd-marker marker

    (setq apps (append org-file-apps (org-default-apps)))
    (if in-emacs
	(setq cmd 'emacs)
      (setq cmd (or (cdr (assoc ext apps))
		    (cdr (assoc t apps)))))
    (when (eq cmd 'mailcap)
      (require 'mailcap)
      (mailcap-parse-mailcaps)
      (let* ((mime-type (mailcap-extension-to-mime (or ext "")))
	     (command (mailcap-mime-info mime-type)))
	(if (stringp command)
	    (setq cmd command)
	  (setq cmd 'emacs))))
    (cond
     ((and (stringp cmd) (not (string-match "^\\s-*$" cmd)))
      (setq cmd (format cmd (concat "\"" file "\"")))
      (save-window-excursion
	(shell-command (concat cmd " &"))))
     ((or (stringp cmd)
	  (eq cmd 'emacs))
      (unless (equal (file-truename file) (file-truename (buffer-file-name)))
	(funcall (cdr (assq 'file org-link-frame-setup)) file))
      (if line (goto-line line)

    ;; for each column
    (setq i -1)
    (while (< (setq i (1+ i)) maxfields)   ;; Loop over all columns
      (setq column (mapcar (lambda (x) (or (nth i x) "")) fields))
      ;; maximum length
      (push (apply 'max 1 (mapcar 'string-width column)) lengths)
      ;; compute the fraction stepwise, ignoring empty fields
      (setq cnt 0 frac 0.0)
      (mapcar
       (lambda (x)
	 (if (equal x "")

    (skip-chars-backward "^|")
    (backward-char 1)
    (if (looking-at "|[^|\n]+")
	(let* ((pos (match-beginning 0))
	       (match (match-string 0))
	       (len (string-width match)))
	  (replace-match (concat "|" (make-string (1- len) ?\ )))
	  (goto-char (+ 2 pos))
	  (substring match 1)))))

(defun org-table-get-field (&optional n replace)

  "Insert a new row above the current line into the table.
With prefix ARG, insert below the current line."
  (interactive "P")
  (if (not (org-at-table-p))
      (error "Not at a table"))
  (let* ((line
	  (org-expand-wide-chars
	   (buffer-substring-no-properties (point-at-bol) (point-at-eol))))
	 new)
    (if (string-match "^[ \t]*|-" line)
	(setq new (mapcar (lambda (x) (if (member x '(?| ?+)) ?| ?\ )) line))
      (setq new (mapcar (lambda (x) (if (equal x ?|) ?| ?\ )) line)))
    ;; Fix the first field if necessary

  "Insert a horizontal-line below the current line into the table.
With prefix ARG, insert above the current line."
  (interactive "P")
  (if (not (org-at-table-p))
      (error "Not at a table"))
  (let ((line
	 (org-expand-wide-chars
	  (buffer-substring-no-properties (point-at-bol) (point-at-eol))))
	(col (current-column))
	start)
    (if (string-match "^[ \t]*|-" line)
	(setq line
	      (mapcar (lambda (x) (if (member x '(?| ?+))

    (beginning-of-line (if arg 1 2))
    (apply 'insert line)
    (if (equal (char-before (point)) ?+)
	(progn (backward-delete-char 1) (insert "|")))
    (insert "\n")
    (beginning-of-line (if arg 1 -1))
    (move-to-column col)))

(defun org-expand-wide-chars (s)
  "Expand wide characters to spaces."
  (let (w a)
    (mapconcat
     (lambda (x)
       (if (> (setq w (string-width (setq a (char-to-string x)))) 1)
	   (make-string w ?\ )
	 a))
     s "")))

(defun org-table-kill-row ()
  "Delete the current row or horizontal line from the table."
  (interactive)
  (if (not (org-at-table-p))

	  (while (re-search-forward "^\\([ \t]*\\)|-.*\n" end t)
	    (replace-match ""))
	  ;; insert a hline before first
	  (goto-char beg)
	  (org-table-insert-hline 'above)
	  (beginning-of-line -1)
	  ;; insert a hline after each line
	  (while (progn (beginning-of-line 3) (< (point) end))
	    (org-table-insert-hline))
	  (goto-char beg)
	  (setq end (move-marker end (org-table-end)))
	  ;; replace "+" at beginning and ending of hlines
	  (while (re-search-forward "^\\([ \t]*\\)|-" end t)

wrapped to the length of that word.
IF WIDTH is nil and LINES is non-nil, the string is forced into at most that
many lines, whatever width that takes.
The return value is a list of lines, without newlines at the end."
  (let* ((words (org-split-string string "[ \t\n]+"))
	 (maxword (apply 'max (mapcar 'string-width words)))
	 w ll)
    (cond (width
	   (org-do-wrap words (max maxword width)))
	  (lines
	   (setq w maxword)

;;; Key bindings

;; - Bindings in Org-mode map are currently
;;   0123456789abcdefghijklmnopqrstuvwxyz!?@#$%^&-+*/=()_{}[]:;"|,.<>~`'\t  the alphabet
;;             abcd fgh j lmnopqrstuvwxyz!? #$   -+*/=     [] ; |,.<>~  \t  necessary bindings
;;                 e                                                        (?) useful from outline-mode
;;                     i k                 @                                expendable from outline-mode
;;   0123456789                               %^&     ()_{}    "      `'    free

;; Make `C-c C-x' a prefix key
(define-key org-mode-map "\C-c\C-x" (make-sparse-keymap))

;; TAB key with modifiers

(run-hooks 'org-load-hook)

;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd
;;; org.el ends here


(defun org-get-tags-at (&optional pos)
  "Get a list of all headline targs applicable at POS.
POS defaults to point.  If tags are inherited, the list contains
the targets in the same sequence as the headlines appear, i.e.
the tags of the current headline come last."
  (interactive)
  (let (tags)
    (save-excursion
      (goto-char (or pos (point)))
      (save-match-data
	(org-back-to-heading t)
	(condition-case nil
	    (while t
	      (if (looking-at "[^\r\n]+?:\\([a-zA-Z_:]+\\):[ \t]*\\([\n\r]\\|\\'\\)")
		  (setq tags (append (org-split-string (match-string 1) ":") tags)))
	      (or org-use-tag-inheritance (error ""))
	      (org-up-heading-all 1))
	  (error nil))))
    (message "%s" tags)
    tags))