;;; org-colview.el --- Column View in Org-mode
-;; Copyright (C) 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 6.05a
+;; Version: 6.16
;;
;; This file is part of GNU Emacs.
;;
;;
;;; Commentary:
-;; This file contains the face definitons for Org.
+;; This file contains the column view for Org.
;;; Code:
(push ov org-columns-overlays)
ov))
-(defun org-columns-display-here (&optional props)
+(defun org-columns-display-here (&optional props dateline)
"Overlay the current line with column display."
(interactive)
(let* ((fmt org-columns-current-fmt-compiled)
'default))
(color (list :foreground (face-attribute ref-face :foreground)))
(face (list color 'org-column ref-face))
+ (face1 (list color 'org-agenda-column-dateline ref-face))
(pl (or (get-text-property (point-at-bol) 'prefix-length) 0))
(cphr (get-text-property (point-at-bol) 'org-complex-heading-regexp))
- pom property ass width f string ov column val modval s1 s2)
+ pom property ass width f string ov column val modval s1 s2 title)
;; Check if the entry is in another buffer.
(unless props
(if (eq major-mode 'org-agenda-mode)
;; Walk the format
(while (setq column (pop fmt))
(setq property (car column)
+ title (nth 1 column)
ass (if (equal property "ITEM")
(cons "ITEM"
(save-match-data
(length property))
f (format "%%-%d.%ds | " width width)
val (or (cdr ass) "")
- modval (if (equal property "ITEM")
- (if (org-mode-p)
- (org-columns-cleanup-item
- val org-columns-current-fmt-compiled)
- (org-agenda-columns-cleanup-item
- val pl cphr org-columns-current-fmt-compiled))))
+ modval (or (and org-columns-modify-value-for-display-function
+ (functionp
+ org-columns-modify-value-for-display-function)
+ (funcall
+ org-columns-modify-value-for-display-function
+ title val))
+ (if (equal property "ITEM")
+ (if (org-mode-p)
+ (org-columns-cleanup-item
+ val org-columns-current-fmt-compiled)
+ (org-agenda-columns-cleanup-item
+ val pl cphr org-columns-current-fmt-compiled)))))
(setq s2 (org-columns-add-ellipses (or modval val) width))
(setq string (format f s2))
;; Create the overlay
(org-unmodified
(setq ov (org-columns-new-overlay
- beg (setq beg (1+ beg)) string face))
+ beg (setq beg (1+ beg)) string (if dateline face1 face)))
(org-overlay-put ov 'keymap org-columns-map)
(org-overlay-put ov 'org-columns-key property)
(org-overlay-put ov 'org-columns-value (cdr ass))
(defun org-columns-add-ellipses (string width)
"Truncate STRING with WIDTH characters, with ellipses."
- (cond
+ (cond
((<= (length string) width) string)
((<= width (length org-columns-ellipses))
(substring org-columns-ellipses 0 width))
org-columns-ellipses))))
(defvar org-columns-full-header-line-format nil
- "Fthe full header line format, will be shifted by horizontal scrolling." )
+ "The full header line format, will be shifted by horizontal scrolling." )
(defvar org-previous-header-line-format nil
"The header line format before column view was turned on.")
(defvar org-columns-inhibit-recalculation nil
(defvar org-agenda-columns-remove-prefix-from-item)
(defun org-agenda-columns-cleanup-item (item pl cphr fmt)
- "Cleanup the tiem property for agenda column view.
+ "Cleanup the time property for agenda column view.
See also the variable `org-agenda-columns-remove-prefix-from-item'."
(let* ((org-complex-heading-regexp cphr)
(prefix (substring item 0 pl))
(t
(setq allowed (org-property-get-allowed-values pom key 'table))
(if allowed
- (setq nval (completing-read "Value: " allowed nil t))
+ (setq nval (org-ido-completing-read "Value: " allowed nil t))
(setq nval (read-string "Edit: " value)))
(setq nval (org-trim nval))
(when (not (equal nval value))
(and (memq
(nth 4 (assoc key org-columns-current-fmt-compiled))
'(checkbox checkbox-n-of-m checkbox-percent))
- '("[ ]" "[X]"))))
+ '("[ ]" "[X]"))
+ (org-colview-construct-allowed-dates value)))
nval)
(when (integerp nth)
(setq nth (1- nth))
(and (nth 3 (assoc key org-columns-current-fmt-compiled))
(org-columns-update key))))))
+(defun org-colview-construct-allowed-dates (s)
+ "Construct a list of three dates around the date in S.
+This respects the format of the time stamp in S, active or non-active,
+and also including time or not. S must be just a time stamp, no text
+around it."
+ (when (string-match (concat "^" org-ts-regexp3 "$") s)
+ (let* ((time (org-parse-time-string s 'nodefaults))
+ (active (equal (string-to-char s) ?<))
+ (fmt (funcall (if (nth 1 time) 'cdr 'car) org-time-stamp-formats))
+ time-before time-after)
+ (unless active (setq fmt (concat "[" (substring fmt 1 -1) "]")))
+ (setf (car time) (or (car time) 0))
+ (setf (nth 1 time) (or (nth 1 time) 0))
+ (setf (nth 2 time) (or (nth 2 time) 0))
+ (setq time-before (copy-sequence time))
+ (setq time-after (copy-sequence time))
+ (setf (nth 3 time-before) (1- (nth 3 time)))
+ (setf (nth 3 time-after) (1+ (nth 3 time)))
+ (mapcar (lambda (x) (format-time-string fmt (apply 'encode-time x)))
+ (list time-before time time-after)))))
+
(defun org-verify-version (task)
(cond
((eq task 'columns)
(defun org-columns-get-format-and-top-level ()
(let (fmt)
(when (condition-case nil (org-back-to-heading) (error nil))
- (move-marker org-entry-property-inherited-from nil)
(setq fmt (org-entry-get nil "COLUMNS" t)))
(setq fmt (or fmt org-columns-default-format))
(org-set-local 'org-columns-current-fmt fmt)
(interactive)
(let ((editp (and prop (assoc prop org-columns-current-fmt-compiled)))
cell)
- (setq prop (completing-read
+ (setq prop (org-ido-completing-read
"Property: " (mapcar 'list (org-buffer-property-keys t nil t))
nil nil prop))
(setq title (read-string (concat "Column title [" prop "]: ") (or title prop)))
(if (string-match "\\S-" width)
(setq width (string-to-number width))
(setq width nil))
- (setq fmt (completing-read "Summary [none]: "
+ (setq fmt (org-ido-completing-read "Summary [none]: "
'(("none") ("add_numbers") ("currency") ("add_times") ("checkbox") ("checkbox-n-of-m") ("checkbox-percent"))
nil t))
(if (string-match "\\S-" fmt)
(org-columns-redo)))
(defun org-columns-narrow (arg)
- "Make the column nrrower by ARG characters."
+ "Make the column narrower by ARG characters."
(interactive "p")
(org-columns-widen (- arg)))
(let* ((title (mapcar 'cadr org-columns-current-fmt-compiled))
(n (length title)) row tbl)
(goto-char (point-min))
- (while (and (re-search-forward "^\\(\\*+\\) " nil t)
- (or (null maxlevel)
- (>= maxlevel
- (if org-odd-levels-only
- (/ (1+ (length (match-string 1))) 2)
- (length (match-string 1))))))
- (when (get-char-property (match-beginning 0) 'org-columns-key)
+ (while (re-search-forward "^\\(\\*+\\) " nil t)
+ (when (and (or (null maxlevel)
+ (>= maxlevel
+ (if org-odd-levels-only
+ (/ (1+ (length (match-string 1))) 2)
+ (length (match-string 1)))))
+ (get-char-property (match-beginning 0) 'org-columns-key))
(setq row nil)
(loop for i from 0 to (1- n) do
(push (or (get-char-property (+ (match-beginning 0) i) 'org-columns-value-modified)
(hlines (plist-get params :hlines))
(vlines (plist-get params :vlines))
(maxlevel (plist-get params :maxlevel))
+ (content-lines (org-split-string (plist-get params :content) "\n"))
(skip-empty-rows (plist-get params :skip-empty-rows))
- tbl id idpos nfields tmp)
+ tbl id idpos nfields tmp recalc line)
(save-excursion
(save-restriction
(when (setq id (plist-get params :id))
tbl))
(setq tbl (append tbl (list (cons "/" (make-list nfields "<>"))))))
(setq pos (point))
+ (when content-lines
+ (while (string-match "^#" (car content-lines))
+ (insert (pop content-lines) "\n")))
(insert (org-listtable-to-string tbl))
(when (plist-get params :width)
(insert "\n|" (mapconcat (lambda (x) (format "<%d>" (max 3 x)))
org-columns-current-widths "|")))
- (goto-char pos)
- (org-table-align))))
+ (while (setq line (pop content-lines))
+ (when (string-match "^#" line)
+ (insert "\n" line)
+ (when (string-match "^#\\+TBLFM" line)
+ (setq recalc t))))
+ (if recalc
+ (progn (goto-char pos) (org-table-recalculate 'all))
+ (goto-char pos)
+ (org-table-align)))))
(defun org-listtable-to-string (tbl)
"Convert a listtable TBL to a string that contains the Org-mode table.
-The table still need to be alligned. The resulting string has no leading
+The table still need to be aligned. The resulting string has no leading
and tailing newline characters."
(mapconcat
(lambda (x)
"Create a dynamic block capturing a column view table."
(interactive)
(let ((defaults '(:name "columnview" :hlines 1))
- (id (completing-read
+ (id (org-ido-completing-read
"Capture columns (local, global, entry with :ID: property) [local]: "
(append '(("global") ("local"))
(mapcar 'list (org-property-values "ID"))))))
0 (length lsum) 'face 'bold lsum)
(cons prop lsum))))
fmt))
- (org-columns-display-here props)
+ (org-columns-display-here props 'dateline)
(org-set-local 'org-agenda-columns-active t)))
(if (bobp) (throw 'exit t))
(beginning-of-line 0))))))
HCoop / bpt / emacs.git / blobdiff