org-colview: Fix user properties display
* contrib/lisp/org-colview-xemacs.el (org-columns-display-here): (org-columns-display-here-title): (org-columns-edit-value): (org-columns-next-allowed-value): (org-columns-new): (org-columns-widen): (org-columns-get-autowidth-alist): (org-columns-update): (org-columns-compute): (org-agenda-columns): (org-agenda-colview-summarize): (org-agenda-colview-compute): * lisp/org-colview.el (org-columns-display-here): (org-columns-display-here-title): (org-columns-edit-value): (org-columns-next-allowed-value): (org-columns-new): (org-columns-widen): (org-columns-get-autowidth-alist): (org-columns-update): (org-columns-compute): (org-agenda-columns): (org-agenda-colview-summarize): (org-agenda-colview-compute): Properties are case-insensitive. Reported-by: Eric S Fraga <e.fraga@ucl.ac.uk> <http://permalink.gmane.org/gmane.emacs.orgmode/93854>
This commit is contained in:
Nicolas Goaziou
parent
ef523b0bca
commit
3d2e1eec78
|
|
@ -331,8 +331,10 @@ This is the compiled version of the format.")
|
|||
(while (setq column (pop fmt))
|
||||
(setq property (car column)
|
||||
title (nth 1 column)
|
||||
ass (assoc property props)
|
||||
width (or (cdr (assoc property org-columns-current-maxwidths))
|
||||
ass (assoc-string property props t)
|
||||
width (or (cdr (assoc-string property
|
||||
org-columns-current-maxwidths
|
||||
t))
|
||||
(nth 2 column)
|
||||
(length property))
|
||||
f (format (if (featurep 'xemacs) "%%-%d.%ds |" "%%-%d.%ds | ")
|
||||
|
|
@ -430,7 +432,9 @@ This is the compiled version of the format.")
|
|||
(while (setq column (pop fmt))
|
||||
(setq property (car column)
|
||||
str (or (nth 1 column) property)
|
||||
width (or (cdr (assoc property org-columns-current-maxwidths))
|
||||
width (or (cdr (assoc-string property
|
||||
org-columns-current-maxwidths
|
||||
t))
|
||||
(nth 2 column)
|
||||
(length str))
|
||||
widths (push width widths)
|
||||
|
|
@ -629,7 +633,7 @@ Where possible, use the standard interface for changing this line."
|
|||
(org-columns-display-here)))
|
||||
(org-move-to-column col)
|
||||
(if (and (derived-mode-p 'org-mode)
|
||||
(nth 3 (assoc key org-columns-current-fmt-compiled)))
|
||||
(nth 3 (assoc-string key org-columns-current-fmt-compiled t)))
|
||||
(org-columns-update key)))))))
|
||||
|
||||
(defun org-edit-headline () ; FIXME: this is not columns specific. Make interactive????? Use from agenda????
|
||||
|
|
@ -708,7 +712,9 @@ an integer, select that value."
|
|||
org-columns-overlays)))
|
||||
(allowed (or (org-property-get-allowed-values pom key)
|
||||
(and (memq
|
||||
(nth 4 (assoc key org-columns-current-fmt-compiled))
|
||||
(nth 4 (assoc-string key
|
||||
org-columns-current-fmt-compiled
|
||||
t))
|
||||
'(checkbox checkbox-n-of-m checkbox-percent))
|
||||
'("[ ]" "[X]"))
|
||||
(org-colview-construct-allowed-dates value)))
|
||||
|
|
@ -757,7 +763,7 @@ an integer, select that value."
|
|||
(org-columns-eval '(org-entry-put pom key nval)))
|
||||
(org-columns-display-here)))
|
||||
(org-move-to-column col)
|
||||
(and (nth 3 (assoc key org-columns-current-fmt-compiled))
|
||||
(and (nth 3 (assoc-string key org-columns-current-fmt-compiled t))
|
||||
(org-columns-update key))))))
|
||||
|
||||
(defun org-colview-construct-allowed-dates (s)
|
||||
|
|
@ -896,7 +902,9 @@ interactive function `org-columns-new'.
|
|||
"Insert a new column, to the left of the current column."
|
||||
(interactive)
|
||||
(let ((n (org-columns-current-column))
|
||||
(editp (and prop (assoc prop org-columns-current-fmt-compiled)))
|
||||
(editp (and prop (assoc-string prop
|
||||
org-columns-current-fmt-compiled
|
||||
t)))
|
||||
cell)
|
||||
(setq prop (org-icompleting-read
|
||||
"Property: " (mapcar 'list (org-buffer-property-keys t nil t))
|
||||
|
|
@ -952,7 +960,9 @@ interactive function `org-columns-new'.
|
|||
(let* ((n (org-columns-current-column))
|
||||
(entry (nth n org-columns-current-fmt-compiled))
|
||||
(width (or (nth 2 entry)
|
||||
(cdr (assoc (car entry) org-columns-current-maxwidths)))))
|
||||
(cdr (assoc-string (car entry)
|
||||
org-columns-current-maxwidths
|
||||
t)))))
|
||||
(setq width (max 1 (+ width arg)))
|
||||
(setcar (nthcdr 2 entry) width)
|
||||
(org-columns-store-format)
|
||||
|
|
@ -1024,11 +1034,14 @@ Don't set this, this is meant for dynamic scoping.")
|
|||
(push (cons (match-string 1 s) 1) rtn)
|
||||
(setq start (match-end 0)))
|
||||
(mapc (lambda (x)
|
||||
(setcdr x (apply 'max
|
||||
(setcdr x
|
||||
(apply 'max
|
||||
(let ((prop (car x)))
|
||||
(mapcar
|
||||
(lambda (y)
|
||||
(length (or (cdr (assoc (car x) (cdr y))) " ")))
|
||||
cache))))
|
||||
(length (or (cdr (assoc-string prop (cdr y) t))
|
||||
" ")))
|
||||
cache)))))
|
||||
rtn)
|
||||
rtn))
|
||||
|
||||
|
|
@ -1053,9 +1066,11 @@ Don't set this, this is meant for dynamic scoping.")
|
|||
(when (equal (overlay-get ov 'org-columns-key) property)
|
||||
(setq pos (overlay-start ov))
|
||||
(goto-char pos)
|
||||
(when (setq val (cdr (assoc property
|
||||
(get-text-property
|
||||
(point-at-bol) 'org-summaries))))
|
||||
(when (setq val (cdr (assoc-string
|
||||
property
|
||||
(get-text-property
|
||||
(point-at-bol) 'org-summaries)
|
||||
t)))
|
||||
(setq fmt (overlay-get ov 'org-columns-format))
|
||||
(overlay-put ov 'org-columns-value val)
|
||||
(if (featurep 'xemacs)
|
||||
|
|
@ -1070,11 +1085,11 @@ Don't set this, this is meant for dynamic scoping.")
|
|||
"Sum the values of property PROPERTY hierarchically, for the entire buffer."
|
||||
(interactive)
|
||||
(let* ((re org-outline-regexp-bol)
|
||||
(lmax 30) ; Does anyone use deeper levels???
|
||||
(lmax 30) ; Does anyone use deeper levels???
|
||||
(lvals (make-vector lmax nil))
|
||||
(lflag (make-vector lmax nil))
|
||||
(level 0)
|
||||
(ass (assoc property org-columns-current-fmt-compiled))
|
||||
(ass (assoc-string property org-columns-current-fmt-compiled t))
|
||||
(format (nth 4 ass))
|
||||
(printf (nth 5 ass))
|
||||
(fun (nth 6 ass))
|
||||
|
|
@ -1103,12 +1118,12 @@ Don't set this, this is meant for dynamic scoping.")
|
|||
str1 (org-add-props (copy-sequence str) nil 'org-computed t 'face 'bold)
|
||||
useval (if flag str1 (if valflag val ""))
|
||||
sum-alist (get-text-property sumpos 'org-summaries))
|
||||
(if (assoc property sum-alist)
|
||||
(setcdr (assoc property sum-alist) useval)
|
||||
(push (cons property useval) sum-alist)
|
||||
(org-unmodified
|
||||
(add-text-properties sumpos (1+ sumpos)
|
||||
(list 'org-summaries sum-alist))))
|
||||
(let ((old (assoc-string property sum-alist t)))
|
||||
(if old (setcdr old useval)
|
||||
(push (cons property useval) sum-alist)
|
||||
(org-unmodified
|
||||
(add-text-properties sumpos (1+ sumpos)
|
||||
(list 'org-summaries sum-alist)))))
|
||||
(when (and val (not (equal val (if flag str val))))
|
||||
(org-entry-put nil property (if flag str val)))
|
||||
;; add current to current level accumulator
|
||||
|
|
@ -1525,7 +1540,7 @@ and tailing newline characters."
|
|||
(org-get-at-bol 'org-marker)))
|
||||
(setq p (org-entry-properties m))
|
||||
|
||||
(when (or (not (setq a (assoc org-effort-property p)))
|
||||
(when (or (not (setq a (assoc-string org-effort-property p t)))
|
||||
(not (string-match "\\S-" (or (cdr a) ""))))
|
||||
;; OK, the property is not defined. Use appointment duration?
|
||||
(when (and org-agenda-columns-add-appointments-to-effort-sum
|
||||
|
|
@ -1589,7 +1604,7 @@ This will add overlays to the date lines, to show the summary for each day."
|
|||
(t ;; do the summary
|
||||
(setq lsum nil)
|
||||
(dolist (x entries)
|
||||
(setq v (cdr (assoc prop x)))
|
||||
(setq v (cdr (assoc-string prop x t)))
|
||||
(if v
|
||||
(push
|
||||
(funcall
|
||||
|
|
@ -1639,8 +1654,10 @@ This will add overlays to the date lines, to show the summary for each day."
|
|||
(if (equal (car fm) "CLOCKSUM")
|
||||
(org-clock-sum)
|
||||
(when (and (nth 4 fm)
|
||||
(setq a (assoc (car fm)
|
||||
org-columns-current-fmt-compiled))
|
||||
(setq a (assoc-string
|
||||
(car fm)
|
||||
org-columns-current-fmt-compiled
|
||||
t))
|
||||
(equal (nth 4 a) (nth 4 fm)))
|
||||
(org-columns-compute (car fm)))))))))))
|
||||
|
||||
|
|
|
|||
|
|
@ -186,8 +186,9 @@ This is the compiled version of the format.")
|
|||
(while (setq column (pop fmt))
|
||||
(setq property (car column)
|
||||
title (nth 1 column)
|
||||
ass (assoc property props)
|
||||
width (or (cdr (assoc property org-columns-current-maxwidths))
|
||||
ass (assoc-string property props t)
|
||||
width (or (cdr
|
||||
(assoc-string property org-columns-current-maxwidths t))
|
||||
(nth 2 column)
|
||||
(length property))
|
||||
f (format "%%-%d.%ds | " width width)
|
||||
|
|
@ -279,7 +280,9 @@ for the duration of the command.")
|
|||
(while (setq column (pop fmt))
|
||||
(setq property (car column)
|
||||
str (or (nth 1 column) property)
|
||||
width (or (cdr (assoc property org-columns-current-maxwidths))
|
||||
width (or (cdr (assoc-string property
|
||||
org-columns-current-maxwidths
|
||||
t))
|
||||
(nth 2 column)
|
||||
(length str))
|
||||
widths (push width widths)
|
||||
|
|
@ -396,7 +399,7 @@ Where possible, use the standard interface for changing this line."
|
|||
(value (get-char-property (point) 'org-columns-value))
|
||||
(bol (point-at-bol)) (eol (point-at-eol))
|
||||
(pom (or (get-text-property bol 'org-hd-marker)
|
||||
(point))) ; keep despite of compiler waring
|
||||
(point))) ; keep despite of compiler waring
|
||||
(line-overlays
|
||||
(delq nil (mapcar (lambda (x)
|
||||
(and (eq (overlay-buffer x) (current-buffer))
|
||||
|
|
@ -472,7 +475,7 @@ Where possible, use the standard interface for changing this line."
|
|||
(org-columns-display-here)))
|
||||
(org-move-to-column col)
|
||||
(if (and (derived-mode-p 'org-mode)
|
||||
(nth 3 (assoc key org-columns-current-fmt-compiled)))
|
||||
(nth 3 (assoc-string key org-columns-current-fmt-compiled t)))
|
||||
(org-columns-update key)))))))
|
||||
|
||||
(defun org-edit-headline () ; FIXME: this is not columns specific. Make interactive????? Use from agenda????
|
||||
|
|
@ -541,7 +544,7 @@ an integer, select that value."
|
|||
(value (get-char-property (point) 'org-columns-value))
|
||||
(bol (point-at-bol)) (eol (point-at-eol))
|
||||
(pom (or (get-text-property bol 'org-hd-marker)
|
||||
(point))) ; keep despite of compiler waring
|
||||
(point))) ; keep despite of compiler waring
|
||||
(line-overlays
|
||||
(delq nil (mapcar (lambda (x)
|
||||
(and (eq (overlay-buffer x) (current-buffer))
|
||||
|
|
@ -551,7 +554,9 @@ an integer, select that value."
|
|||
org-columns-overlays)))
|
||||
(allowed (or (org-property-get-allowed-values pom key)
|
||||
(and (memq
|
||||
(nth 4 (assoc key org-columns-current-fmt-compiled))
|
||||
(nth 4 (assoc-string key
|
||||
org-columns-current-fmt-compiled
|
||||
t))
|
||||
'(checkbox checkbox-n-of-m checkbox-percent))
|
||||
'("[ ]" "[X]"))
|
||||
(org-colview-construct-allowed-dates value)))
|
||||
|
|
@ -600,7 +605,7 @@ an integer, select that value."
|
|||
(org-columns-eval '(org-entry-put pom key nval)))
|
||||
(org-columns-display-here)))
|
||||
(org-move-to-column col)
|
||||
(and (nth 3 (assoc key org-columns-current-fmt-compiled))
|
||||
(and (nth 3 (assoc-string key org-columns-current-fmt-compiled t))
|
||||
(org-columns-update key))))))
|
||||
|
||||
(defun org-colview-construct-allowed-dates (s)
|
||||
|
|
@ -753,7 +758,8 @@ calc function called on every element before summarizing. This is
|
|||
(defun org-columns-new (&optional prop title width op fmt fun &rest rest)
|
||||
"Insert a new column, to the left of the current column."
|
||||
(interactive)
|
||||
(let ((editp (and prop (assoc prop org-columns-current-fmt-compiled)))
|
||||
(let ((editp (and prop
|
||||
(assoc-string prop org-columns-current-fmt-compiled t)))
|
||||
cell)
|
||||
(setq prop (org-icompleting-read
|
||||
"Property: " (mapcar 'list (org-buffer-property-keys t nil t))
|
||||
|
|
@ -811,7 +817,9 @@ calc function called on every element before summarizing. This is
|
|||
(let* ((n (current-column))
|
||||
(entry (nth n org-columns-current-fmt-compiled))
|
||||
(width (or (nth 2 entry)
|
||||
(cdr (assoc (car entry) org-columns-current-maxwidths)))))
|
||||
(cdr (assoc-string (car entry)
|
||||
org-columns-current-maxwidths
|
||||
t)))))
|
||||
(setq width (max 1 (+ width arg)))
|
||||
(setcar (nthcdr 2 entry) width)
|
||||
(org-columns-store-format)
|
||||
|
|
@ -879,11 +887,14 @@ display, or in the #+COLUMNS line of the current buffer."
|
|||
(push (cons (match-string 1 s) 1) rtn)
|
||||
(setq start (match-end 0)))
|
||||
(mapc (lambda (x)
|
||||
(setcdr x (apply 'max
|
||||
(setcdr x
|
||||
(apply #'max
|
||||
(let ((prop (car x)))
|
||||
(mapcar
|
||||
(lambda (y)
|
||||
(length (or (cdr (assoc (car x) (cdr y))) " ")))
|
||||
cache))))
|
||||
(length (or (cdr (assoc-string prop (cdr y) t))
|
||||
" ")))
|
||||
cache)))))
|
||||
rtn)
|
||||
rtn))
|
||||
|
||||
|
|
@ -908,9 +919,11 @@ display, or in the #+COLUMNS line of the current buffer."
|
|||
(when (equal (overlay-get ov 'org-columns-key) property)
|
||||
(setq pos (overlay-start ov))
|
||||
(goto-char pos)
|
||||
(when (setq val (cdr (assoc property
|
||||
(get-text-property
|
||||
(point-at-bol) 'org-summaries))))
|
||||
(when (setq val (cdr (assoc-string
|
||||
property
|
||||
(get-text-property
|
||||
(point-at-bol) 'org-summaries)
|
||||
t)))
|
||||
(setq fmt (overlay-get ov 'org-columns-format))
|
||||
(overlay-put ov 'org-columns-value val)
|
||||
(overlay-put ov 'display (format fmt val)))))
|
||||
|
|
@ -924,11 +937,11 @@ display, or in the #+COLUMNS line of the current buffer."
|
|||
"Sum the values of property PROPERTY hierarchically, for the entire buffer."
|
||||
(interactive)
|
||||
(let* ((re org-outline-regexp-bol)
|
||||
(lmax 30) ; Does anyone use deeper levels???
|
||||
(lmax 30) ; Does anyone use deeper levels???
|
||||
(lvals (make-vector lmax nil))
|
||||
(lflag (make-vector lmax nil))
|
||||
(level 0)
|
||||
(ass (assoc property org-columns-current-fmt-compiled))
|
||||
(ass (assoc-string property org-columns-current-fmt-compiled t))
|
||||
(format (nth 4 ass))
|
||||
(printf (nth 5 ass))
|
||||
(fun (nth 6 ass))
|
||||
|
|
@ -968,12 +981,12 @@ display, or in the #+COLUMNS line of the current buffer."
|
|||
str1 (org-add-props (copy-sequence str) nil 'org-computed t 'face 'bold)
|
||||
useval (if flag str1 (if valflag val ""))
|
||||
sum-alist (get-text-property sumpos 'org-summaries))
|
||||
(if (assoc property sum-alist)
|
||||
(setcdr (assoc property sum-alist) useval)
|
||||
(push (cons property useval) sum-alist)
|
||||
(org-with-silent-modifications
|
||||
(add-text-properties sumpos (1+ sumpos)
|
||||
(list 'org-summaries sum-alist))))
|
||||
(let ((old (assoc-string property sum-alist t)))
|
||||
(if old (setcdr old useval)
|
||||
(push (cons property useval) sum-alist)
|
||||
(org-with-silent-modifications
|
||||
(add-text-properties sumpos (1+ sumpos)
|
||||
(list 'org-summaries sum-alist)))))
|
||||
(when (and val (not (equal val (if flag str val))))
|
||||
(org-entry-put nil property (if flag str val)))
|
||||
;; add current to current level accumulator
|
||||
|
|
@ -1374,7 +1387,7 @@ and tailing newline characters."
|
|||
(org-get-at-bol 'org-marker)))
|
||||
(setq p (org-entry-properties m))
|
||||
|
||||
(when (or (not (setq a (assoc org-effort-property p)))
|
||||
(when (or (not (setq a (assoc-string org-effort-property p t)))
|
||||
(not (string-match "\\S-" (or (cdr a) ""))))
|
||||
;; OK, the property is not defined. Use appointment duration?
|
||||
(when (and org-agenda-columns-add-appointments-to-effort-sum
|
||||
|
|
@ -1444,7 +1457,7 @@ This will add overlays to the date lines, to show the summary for each day."
|
|||
(t ;; do the summary
|
||||
(setq lsum nil)
|
||||
(dolist (x entries)
|
||||
(setq v (cdr (assoc prop x)))
|
||||
(setq v (cdr (assoc-string prop x t)))
|
||||
(if v
|
||||
(push
|
||||
(funcall
|
||||
|
|
@ -1495,8 +1508,9 @@ This will add overlays to the date lines, to show the summary for each day."
|
|||
((equal (car fm) "CLOCKSUM_T")
|
||||
(org-clock-sum-today))
|
||||
((and (nth 4 fm)
|
||||
(setq a (assoc (car fm)
|
||||
org-columns-current-fmt-compiled))
|
||||
(setq a (assoc-string (car fm)
|
||||
org-columns-current-fmt-compiled
|
||||
t))
|
||||
(equal (nth 4 a) (nth 4 fm)))
|
||||
(org-columns-compute (car fm)))))))))))
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue