From 3d2e1eec787673ed1170b8cfbe33869ade62a023 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Wed, 7 Jan 2015 18:08:51 +0100 Subject: [PATCH] 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 --- contrib/lisp/org-colview-xemacs.el | 69 +++++++++++++++++++++++-------------- lisp/org-colview.el | 70 +++++++++++++++++++++++--------------- 2 files changed, 85 insertions(+), 54 deletions(-) diff --git a/contrib/lisp/org-colview-xemacs.el b/contrib/lisp/org-colview-xemacs.el index 85845a851..7bc31960f 100644 --- a/contrib/lisp/org-colview-xemacs.el +++ b/contrib/lisp/org-colview-xemacs.el @@ -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))))))))))) diff --git a/lisp/org-colview.el b/lisp/org-colview.el index a8de39e92..993afdb13 100644 --- a/lisp/org-colview.el +++ b/lisp/org-colview.el @@ -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))))))))))) -- 2.11.4.GIT