2015-10-26 00:56:00 +00:00
|
|
|
|
;;; org-colview.el --- Column View in Org -*- lexical-binding: t; -*-
|
2008-04-09 13:42:36 +00:00
|
|
|
|
|
2022-01-01 20:10:55 +00:00
|
|
|
|
;; Copyright (C) 2004-2022 Free Software Foundation, Inc.
|
2008-04-09 13:42:36 +00:00
|
|
|
|
|
2021-05-07 14:50:57 +00:00
|
|
|
|
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
|
2008-04-09 13:42:36 +00:00
|
|
|
|
;; Keywords: outlines, hypermedia, calendar, wp
|
2018-01-16 16:22:00 +00:00
|
|
|
|
;; Homepage: https://orgmode.org
|
2008-04-09 13:42:36 +00:00
|
|
|
|
;;
|
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
|
;;
|
2008-05-06 12:45:52 +00:00
|
|
|
|
;; GNU Emacs is free software: you can redistribute it and/or modify
|
2008-04-09 13:42:36 +00:00
|
|
|
|
;; it under the terms of the GNU General Public License as published by
|
2008-05-06 12:45:52 +00:00
|
|
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
|
|
|
;; (at your option) any later version.
|
2008-04-09 13:42:36 +00:00
|
|
|
|
|
|
|
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
|
|
;; GNU General Public License for more details.
|
|
|
|
|
|
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
2017-09-13 22:52:52 +00:00
|
|
|
|
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
2008-04-09 13:42:36 +00:00
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
;;
|
|
|
|
|
;;; Commentary:
|
|
|
|
|
|
2008-12-17 08:08:06 +00:00
|
|
|
|
;; This file contains the column view for Org.
|
2008-04-09 13:42:36 +00:00
|
|
|
|
|
|
|
|
|
;;; Code:
|
|
|
|
|
|
2016-02-13 09:12:57 +00:00
|
|
|
|
(require 'cl-lib)
|
2008-04-09 13:42:36 +00:00
|
|
|
|
(require 'org)
|
|
|
|
|
|
2016-05-15 02:56:53 +00:00
|
|
|
|
(declare-function org-agenda-redo "org-agenda" (&optional all))
|
2009-11-13 22:22:18 +00:00
|
|
|
|
(declare-function org-agenda-do-context-action "org-agenda" ())
|
2012-08-05 16:59:51 +00:00
|
|
|
|
(declare-function org-clock-sum-today "org-clock" (&optional headline-filter))
|
2016-02-17 22:24:51 +00:00
|
|
|
|
(declare-function org-element-extract-element "org-element" (element))
|
|
|
|
|
(declare-function org-element-interpret-data "org-element" (data))
|
|
|
|
|
(declare-function org-element-map "org-element" (data types fun &optional info first-match no-recursion with-affiliated))
|
|
|
|
|
(declare-function org-element-parse-secondary-string "org-element" (string restriction &optional parent))
|
2016-02-23 23:53:27 +00:00
|
|
|
|
(declare-function org-element-property "org-element" (property element))
|
2016-02-17 22:24:51 +00:00
|
|
|
|
(declare-function org-element-restriction "org-element" (element))
|
2016-02-23 23:53:27 +00:00
|
|
|
|
(declare-function org-element-type "org-element" (element))
|
2018-12-23 05:35:38 +00:00
|
|
|
|
(declare-function org-dynamic-block-define "org" (type func))
|
2018-11-26 23:04:41 +00:00
|
|
|
|
(declare-function org-link-display-format "ol" (s))
|
|
|
|
|
(declare-function org-link-open-from-string "ol" (s &optional arg))
|
2020-02-17 12:59:19 +00:00
|
|
|
|
(declare-function face-remap-remove-relative "face-remap" (cookie))
|
|
|
|
|
(declare-function face-remap-add-relative "face-remap" (face &rest specs))
|
2008-05-30 07:30:43 +00:00
|
|
|
|
|
2016-02-14 09:17:14 +00:00
|
|
|
|
(defvar org-agenda-columns-add-appointments-to-effort-sum)
|
|
|
|
|
(defvar org-agenda-columns-compute-summary-properties)
|
|
|
|
|
(defvar org-agenda-columns-show-summaries)
|
|
|
|
|
(defvar org-agenda-view-columns-initially)
|
2016-02-18 10:33:33 +00:00
|
|
|
|
(defvar org-inlinetask-min-level)
|
2016-02-14 09:17:14 +00:00
|
|
|
|
|
2016-02-20 14:36:23 +00:00
|
|
|
|
|
2016-02-13 11:21:08 +00:00
|
|
|
|
;;; Configuration
|
|
|
|
|
|
|
|
|
|
(defcustom org-columns-modify-value-for-display-function nil
|
|
|
|
|
"Function that modifies values for display in column view.
|
|
|
|
|
For example, it can be used to cut out a certain part from a time stamp.
|
|
|
|
|
The function must take 2 arguments:
|
|
|
|
|
|
|
|
|
|
column-title The title of the column (*not* the property name)
|
|
|
|
|
value The value that should be modified.
|
|
|
|
|
|
|
|
|
|
The function should return the value that should be displayed,
|
|
|
|
|
or nil if the normal value should be used."
|
|
|
|
|
:group 'org-properties
|
|
|
|
|
:type '(choice (const nil) (function)))
|
|
|
|
|
|
2016-02-20 23:16:51 +00:00
|
|
|
|
(defcustom org-columns-summary-types nil
|
|
|
|
|
"Alist between operators and summarize functions.
|
|
|
|
|
|
2017-09-08 19:26:56 +00:00
|
|
|
|
Each association follows the pattern (LABEL . SUMMARIZE),
|
2018-02-10 13:03:59 +00:00
|
|
|
|
or (LABEL SUMMARIZE COLLECT) where
|
2016-02-20 23:16:51 +00:00
|
|
|
|
|
|
|
|
|
LABEL is a string used in #+COLUMNS definition describing the
|
|
|
|
|
summary type. It can contain any character but \"}\". It is
|
|
|
|
|
case-sensitive.
|
|
|
|
|
|
|
|
|
|
SUMMARIZE is a function called with two arguments. The first
|
|
|
|
|
argument is a non-empty list of values, as non-empty strings.
|
|
|
|
|
The second one is a format string or nil. It has to return
|
|
|
|
|
a string summarizing the list of values.
|
|
|
|
|
|
2017-09-08 19:26:56 +00:00
|
|
|
|
COLLECT is a function called with one argument, a property
|
|
|
|
|
name. It is called in the context of a headline and must
|
|
|
|
|
return the collected property, or the empty string. You can
|
|
|
|
|
use this to only collect a property if a related conditional
|
|
|
|
|
properties is set, e.g., to return VACATION_DAYS only if
|
|
|
|
|
CONFIRMED is true.
|
|
|
|
|
|
2016-02-20 23:16:51 +00:00
|
|
|
|
Note that the return value can become one value for an higher
|
|
|
|
|
order summary, so the function is expected to handle its own
|
|
|
|
|
output.
|
|
|
|
|
|
|
|
|
|
Types defined in this variable take precedence over those defined
|
|
|
|
|
in `org-columns-summary-types-default', which see."
|
|
|
|
|
:group 'org-properties
|
2017-01-26 04:39:18 +00:00
|
|
|
|
:version "26.1"
|
2016-02-20 23:16:51 +00:00
|
|
|
|
:package-version '(Org . "9.0")
|
|
|
|
|
:type '(alist :key-type (string :tag " Label")
|
2017-09-10 09:16:40 +00:00
|
|
|
|
:value-type
|
|
|
|
|
(choice (function :tag "Summarize")
|
|
|
|
|
(list :tag "Collect and summarize"
|
|
|
|
|
(function :tag "Summarize")
|
|
|
|
|
(function :tag "Collect")))))
|
2016-02-20 23:16:51 +00:00
|
|
|
|
|
2016-02-20 14:36:23 +00:00
|
|
|
|
|
|
|
|
|
|
2008-04-09 13:42:36 +00:00
|
|
|
|
;;; Column View
|
|
|
|
|
|
2017-07-25 07:49:23 +00:00
|
|
|
|
(defvar-local org-columns-overlays nil
|
2008-04-09 13:42:36 +00:00
|
|
|
|
"Holds the list of current column overlays.")
|
|
|
|
|
|
2015-11-05 16:47:38 +00:00
|
|
|
|
(defvar-local org-columns-current-fmt nil
|
2008-04-09 13:42:36 +00:00
|
|
|
|
"Local variable, holds the currently active column format.")
|
2016-02-22 11:19:22 +00:00
|
|
|
|
|
2015-11-05 16:47:38 +00:00
|
|
|
|
(defvar-local org-columns-current-fmt-compiled nil
|
2008-04-09 13:42:36 +00:00
|
|
|
|
"Local variable, holds the currently active column format.
|
|
|
|
|
This is the compiled version of the format.")
|
2016-02-22 11:19:22 +00:00
|
|
|
|
|
2015-11-05 16:47:38 +00:00
|
|
|
|
(defvar-local org-columns-current-maxwidths nil
|
2016-02-22 11:19:22 +00:00
|
|
|
|
"Currently active maximum column widths, as a vector.")
|
|
|
|
|
|
2017-07-25 07:49:23 +00:00
|
|
|
|
(defvar-local org-columns-begin-marker nil
|
2008-04-09 13:42:36 +00:00
|
|
|
|
"Points to the position where last a column creation command was called.")
|
2016-02-22 11:19:22 +00:00
|
|
|
|
|
2017-07-25 07:49:23 +00:00
|
|
|
|
(defvar-local org-columns-top-level-marker nil
|
2008-04-09 13:42:36 +00:00
|
|
|
|
"Points to the position where current columns region starts.")
|
|
|
|
|
|
2017-07-25 07:49:23 +00:00
|
|
|
|
(defvar org-columns--time 0.0
|
|
|
|
|
"Number of seconds since the epoch, as a floating point number.")
|
|
|
|
|
|
2008-04-09 13:42:36 +00:00
|
|
|
|
(defvar org-columns-map (make-sparse-keymap)
|
|
|
|
|
"The keymap valid in column display.")
|
|
|
|
|
|
2016-02-20 23:16:51 +00:00
|
|
|
|
(defconst org-columns-summary-types-default
|
2016-02-20 21:42:51 +00:00
|
|
|
|
'(("+" . org-columns--summary-sum)
|
|
|
|
|
("$" . org-columns--summary-currencies)
|
|
|
|
|
("X" . org-columns--summary-checkbox)
|
|
|
|
|
("X/" . org-columns--summary-checkbox-count)
|
|
|
|
|
("X%" . org-columns--summary-checkbox-percent)
|
|
|
|
|
("max" . org-columns--summary-max)
|
|
|
|
|
("mean" . org-columns--summary-mean)
|
|
|
|
|
("min" . org-columns--summary-min)
|
|
|
|
|
(":" . org-columns--summary-sum-times)
|
|
|
|
|
(":max" . org-columns--summary-max-time)
|
|
|
|
|
(":mean" . org-columns--summary-mean-time)
|
|
|
|
|
(":min" . org-columns--summary-min-time)
|
|
|
|
|
("@max" . org-columns--summary-max-age)
|
|
|
|
|
("@mean" . org-columns--summary-mean-age)
|
|
|
|
|
("@min" . org-columns--summary-min-age)
|
|
|
|
|
("est+" . org-columns--summary-estimate))
|
2016-02-20 14:36:23 +00:00
|
|
|
|
"Map operators to summarize functions.
|
2016-02-20 23:16:51 +00:00
|
|
|
|
See `org-columns-summary-types' for details.")
|
2016-02-20 14:36:23 +00:00
|
|
|
|
|
2008-04-09 13:42:36 +00:00
|
|
|
|
(defun org-columns-content ()
|
|
|
|
|
"Switch to contents view while in columns view."
|
|
|
|
|
(interactive)
|
2022-01-16 07:07:25 +00:00
|
|
|
|
(org-cycle-overview)
|
|
|
|
|
(org-cycle-content))
|
2008-04-09 13:42:36 +00:00
|
|
|
|
|
2021-05-18 23:36:54 +00:00
|
|
|
|
(org-defkey org-columns-map "c" #'org-columns-content)
|
|
|
|
|
(org-defkey org-columns-map "o" #'org-overview)
|
|
|
|
|
(org-defkey org-columns-map "e" #'org-columns-edit-value)
|
|
|
|
|
(org-defkey org-columns-map "\C-c\C-t" #'org-columns-todo)
|
|
|
|
|
(org-defkey org-columns-map "\C-c\C-c" #'org-columns-toggle-or-columns-quit)
|
|
|
|
|
(org-defkey org-columns-map "\C-c\C-o" #'org-columns-open-link)
|
|
|
|
|
(org-defkey org-columns-map "v" #'org-columns-show-value)
|
|
|
|
|
(org-defkey org-columns-map "q" #'org-columns-quit)
|
|
|
|
|
(org-defkey org-columns-map "r" #'org-columns-redo)
|
|
|
|
|
(org-defkey org-columns-map "g" #'org-columns-redo)
|
|
|
|
|
(org-defkey org-columns-map [left] #'backward-char)
|
|
|
|
|
(org-defkey org-columns-map "\M-b" #'backward-char)
|
|
|
|
|
(org-defkey org-columns-map "a" #'org-columns-edit-allowed)
|
|
|
|
|
(org-defkey org-columns-map "s" #'org-columns-edit-attributes)
|
2009-03-05 08:50:38 +00:00
|
|
|
|
(org-defkey org-columns-map "\M-f"
|
|
|
|
|
(lambda () (interactive) (goto-char (1+ (point)))))
|
|
|
|
|
(org-defkey org-columns-map [right]
|
|
|
|
|
(lambda () (interactive) (goto-char (1+ (point)))))
|
|
|
|
|
(org-defkey org-columns-map [down]
|
|
|
|
|
(lambda () (interactive)
|
|
|
|
|
(let ((col (current-column)))
|
2009-03-10 16:45:22 +00:00
|
|
|
|
(beginning-of-line 2)
|
|
|
|
|
(while (and (org-invisible-p2) (not (eobp)))
|
|
|
|
|
(beginning-of-line 2))
|
2009-11-12 08:04:48 +00:00
|
|
|
|
(move-to-column col)
|
2021-05-18 23:36:54 +00:00
|
|
|
|
(if (derived-mode-p 'org-agenda-mode)
|
2009-11-13 13:48:00 +00:00
|
|
|
|
(org-agenda-do-context-action)))))
|
2009-03-05 08:50:38 +00:00
|
|
|
|
(org-defkey org-columns-map [up]
|
|
|
|
|
(lambda () (interactive)
|
|
|
|
|
(let ((col (current-column)))
|
2009-03-10 16:45:22 +00:00
|
|
|
|
(beginning-of-line 0)
|
|
|
|
|
(while (and (org-invisible-p2) (not (bobp)))
|
|
|
|
|
(beginning-of-line 0))
|
2009-11-12 08:04:48 +00:00
|
|
|
|
(move-to-column col)
|
2009-11-13 13:48:00 +00:00
|
|
|
|
(if (eq major-mode 'org-agenda-mode)
|
|
|
|
|
(org-agenda-do-context-action)))))
|
2021-05-18 23:36:54 +00:00
|
|
|
|
(org-defkey org-columns-map [(shift right)] #'org-columns-next-allowed-value)
|
|
|
|
|
(org-defkey org-columns-map "n" #'org-columns-next-allowed-value)
|
|
|
|
|
(org-defkey org-columns-map [(shift left)] #'org-columns-previous-allowed-value)
|
|
|
|
|
(org-defkey org-columns-map "p" #'org-columns-previous-allowed-value)
|
|
|
|
|
(org-defkey org-columns-map "<" #'org-columns-narrow)
|
|
|
|
|
(org-defkey org-columns-map ">" #'org-columns-widen)
|
|
|
|
|
(org-defkey org-columns-map [(meta right)] #'org-columns-move-right)
|
|
|
|
|
(org-defkey org-columns-map [(meta left)] #'org-columns-move-left)
|
|
|
|
|
(org-defkey org-columns-map [(shift meta right)] #'org-columns-new)
|
|
|
|
|
(org-defkey org-columns-map [(shift meta left)] #'org-columns-delete)
|
2008-06-09 07:53:19 +00:00
|
|
|
|
(dotimes (i 10)
|
|
|
|
|
(org-defkey org-columns-map (number-to-string i)
|
2021-05-18 23:36:54 +00:00
|
|
|
|
(lambda () (interactive)
|
|
|
|
|
(org-columns-next-allowed-value nil i))))
|
2008-04-09 13:42:36 +00:00
|
|
|
|
|
2021-09-16 10:32:43 +00:00
|
|
|
|
(easy-menu-define org-columns-menu org-columns-map "Org Column Menu."
|
2008-04-09 13:42:36 +00:00
|
|
|
|
'("Column"
|
|
|
|
|
["Edit property" org-columns-edit-value t]
|
|
|
|
|
["Next allowed value" org-columns-next-allowed-value t]
|
|
|
|
|
["Previous allowed value" org-columns-previous-allowed-value t]
|
|
|
|
|
["Show full value" org-columns-show-value t]
|
|
|
|
|
["Edit allowed values" org-columns-edit-allowed t]
|
|
|
|
|
"--"
|
|
|
|
|
["Edit column attributes" org-columns-edit-attributes t]
|
|
|
|
|
["Increase column width" org-columns-widen t]
|
|
|
|
|
["Decrease column width" org-columns-narrow t]
|
|
|
|
|
"--"
|
|
|
|
|
["Move column right" org-columns-move-right t]
|
|
|
|
|
["Move column left" org-columns-move-left t]
|
|
|
|
|
["Add column" org-columns-new t]
|
|
|
|
|
["Delete column" org-columns-delete t]
|
|
|
|
|
"--"
|
|
|
|
|
["CONTENTS" org-columns-content t]
|
|
|
|
|
["OVERVIEW" org-overview t]
|
|
|
|
|
["Refresh columns display" org-columns-redo t]
|
|
|
|
|
"--"
|
|
|
|
|
["Open link" org-columns-open-link t]
|
|
|
|
|
"--"
|
|
|
|
|
["Quit" org-columns-quit t]))
|
|
|
|
|
|
2018-12-18 11:07:43 +00:00
|
|
|
|
(defun org-columns--displayed-value (spec value &optional no-star)
|
2016-02-22 14:00:31 +00:00
|
|
|
|
"Return displayed value for specification SPEC in current entry.
|
2018-12-18 11:07:43 +00:00
|
|
|
|
|
2016-02-22 14:00:31 +00:00
|
|
|
|
SPEC is a column format specification as stored in
|
|
|
|
|
`org-columns-current-fmt-compiled'. VALUE is the real value to
|
2018-12-18 11:07:43 +00:00
|
|
|
|
display, as a string.
|
|
|
|
|
|
|
|
|
|
When NO-STAR is non-nil, do not add asterisks before displayed
|
|
|
|
|
value for ITEM property."
|
2017-05-20 20:11:45 +00:00
|
|
|
|
(or (and (functionp org-columns-modify-value-for-display-function)
|
|
|
|
|
(funcall org-columns-modify-value-for-display-function
|
|
|
|
|
(nth 1 spec) ;column name
|
|
|
|
|
value))
|
|
|
|
|
(pcase spec
|
|
|
|
|
(`("ITEM" . ,_)
|
2018-12-18 11:07:43 +00:00
|
|
|
|
(let ((stars
|
|
|
|
|
(and (not no-star)
|
|
|
|
|
(concat (make-string (1- (org-current-level))
|
|
|
|
|
(if org-hide-leading-stars ?\s ?*))
|
|
|
|
|
"* "))))
|
2019-01-01 16:19:49 +00:00
|
|
|
|
(concat stars (org-link-display-format value))))
|
2020-05-12 01:55:58 +00:00
|
|
|
|
(`(,(or "DEADLINE" "SCHEDULED" "TIMESTAMP") . ,_)
|
|
|
|
|
(replace-regexp-in-string org-ts-regexp "[\\1]" value))
|
2017-05-20 20:11:45 +00:00
|
|
|
|
(`(,_ ,_ ,_ ,_ nil) value)
|
2017-05-22 13:27:17 +00:00
|
|
|
|
;; If PRINTF is set, assume we are displaying a number and
|
|
|
|
|
;; obey to the format string.
|
2017-05-25 18:54:39 +00:00
|
|
|
|
(`(,_ ,_ ,_ ,_ ,printf) (format printf (string-to-number value)))
|
2017-05-20 20:11:45 +00:00
|
|
|
|
(_ (error "Invalid column specification format: %S" spec)))))
|
2016-02-14 09:17:14 +00:00
|
|
|
|
|
2016-12-11 00:34:55 +00:00
|
|
|
|
(defun org-columns--collect-values (&optional compiled-fmt)
|
2016-02-14 09:17:14 +00:00
|
|
|
|
"Collect values for columns on the current line.
|
|
|
|
|
|
2016-02-22 14:00:31 +00:00
|
|
|
|
Return a list of triplets (SPEC VALUE DISPLAYED) suitable for
|
2016-02-14 09:17:14 +00:00
|
|
|
|
`org-columns--display-here'.
|
|
|
|
|
|
|
|
|
|
This function assumes `org-columns-current-fmt-compiled' is
|
2016-12-11 00:34:55 +00:00
|
|
|
|
initialized is set in the current buffer. However, it is
|
|
|
|
|
possible to override it with optional argument COMPILED-FMT."
|
2016-02-23 13:20:19 +00:00
|
|
|
|
(let ((summaries (get-text-property (point) 'org-summaries)))
|
|
|
|
|
(mapcar
|
|
|
|
|
(lambda (spec)
|
|
|
|
|
(pcase spec
|
|
|
|
|
(`(,p . ,_)
|
|
|
|
|
(let* ((v (or (cdr (assoc spec summaries))
|
|
|
|
|
(org-entry-get (point) p 'selective t)
|
2016-12-11 00:34:55 +00:00
|
|
|
|
(and compiled-fmt ;assume `org-agenda-columns'
|
2016-02-23 13:20:19 +00:00
|
|
|
|
;; Effort property is not defined. Try
|
|
|
|
|
;; to use appointment duration.
|
|
|
|
|
org-agenda-columns-add-appointments-to-effort-sum
|
|
|
|
|
(string= p (upcase org-effort-property))
|
|
|
|
|
(get-text-property (point) 'duration)
|
2017-02-08 21:24:32 +00:00
|
|
|
|
(propertize (org-duration-from-minutes
|
2016-12-11 00:34:55 +00:00
|
|
|
|
(get-text-property (point) 'duration))
|
|
|
|
|
'face 'org-warning))
|
2016-02-23 13:20:19 +00:00
|
|
|
|
"")))
|
2018-12-18 11:07:43 +00:00
|
|
|
|
;; A non-nil COMPILED-FMT means we're calling from Org
|
|
|
|
|
;; Agenda mode, where we do not want leading stars for
|
|
|
|
|
;; ITEM. Hence the optional argument for
|
|
|
|
|
;; `org-columns--displayed-value'.
|
|
|
|
|
(list spec v (org-columns--displayed-value spec v compiled-fmt))))))
|
2016-12-11 00:34:55 +00:00
|
|
|
|
(or compiled-fmt org-columns-current-fmt-compiled))))
|
2016-02-14 09:17:14 +00:00
|
|
|
|
|
2016-02-22 11:19:22 +00:00
|
|
|
|
(defun org-columns--set-widths (cache)
|
|
|
|
|
"Compute the maximum column widths from the format and CACHE.
|
|
|
|
|
This function sets `org-columns-current-maxwidths' as a vector of
|
|
|
|
|
integers greater than 0."
|
|
|
|
|
(setq org-columns-current-maxwidths
|
|
|
|
|
(apply #'vector
|
|
|
|
|
(mapcar
|
|
|
|
|
(lambda (spec)
|
|
|
|
|
(pcase spec
|
|
|
|
|
(`(,_ ,_ ,(and width (pred wholenump)) . ,_) width)
|
2016-02-22 14:00:31 +00:00
|
|
|
|
(`(,_ ,name . ,_)
|
2016-02-22 11:19:22 +00:00
|
|
|
|
;; No width is specified in the columns format.
|
|
|
|
|
;; Compute it by checking all possible values for
|
|
|
|
|
;; PROPERTY.
|
|
|
|
|
(let ((width (length name)))
|
|
|
|
|
(dolist (entry cache width)
|
2016-02-22 14:00:31 +00:00
|
|
|
|
(let ((value (nth 2 (assoc spec (cdr entry)))))
|
2016-02-22 11:19:22 +00:00
|
|
|
|
(setq width (max (length value) width))))))))
|
|
|
|
|
org-columns-current-fmt-compiled))))
|
2015-08-11 17:10:09 +00:00
|
|
|
|
|
2016-02-22 22:53:04 +00:00
|
|
|
|
(defun org-columns--new-overlay (beg end &optional string face)
|
2008-04-09 13:42:36 +00:00
|
|
|
|
"Create a new column overlay and add it to the list."
|
2010-04-18 14:37:42 +00:00
|
|
|
|
(let ((ov (make-overlay beg end)))
|
|
|
|
|
(overlay-put ov 'face (or face 'secondary-selection))
|
2008-04-09 13:42:36 +00:00
|
|
|
|
(org-overlay-display ov string face)
|
|
|
|
|
(push ov org-columns-overlays)
|
|
|
|
|
ov))
|
|
|
|
|
|
2016-02-21 13:22:23 +00:00
|
|
|
|
(defun org-columns--summarize (operator)
|
|
|
|
|
"Return summary function associated to string OPERATOR."
|
2017-09-08 19:26:56 +00:00
|
|
|
|
(pcase (or (assoc operator org-columns-summary-types)
|
|
|
|
|
(assoc operator org-columns-summary-types-default))
|
|
|
|
|
(`nil (error "Unknown %S operator" operator))
|
|
|
|
|
(`(,_ . ,(and (pred functionp) summarize)) summarize)
|
|
|
|
|
(`(,_ ,summarize ,_) summarize)
|
|
|
|
|
(_ (error "Invalid definition for operator %S" operator))))
|
|
|
|
|
|
|
|
|
|
(defun org-columns--collect (operator)
|
|
|
|
|
"Return collect function associated to string OPERATOR.
|
|
|
|
|
Return nil if no collect function is associated to OPERATOR."
|
|
|
|
|
(pcase (or (assoc operator org-columns-summary-types)
|
|
|
|
|
(assoc operator org-columns-summary-types-default))
|
|
|
|
|
(`nil (error "Unknown %S operator" operator))
|
|
|
|
|
(`(,_ . ,(pred functionp)) nil) ;default value
|
|
|
|
|
(`(,_ ,_ ,collect) collect)
|
|
|
|
|
(_ (error "Invalid definition for operator %S" operator))))
|
2016-02-21 13:22:23 +00:00
|
|
|
|
|
2016-02-17 21:38:39 +00:00
|
|
|
|
(defun org-columns--overlay-text (value fmt width property original)
|
2018-12-18 08:54:24 +00:00
|
|
|
|
"Return decorated VALUE string for columns overlay display.
|
|
|
|
|
FMT is a format string. WIDTH is the width of the column, as an
|
|
|
|
|
integer. PROPERTY is the property being displayed, as a string.
|
|
|
|
|
ORIGINAL is the real string, i.e., before it is modified by
|
|
|
|
|
`org-columns--displayed-value'."
|
2016-02-17 21:38:39 +00:00
|
|
|
|
(format fmt
|
|
|
|
|
(let ((v (org-columns-add-ellipses value width)))
|
2016-02-22 09:48:00 +00:00
|
|
|
|
(pcase property
|
2016-02-17 21:38:39 +00:00
|
|
|
|
("PRIORITY"
|
|
|
|
|
(propertize v 'face (org-get-priority-face original)))
|
|
|
|
|
("TAGS"
|
|
|
|
|
(if (not org-tags-special-faces-re)
|
|
|
|
|
(propertize v 'face 'org-tag)
|
|
|
|
|
(replace-regexp-in-string
|
|
|
|
|
org-tags-special-faces-re
|
|
|
|
|
(lambda (m) (propertize m 'face (org-get-tag-face m)))
|
|
|
|
|
v nil nil 1)))
|
|
|
|
|
("TODO" (propertize v 'face (org-get-todo-face original)))
|
|
|
|
|
(_ v)))))
|
|
|
|
|
|
2020-02-17 12:59:19 +00:00
|
|
|
|
(defvar org-columns-header-line-remap nil
|
|
|
|
|
"Store the relative remapping of column header-line.
|
|
|
|
|
This is needed to later remove this relative remapping.")
|
|
|
|
|
|
2016-02-14 09:17:14 +00:00
|
|
|
|
(defun org-columns--display-here (columns &optional dateline)
|
|
|
|
|
"Overlay the current line with column display.
|
2016-02-22 14:00:31 +00:00
|
|
|
|
COLUMNS is an alist (SPEC VALUE DISPLAYED). Optional argument
|
|
|
|
|
DATELINE is non-nil when the face used should be
|
2016-02-14 09:17:14 +00:00
|
|
|
|
`org-agenda-column-dateline'."
|
2022-01-17 12:12:32 +00:00
|
|
|
|
(when (and (ignore-errors (require 'face-remap))
|
|
|
|
|
org-columns-header-line-remap)
|
2020-02-17 12:59:19 +00:00
|
|
|
|
(setq org-columns-header-line-remap
|
|
|
|
|
(face-remap-add-relative 'header-line '(:inherit default))))
|
2015-07-18 07:39:23 +00:00
|
|
|
|
(save-excursion
|
|
|
|
|
(beginning-of-line)
|
2016-02-05 23:04:35 +00:00
|
|
|
|
(let* ((level-face (and (looking-at "\\(\\**\\)\\(\\* \\)")
|
2015-07-18 07:39:23 +00:00
|
|
|
|
(org-get-level-face 2)))
|
|
|
|
|
(ref-face (or level-face
|
|
|
|
|
(and (eq major-mode 'org-agenda-mode)
|
|
|
|
|
(org-get-at-bol 'face))
|
|
|
|
|
'default))
|
|
|
|
|
(color (list :foreground (face-attribute ref-face :foreground)))
|
2020-02-17 12:59:19 +00:00
|
|
|
|
(font (list :family (face-attribute 'default :family)))
|
2015-07-18 07:39:23 +00:00
|
|
|
|
(face (list color font 'org-column ref-face))
|
2016-02-14 09:17:14 +00:00
|
|
|
|
(face1 (list color font 'org-agenda-column-dateline ref-face)))
|
2015-07-18 07:39:23 +00:00
|
|
|
|
;; Each column is an overlay on top of a character. So there has
|
|
|
|
|
;; to be at least as many characters available on the line as
|
|
|
|
|
;; columns to display.
|
|
|
|
|
(let ((columns (length org-columns-current-fmt-compiled))
|
|
|
|
|
(chars (- (line-end-position) (line-beginning-position))))
|
|
|
|
|
(when (> columns chars)
|
|
|
|
|
(save-excursion
|
|
|
|
|
(end-of-line)
|
|
|
|
|
(let ((inhibit-read-only t))
|
|
|
|
|
(insert (make-string (- columns chars) ?\s))))))
|
2016-02-14 09:17:14 +00:00
|
|
|
|
;; Display columns. Create and install the overlay for the
|
2015-07-18 07:39:23 +00:00
|
|
|
|
;; current column on the next character.
|
2016-02-22 11:19:22 +00:00
|
|
|
|
(let ((i 0)
|
|
|
|
|
(last (1- (length columns))))
|
2016-02-17 16:30:32 +00:00
|
|
|
|
(dolist (column columns)
|
|
|
|
|
(pcase column
|
2016-02-22 14:00:31 +00:00
|
|
|
|
(`(,spec ,original ,value)
|
|
|
|
|
(let* ((property (car spec))
|
|
|
|
|
(width (aref org-columns-current-maxwidths i))
|
2016-02-22 11:19:22 +00:00
|
|
|
|
(fmt (format (if (= i last) "%%-%d.%ds |"
|
2016-02-17 16:30:32 +00:00
|
|
|
|
"%%-%d.%ds | ")
|
|
|
|
|
width width))
|
2016-02-22 22:53:04 +00:00
|
|
|
|
(ov (org-columns--new-overlay
|
2016-02-17 21:38:39 +00:00
|
|
|
|
(point) (1+ (point))
|
|
|
|
|
(org-columns--overlay-text
|
|
|
|
|
value fmt width property original)
|
|
|
|
|
(if dateline face1 face))))
|
2016-02-17 16:30:32 +00:00
|
|
|
|
(overlay-put ov 'keymap org-columns-map)
|
|
|
|
|
(overlay-put ov 'org-columns-key property)
|
|
|
|
|
(overlay-put ov 'org-columns-value original)
|
|
|
|
|
(overlay-put ov 'org-columns-value-modified value)
|
|
|
|
|
(overlay-put ov 'org-columns-format fmt)
|
|
|
|
|
(overlay-put ov 'line-prefix "")
|
|
|
|
|
(overlay-put ov 'wrap-prefix "")
|
2016-02-22 11:19:22 +00:00
|
|
|
|
(forward-char))))
|
|
|
|
|
(cl-incf i)))
|
2015-07-18 07:39:23 +00:00
|
|
|
|
;; Make the rest of the line disappear.
|
2016-02-22 22:53:04 +00:00
|
|
|
|
(let ((ov (org-columns--new-overlay (point) (line-end-position))))
|
2015-07-18 07:39:23 +00:00
|
|
|
|
(overlay-put ov 'invisible t)
|
|
|
|
|
(overlay-put ov 'keymap org-columns-map)
|
|
|
|
|
(overlay-put ov 'line-prefix "")
|
|
|
|
|
(overlay-put ov 'wrap-prefix ""))
|
|
|
|
|
(let ((ov (make-overlay (1- (line-end-position))
|
|
|
|
|
(line-beginning-position 2))))
|
|
|
|
|
(overlay-put ov 'keymap org-columns-map)
|
|
|
|
|
(push ov org-columns-overlays))
|
2018-04-29 10:02:01 +00:00
|
|
|
|
(with-silent-modifications
|
|
|
|
|
(let ((inhibit-read-only t))
|
|
|
|
|
(put-text-property
|
|
|
|
|
(line-end-position 0)
|
|
|
|
|
(line-beginning-position 2)
|
|
|
|
|
'read-only
|
|
|
|
|
(substitute-command-keys
|
|
|
|
|
"Type \\<org-columns-map>`\\[org-columns-edit-value]' \
|
2015-07-18 07:39:23 +00:00
|
|
|
|
to edit property")))))))
|
2008-04-09 13:42:36 +00:00
|
|
|
|
|
2008-05-30 07:30:43 +00:00
|
|
|
|
(defun org-columns-add-ellipses (string width)
|
|
|
|
|
"Truncate STRING with WIDTH characters, with ellipses."
|
2008-12-04 14:33:43 +00:00
|
|
|
|
(cond
|
2008-05-30 07:30:43 +00:00
|
|
|
|
((<= (length string) width) string)
|
|
|
|
|
((<= width (length org-columns-ellipses))
|
|
|
|
|
(substring org-columns-ellipses 0 width))
|
|
|
|
|
(t (concat (substring string 0 (- width (length org-columns-ellipses)))
|
|
|
|
|
org-columns-ellipses))))
|
|
|
|
|
|
2008-04-09 13:42:36 +00:00
|
|
|
|
(defvar org-columns-full-header-line-format nil
|
2008-12-16 14:49:08 +00:00
|
|
|
|
"The full header line format, will be shifted by horizontal scrolling." )
|
2008-04-09 13:42:36 +00:00
|
|
|
|
(defvar org-previous-header-line-format nil
|
|
|
|
|
"The header line format before column view was turned on.")
|
|
|
|
|
(defvar org-columns-inhibit-recalculation nil
|
|
|
|
|
"Inhibit recomputing of columns on column view startup.")
|
2008-04-24 06:33:49 +00:00
|
|
|
|
(defvar org-columns-flyspell-was-active nil
|
|
|
|
|
"Remember the state of `flyspell-mode' before column view.
|
|
|
|
|
Flyspell-mode can cause problems in columns view, so it is turned off
|
2008-04-24 08:29:47 +00:00
|
|
|
|
for the duration of the command.")
|
2008-04-09 13:42:36 +00:00
|
|
|
|
|
|
|
|
|
(defvar header-line-format)
|
|
|
|
|
(defvar org-columns-previous-hscroll 0)
|
2009-08-28 12:50:51 +00:00
|
|
|
|
|
2016-02-14 09:17:14 +00:00
|
|
|
|
(defun org-columns--display-here-title ()
|
2008-04-09 13:42:36 +00:00
|
|
|
|
"Overlay the newline before the current line with the table title."
|
|
|
|
|
(interactive)
|
2016-02-22 11:19:22 +00:00
|
|
|
|
(let ((title "")
|
2018-04-28 00:17:44 +00:00
|
|
|
|
(linum-offset (org-line-number-display-width 'columns))
|
2016-02-22 11:19:22 +00:00
|
|
|
|
(i 0))
|
2016-02-14 09:17:14 +00:00
|
|
|
|
(dolist (column org-columns-current-fmt-compiled)
|
|
|
|
|
(pcase column
|
|
|
|
|
(`(,property ,name . ,_)
|
2016-02-22 11:19:22 +00:00
|
|
|
|
(let* ((width (aref org-columns-current-maxwidths i))
|
2016-02-14 09:17:14 +00:00
|
|
|
|
(fmt (format "%%-%d.%ds | " width width)))
|
2016-02-22 11:19:22 +00:00
|
|
|
|
(setq title (concat title (format fmt (or name property)))))))
|
|
|
|
|
(cl-incf i))
|
2015-11-05 16:47:38 +00:00
|
|
|
|
(setq-local org-previous-header-line-format header-line-format)
|
2016-02-17 16:30:32 +00:00
|
|
|
|
(setq org-columns-full-header-line-format
|
|
|
|
|
(concat
|
2018-04-26 22:44:55 +00:00
|
|
|
|
(org-add-props " " nil 'display `(space :align-to ,linum-offset))
|
2016-02-17 16:30:32 +00:00
|
|
|
|
(org-add-props (substring title 0 -1) nil 'face 'org-column-title)))
|
2008-04-09 13:42:36 +00:00
|
|
|
|
(setq org-columns-previous-hscroll -1)
|
2021-05-18 23:36:54 +00:00
|
|
|
|
(add-hook 'post-command-hook #'org-columns-hscroll-title nil 'local)))
|
2008-04-09 13:42:36 +00:00
|
|
|
|
|
2016-06-24 12:26:30 +00:00
|
|
|
|
(defun org-columns-hscroll-title ()
|
2010-07-15 20:26:51 +00:00
|
|
|
|
"Set the `header-line-format' so that it scrolls along with the table."
|
2008-04-09 13:42:36 +00:00
|
|
|
|
(sit-for .0001) ; need to force a redisplay to update window-hscroll
|
2019-03-21 21:15:04 +00:00
|
|
|
|
(let ((hscroll (window-hscroll)))
|
|
|
|
|
(when (/= org-columns-previous-hscroll hscroll)
|
|
|
|
|
(setq header-line-format
|
|
|
|
|
(concat (substring org-columns-full-header-line-format 0 1)
|
|
|
|
|
(substring org-columns-full-header-line-format
|
|
|
|
|
(min (length org-columns-full-header-line-format)
|
|
|
|
|
(1+ hscroll))))
|
|
|
|
|
org-columns-previous-hscroll hscroll)
|
|
|
|
|
(force-mode-line-update))))
|
2008-04-09 13:42:36 +00:00
|
|
|
|
|
2009-03-21 14:59:56 +00:00
|
|
|
|
(defvar org-colview-initial-truncate-line-value nil
|
|
|
|
|
"Remember the value of `truncate-lines' across colview.")
|
|
|
|
|
|
2013-11-15 05:53:59 +00:00
|
|
|
|
;;;###autoload
|
2008-04-09 13:42:36 +00:00
|
|
|
|
(defun org-columns-remove-overlays ()
|
|
|
|
|
"Remove all currently active column overlays."
|
|
|
|
|
(interactive)
|
2020-02-17 12:59:19 +00:00
|
|
|
|
(when (and (fboundp 'face-remap-remove-relative)
|
|
|
|
|
org-columns-header-line-remap)
|
2022-01-17 12:12:32 +00:00
|
|
|
|
(face-remap-remove-relative org-columns-header-line-remap)
|
|
|
|
|
(setq org-columns-header-line-remap nil))
|
2017-07-25 07:49:23 +00:00
|
|
|
|
(when org-columns-overlays
|
|
|
|
|
(when (local-variable-p 'org-previous-header-line-format)
|
|
|
|
|
(setq header-line-format org-previous-header-line-format)
|
|
|
|
|
(kill-local-variable 'org-previous-header-line-format)
|
2021-05-18 23:36:54 +00:00
|
|
|
|
(remove-hook 'post-command-hook #'org-columns-hscroll-title 'local))
|
2017-07-25 07:49:23 +00:00
|
|
|
|
(set-marker org-columns-begin-marker nil)
|
2017-09-26 18:03:03 +00:00
|
|
|
|
(when (markerp org-columns-top-level-marker)
|
|
|
|
|
(set-marker org-columns-top-level-marker nil))
|
2018-04-29 10:02:01 +00:00
|
|
|
|
(with-silent-modifications
|
|
|
|
|
(mapc #'delete-overlay org-columns-overlays)
|
|
|
|
|
(setq org-columns-overlays nil)
|
|
|
|
|
(let ((inhibit-read-only t))
|
|
|
|
|
(remove-text-properties (point-min) (point-max) '(read-only t))))
|
2017-07-25 07:49:23 +00:00
|
|
|
|
(when org-columns-flyspell-was-active
|
|
|
|
|
(flyspell-mode 1))
|
|
|
|
|
(when (local-variable-p 'org-colview-initial-truncate-line-value)
|
|
|
|
|
(setq truncate-lines org-colview-initial-truncate-line-value))))
|
2008-04-09 13:42:36 +00:00
|
|
|
|
|
|
|
|
|
(defun org-columns-show-value ()
|
|
|
|
|
"Show the full value of the property."
|
|
|
|
|
(interactive)
|
|
|
|
|
(let ((value (get-char-property (point) 'org-columns-value)))
|
|
|
|
|
(message "Value is: %s" (or value ""))))
|
|
|
|
|
|
2008-04-18 03:42:38 +00:00
|
|
|
|
(defvar org-agenda-columns-active) ;; defined in org-agenda.el
|
2009-08-28 12:50:51 +00:00
|
|
|
|
|
2008-04-09 13:42:36 +00:00
|
|
|
|
(defun org-columns-quit ()
|
|
|
|
|
"Remove the column overlays and in this way exit column editing."
|
|
|
|
|
(interactive)
|
2018-04-29 10:02:01 +00:00
|
|
|
|
(with-silent-modifications
|
|
|
|
|
(org-columns-remove-overlays)
|
|
|
|
|
(let ((inhibit-read-only t))
|
|
|
|
|
(remove-text-properties (point-min) (point-max) '(read-only t))))
|
2016-02-23 14:11:58 +00:00
|
|
|
|
(if (not (eq major-mode 'org-agenda-mode))
|
|
|
|
|
(setq org-columns-current-fmt nil)
|
2008-04-15 12:01:59 +00:00
|
|
|
|
(setq org-agenda-columns-active nil)
|
2008-04-09 13:42:36 +00:00
|
|
|
|
(message
|
|
|
|
|
"Modification not yet reflected in Agenda buffer, use `r' to refresh")))
|
|
|
|
|
|
|
|
|
|
(defun org-columns-check-computed ()
|
2016-02-23 10:15:48 +00:00
|
|
|
|
"Throw an error if current column value is computed."
|
|
|
|
|
(let ((spec (nth (current-column) org-columns-current-fmt-compiled)))
|
|
|
|
|
(and
|
|
|
|
|
(nth 3 spec)
|
|
|
|
|
(assoc spec (get-text-property (line-beginning-position) 'org-summaries))
|
|
|
|
|
(error "This value is computed from the entry's children"))))
|
2008-04-09 13:42:36 +00:00
|
|
|
|
|
2015-10-26 00:56:00 +00:00
|
|
|
|
(defun org-columns-todo (&optional _arg)
|
2008-04-09 13:42:36 +00:00
|
|
|
|
"Change the TODO state during column view."
|
|
|
|
|
(interactive "P")
|
|
|
|
|
(org-columns-edit-value "TODO"))
|
|
|
|
|
|
2019-12-04 22:36:33 +00:00
|
|
|
|
(defun org-columns-toggle-or-columns-quit ()
|
|
|
|
|
"Toggle checkbox at point, or quit column view."
|
|
|
|
|
(interactive)
|
|
|
|
|
(or (org-columns--toggle)
|
|
|
|
|
(org-columns-quit)))
|
|
|
|
|
|
|
|
|
|
(defun org-columns--toggle ()
|
|
|
|
|
"Toggle checkbox at point. Return non-nil if toggle happened, else nil.
|
|
|
|
|
See info documentation about realizing a suitable checkbox."
|
|
|
|
|
(when (string-match "\\`\\[[ xX-]\\]\\'"
|
|
|
|
|
(get-char-property (point) 'org-columns-value))
|
|
|
|
|
(org-columns-next-allowed-value)
|
|
|
|
|
t))
|
2008-04-09 13:42:36 +00:00
|
|
|
|
|
2019-02-17 01:21:04 +00:00
|
|
|
|
(defvar org-overriding-columns-format nil
|
Backport changes from Emacs revs 115081 and 115082
2013-11-12 Stefan Monnier <monnier@iro.umontreal.ca>
Address some byte-compiler warnings.
* ob-abc.el (org-babel-expand-body:abc): Use dolist.
(org-babel-execute:abc): Fix regexp quoting.
* ob-calc.el (org--var-syms): Rename from `var-syms'.
* ob-lilypond.el (ly-compile-lilyfile): Remove redundant let-binding.
* ob-table.el (sbe): Move debug declaration.
* org-clock.el (org--msg-extra): Rename from `msg-extra'.
* org.el (org-version): Avoid var name starting with _.
(org-inhibit-startup, org-called-with-limited-levels)
(org-link-search-inhibit-query, org-time-was-given)
(org-end-time-was-given, org-def, org-defdecode, org-with-time):
* org-colview.el (org-agenda-overriding-columns-format):
* org-agenda.el (org-agenda-multi, org-depend-tag-blocked)
(org-agenda-show-log-scoped):
* ob-python.el (py-which-bufname, python-shell-buffer-name):
* ob-haskell.el (org-export-copy-to-kill-ring):
* ob-exp.el (org-link-search-inhibit-query):
* ob-R.el (ess-eval-visibly-p):
* ob-core.el (org-src-window-setup): Declare before use.
(org-babel-expand-noweb-references): Remove unused `blocks-in-buffer'.
* ox-odt.el (org-odt-hfy-face-to-css):
* org-src.el (org-src-associate-babel-session, org-src-get-lang-mode):
* org-bibtex.el (org-bibtex-get, org-bibtex-ask, org-bibtex)
(org-bibtex-check):
* ob-tangle.el (org-babel-tangle, org-babel-spec-to-string)
(org-babel-tangle-single-block, org-babel-tangle-comment-links):
* ob-table.el (sbe):
* ob-sqlite.el (org-babel-sqlite-expand-vars):
* ob-sql.el (org-babel-sql-expand-vars):
* ob-shen.el (org-babel-execute:shen):
* ob-sh.el (org-babel-execute:sh, org-babel-sh-evaluate):
* ob-scala.el (org-babel-scala-evaluate):
* ob-ruby.el (org-babel-ruby-table-or-string)
(org-babel-ruby-evaluate):
* ob-python.el (org-babel-python-table-or-string)
(org-babel-python-evaluate-external-process)
(org-babel-python-evaluate-session):
* ob-picolisp.el (org-babel-execute:picolisp):
* ob-perl.el (org-babel-perl-evaluate):
* ob-maxima.el (org-babel-execute:maxima):
* ob-lisp.el (org-babel-execute:lisp):
* ob-java.el (org-babel-execute:java):
* ob-io.el (org-babel-io-evaluate):
* ob-haskell.el (org-babel-execute:haskell):
* ob-fortran.el (org-babel-execute:fortran):
* ob-exp.el (org-babel-exp-code):
* ob-emacs-lisp.el (org-babel-execute:emacs-lisp):
* ob-ditaa.el (org-babel-execute:ditaa):
* ob-core.el (org-babel-execute-src-block, org-babel-sha1-hash)
(org-babel-parse-header-arguments, org-babel-reassemble-table)
(org-babel-goto-src-block-head, org-babel-mark-block)
(org-babel-expand-noweb-references, org-babel-script-escape)
(org-babel-process-file-name):
* ob-clojure.el (org-babel-execute:clojure):
* ob-calc.el (org-babel-execute:calc):
* ob-awk.el (org-babel-execute:awk):
* ob-abc.el (org-babel-execute:abc):
* ob-R.el (org-babel-expand-body:R):
* ob-C.el (org-babel-C-execute): Avoid deprecated ((lambda) ...).
2013-11-12 Glenn Morris <rgm@gnu.org>
* ox-html.el (org-html-scripts): Add 2013 to copyright years.
(org-html-infojs-template): Copyright holder to FSF.
2013-11-12 19:57:31 +00:00
|
|
|
|
"When set, overrides any other format definition for the agenda.
|
2019-02-17 01:21:04 +00:00
|
|
|
|
Don't set this, this is meant for dynamic scoping. Set
|
2019-08-15 07:18:10 +00:00
|
|
|
|
`org-columns-default-format' and `org-columns-default-format-for-agenda'
|
|
|
|
|
instead. You should use this variable only in the local settings
|
|
|
|
|
section for a custom agenda view.")
|
2019-02-17 01:21:04 +00:00
|
|
|
|
|
|
|
|
|
(defvar-local org-local-columns-format nil
|
Backport changes from Emacs revs 115081 and 115082
2013-11-12 Stefan Monnier <monnier@iro.umontreal.ca>
Address some byte-compiler warnings.
* ob-abc.el (org-babel-expand-body:abc): Use dolist.
(org-babel-execute:abc): Fix regexp quoting.
* ob-calc.el (org--var-syms): Rename from `var-syms'.
* ob-lilypond.el (ly-compile-lilyfile): Remove redundant let-binding.
* ob-table.el (sbe): Move debug declaration.
* org-clock.el (org--msg-extra): Rename from `msg-extra'.
* org.el (org-version): Avoid var name starting with _.
(org-inhibit-startup, org-called-with-limited-levels)
(org-link-search-inhibit-query, org-time-was-given)
(org-end-time-was-given, org-def, org-defdecode, org-with-time):
* org-colview.el (org-agenda-overriding-columns-format):
* org-agenda.el (org-agenda-multi, org-depend-tag-blocked)
(org-agenda-show-log-scoped):
* ob-python.el (py-which-bufname, python-shell-buffer-name):
* ob-haskell.el (org-export-copy-to-kill-ring):
* ob-exp.el (org-link-search-inhibit-query):
* ob-R.el (ess-eval-visibly-p):
* ob-core.el (org-src-window-setup): Declare before use.
(org-babel-expand-noweb-references): Remove unused `blocks-in-buffer'.
* ox-odt.el (org-odt-hfy-face-to-css):
* org-src.el (org-src-associate-babel-session, org-src-get-lang-mode):
* org-bibtex.el (org-bibtex-get, org-bibtex-ask, org-bibtex)
(org-bibtex-check):
* ob-tangle.el (org-babel-tangle, org-babel-spec-to-string)
(org-babel-tangle-single-block, org-babel-tangle-comment-links):
* ob-table.el (sbe):
* ob-sqlite.el (org-babel-sqlite-expand-vars):
* ob-sql.el (org-babel-sql-expand-vars):
* ob-shen.el (org-babel-execute:shen):
* ob-sh.el (org-babel-execute:sh, org-babel-sh-evaluate):
* ob-scala.el (org-babel-scala-evaluate):
* ob-ruby.el (org-babel-ruby-table-or-string)
(org-babel-ruby-evaluate):
* ob-python.el (org-babel-python-table-or-string)
(org-babel-python-evaluate-external-process)
(org-babel-python-evaluate-session):
* ob-picolisp.el (org-babel-execute:picolisp):
* ob-perl.el (org-babel-perl-evaluate):
* ob-maxima.el (org-babel-execute:maxima):
* ob-lisp.el (org-babel-execute:lisp):
* ob-java.el (org-babel-execute:java):
* ob-io.el (org-babel-io-evaluate):
* ob-haskell.el (org-babel-execute:haskell):
* ob-fortran.el (org-babel-execute:fortran):
* ob-exp.el (org-babel-exp-code):
* ob-emacs-lisp.el (org-babel-execute:emacs-lisp):
* ob-ditaa.el (org-babel-execute:ditaa):
* ob-core.el (org-babel-execute-src-block, org-babel-sha1-hash)
(org-babel-parse-header-arguments, org-babel-reassemble-table)
(org-babel-goto-src-block-head, org-babel-mark-block)
(org-babel-expand-noweb-references, org-babel-script-escape)
(org-babel-process-file-name):
* ob-clojure.el (org-babel-execute:clojure):
* ob-calc.el (org-babel-execute:calc):
* ob-awk.el (org-babel-execute:awk):
* ob-abc.el (org-babel-execute:abc):
* ob-R.el (org-babel-expand-body:R):
* ob-C.el (org-babel-C-execute): Avoid deprecated ((lambda) ...).
2013-11-12 Glenn Morris <rgm@gnu.org>
* ox-html.el (org-html-scripts): Add 2013 to copyright years.
(org-html-infojs-template): Copyright holder to FSF.
2013-11-12 19:57:31 +00:00
|
|
|
|
"When set, overrides any other format definition for the agenda.
|
2019-02-17 01:21:04 +00:00
|
|
|
|
This can be set as a buffer local value to avoid interfering with
|
|
|
|
|
dynamic scoping for `org-overriding-columns-format'.")
|
Backport changes from Emacs revs 115081 and 115082
2013-11-12 Stefan Monnier <monnier@iro.umontreal.ca>
Address some byte-compiler warnings.
* ob-abc.el (org-babel-expand-body:abc): Use dolist.
(org-babel-execute:abc): Fix regexp quoting.
* ob-calc.el (org--var-syms): Rename from `var-syms'.
* ob-lilypond.el (ly-compile-lilyfile): Remove redundant let-binding.
* ob-table.el (sbe): Move debug declaration.
* org-clock.el (org--msg-extra): Rename from `msg-extra'.
* org.el (org-version): Avoid var name starting with _.
(org-inhibit-startup, org-called-with-limited-levels)
(org-link-search-inhibit-query, org-time-was-given)
(org-end-time-was-given, org-def, org-defdecode, org-with-time):
* org-colview.el (org-agenda-overriding-columns-format):
* org-agenda.el (org-agenda-multi, org-depend-tag-blocked)
(org-agenda-show-log-scoped):
* ob-python.el (py-which-bufname, python-shell-buffer-name):
* ob-haskell.el (org-export-copy-to-kill-ring):
* ob-exp.el (org-link-search-inhibit-query):
* ob-R.el (ess-eval-visibly-p):
* ob-core.el (org-src-window-setup): Declare before use.
(org-babel-expand-noweb-references): Remove unused `blocks-in-buffer'.
* ox-odt.el (org-odt-hfy-face-to-css):
* org-src.el (org-src-associate-babel-session, org-src-get-lang-mode):
* org-bibtex.el (org-bibtex-get, org-bibtex-ask, org-bibtex)
(org-bibtex-check):
* ob-tangle.el (org-babel-tangle, org-babel-spec-to-string)
(org-babel-tangle-single-block, org-babel-tangle-comment-links):
* ob-table.el (sbe):
* ob-sqlite.el (org-babel-sqlite-expand-vars):
* ob-sql.el (org-babel-sql-expand-vars):
* ob-shen.el (org-babel-execute:shen):
* ob-sh.el (org-babel-execute:sh, org-babel-sh-evaluate):
* ob-scala.el (org-babel-scala-evaluate):
* ob-ruby.el (org-babel-ruby-table-or-string)
(org-babel-ruby-evaluate):
* ob-python.el (org-babel-python-table-or-string)
(org-babel-python-evaluate-external-process)
(org-babel-python-evaluate-session):
* ob-picolisp.el (org-babel-execute:picolisp):
* ob-perl.el (org-babel-perl-evaluate):
* ob-maxima.el (org-babel-execute:maxima):
* ob-lisp.el (org-babel-execute:lisp):
* ob-java.el (org-babel-execute:java):
* ob-io.el (org-babel-io-evaluate):
* ob-haskell.el (org-babel-execute:haskell):
* ob-fortran.el (org-babel-execute:fortran):
* ob-exp.el (org-babel-exp-code):
* ob-emacs-lisp.el (org-babel-execute:emacs-lisp):
* ob-ditaa.el (org-babel-execute:ditaa):
* ob-core.el (org-babel-execute-src-block, org-babel-sha1-hash)
(org-babel-parse-header-arguments, org-babel-reassemble-table)
(org-babel-goto-src-block-head, org-babel-mark-block)
(org-babel-expand-noweb-references, org-babel-script-escape)
(org-babel-process-file-name):
* ob-clojure.el (org-babel-execute:clojure):
* ob-calc.el (org-babel-execute:calc):
* ob-awk.el (org-babel-execute:awk):
* ob-abc.el (org-babel-execute:abc):
* ob-R.el (org-babel-expand-body:R):
* ob-C.el (org-babel-C-execute): Avoid deprecated ((lambda) ...).
2013-11-12 Glenn Morris <rgm@gnu.org>
* ox-html.el (org-html-scripts): Add 2013 to copyright years.
(org-html-infojs-template): Copyright holder to FSF.
2013-11-12 19:57:31 +00:00
|
|
|
|
|
2008-04-09 13:42:36 +00:00
|
|
|
|
(defun org-columns-edit-value (&optional key)
|
|
|
|
|
"Edit the value of the property at point in column view.
|
|
|
|
|
Where possible, use the standard interface for changing this line."
|
|
|
|
|
(interactive)
|
|
|
|
|
(org-columns-check-computed)
|
2009-02-20 08:12:10 +00:00
|
|
|
|
(let* ((col (current-column))
|
2016-06-24 07:57:53 +00:00
|
|
|
|
(bol (line-beginning-position))
|
|
|
|
|
(eol (line-end-position))
|
|
|
|
|
(pom (or (get-text-property bol 'org-hd-marker) (point)))
|
2016-06-24 08:06:02 +00:00
|
|
|
|
(key (or key (get-char-property (point) 'org-columns-key)))
|
2017-10-21 02:40:09 +00:00
|
|
|
|
(org-columns--time (float-time))
|
2016-06-24 07:57:53 +00:00
|
|
|
|
(action
|
2016-06-24 08:06:02 +00:00
|
|
|
|
(pcase key
|
2016-06-24 07:57:53 +00:00
|
|
|
|
("CLOCKSUM"
|
Many small code improvements
* lisp/org-capture.el (org-capture-member): Make obsolete; the old
definition was identical to ‘org-capture-get’ anyway.
(org-capture-mode-map): Move the calls to ‘define-key’ up to where the
variable is defined.
(org-capture-mode-hook): Small docstring tweak.
(org-capture-mode): Fix typo in mode lighter.
(org-capture-set-target-location, org-capture-place-item):
(org-capture-place-plain-text, org-capture-narrow):
(org-capture-empty-lines-after):
(org-capture-import-remember-templates): ‘if’ without else -> ‘when’
* lisp/org-colview.el (org-columns-edit-value): Change an error to a
user-error.
(org-columns-uncompile-format): Improve docstring.
* lisp/org-compat.el (org-remove-from-invisibility-spec): Make
obsolete, the underlying emacs function exists since 1997, commit 31aa282e.
(org-in-invisibility-spec-p, org-count-lines): ‘if’ without else -> ‘when’.
* lisp/org-element.el (org-element-swap-A-B):
* lisp/org-entities.el (org-entities-create-table):
* lisp/org-list.el (org-insert-item):
* lisp/org-macs.el (org-with-point-at, org-base-buffer):
(org-preserve-local-variables, org-overlay-display):
(org-overlay-before-string): ‘if’ without else -> ‘when’.
* lisp/org-eshell.el (org-eshell-open): Fix docstring typo.
* lisp/org-pcomplete.el (pcomplete/org-mode/file-option/language):
(pcomplete/org-mode/file-option/startup):
(pcomplete/org-mode/file-option/options):
(pcomplete/org-mode/file-option/infojs_opt):
(pcomplete/org-mode/link, pcomplete/org-mode/tex):
(pcomplete/org-mode/todo, pcomplete/org-mode/searchhead):
(pcomplete/org-mode/tag, pcomplete/org-mode/prop): Avoid the formerly
misspelled ‘pcomplete-uniqify-list’ function. It has a defalias in
emacs >= 27; we add our own for older emacsen.
(pcomplete/org-mode/file-option/bind): ‘if’ without else -> ‘when’.
* lisp/org-protocol.el (org-protocol-capture):
(org-protocol-convert-query-to-plist): ‘if’ without else -> ‘when’.
(org-protocol-do-capture): Pacify byte compiler, simplify conditional
logic.
* lisp/org-table.el (org-table-create-with-table.el): Simplify conditional
logic.
(org-table-create, org-table-convert-region, org-table-next-field):
(org-table-beginning-of-field, org-table-end-of-field):
* lisp/org-w3m.el (org-w3m-copy-for-org-mode): ‘if’ without else ->
‘when’.
* lisp/org.el (org-babel-do-load-languages, org-previous-link):
(org-refile): Use ‘(foo ...)’ instead of ‘(funcall 'foo ...)’.
(org-add-log-note): Convert a long cond into a cl-case.
(org-priority): Improve docstring, show a deprecation warning if the
‘show’ argument is passed (which was previously silently ignored).
Also, use ?\s instead of ?\ as a character literal for space.
(org-fast-tag-insert): Fix docstring typo.
(org-fill-element): ‘if’ without else -> ‘when’.
(org-on-target-p): Remove ancient compatibility alias.
2018-05-10 01:02:35 +00:00
|
|
|
|
(user-error "This special column cannot be edited"))
|
2016-06-24 07:57:53 +00:00
|
|
|
|
("ITEM"
|
|
|
|
|
(lambda () (org-with-point-at pom (org-edit-headline))))
|
|
|
|
|
("TODO"
|
|
|
|
|
(lambda ()
|
|
|
|
|
(org-with-point-at pom (call-interactively #'org-todo))))
|
|
|
|
|
("PRIORITY"
|
|
|
|
|
(lambda ()
|
|
|
|
|
(org-with-point-at pom
|
|
|
|
|
(call-interactively #'org-priority))))
|
|
|
|
|
("TAGS"
|
|
|
|
|
(lambda ()
|
|
|
|
|
(org-with-point-at pom
|
|
|
|
|
(let ((org-fast-tag-selection-single-key
|
|
|
|
|
(if (eq org-fast-tag-selection-single-key 'expert)
|
|
|
|
|
t
|
|
|
|
|
org-fast-tag-selection-single-key)))
|
2018-04-20 08:45:19 +00:00
|
|
|
|
(call-interactively #'org-set-tags-command)))))
|
2016-06-24 07:57:53 +00:00
|
|
|
|
("DEADLINE"
|
|
|
|
|
(lambda ()
|
|
|
|
|
(org-with-point-at pom (call-interactively #'org-deadline))))
|
|
|
|
|
("SCHEDULED"
|
|
|
|
|
(lambda ()
|
|
|
|
|
(org-with-point-at pom (call-interactively #'org-schedule))))
|
2016-06-24 08:06:02 +00:00
|
|
|
|
("BEAMER_ENV"
|
2016-06-24 07:57:53 +00:00
|
|
|
|
(lambda ()
|
|
|
|
|
(org-with-point-at pom
|
|
|
|
|
(call-interactively #'org-beamer-select-environment))))
|
2016-06-24 08:06:02 +00:00
|
|
|
|
(_
|
2016-06-24 07:57:53 +00:00
|
|
|
|
(let* ((allowed (org-property-get-allowed-values pom key 'table))
|
|
|
|
|
(value (get-char-property (point) 'org-columns-value))
|
|
|
|
|
(nval (org-trim
|
|
|
|
|
(if (null allowed) (read-string "Edit: " value)
|
|
|
|
|
(completing-read
|
|
|
|
|
"Value: " allowed nil
|
|
|
|
|
(not (get-text-property
|
|
|
|
|
0 'org-unrestricted (caar allowed))))))))
|
|
|
|
|
(and (not (equal nval value))
|
|
|
|
|
(lambda () (org-entry-put pom key nval))))))))
|
2008-04-09 13:42:36 +00:00
|
|
|
|
(cond
|
2016-06-24 07:57:53 +00:00
|
|
|
|
((null action))
|
|
|
|
|
((eq major-mode 'org-agenda-mode)
|
|
|
|
|
(org-columns--call action)
|
|
|
|
|
;; The following let preserves the current format, and makes
|
|
|
|
|
;; sure that in only a single file things need to be updated.
|
2019-02-17 01:21:04 +00:00
|
|
|
|
(let* ((org-overriding-columns-format org-columns-current-fmt)
|
2016-06-24 07:57:53 +00:00
|
|
|
|
(buffer (marker-buffer pom))
|
|
|
|
|
(org-agenda-contributing-files
|
|
|
|
|
(list (with-current-buffer buffer
|
|
|
|
|
(buffer-file-name (buffer-base-buffer))))))
|
|
|
|
|
(org-agenda-columns)))
|
2008-04-09 13:42:36 +00:00
|
|
|
|
(t
|
2016-06-24 07:57:53 +00:00
|
|
|
|
(let ((inhibit-read-only t))
|
2018-04-29 10:02:01 +00:00
|
|
|
|
(with-silent-modifications
|
|
|
|
|
(remove-text-properties (max (point-min) (1- bol)) eol '(read-only t)))
|
2016-06-24 07:57:53 +00:00
|
|
|
|
(org-columns--call action))
|
|
|
|
|
;; Some properties can modify headline (e.g., "TODO"), and
|
|
|
|
|
;; possible shuffle overlays. Make sure they are still all at
|
|
|
|
|
;; the right place on the current line.
|
|
|
|
|
(let ((org-columns-inhibit-recalculation)) (org-columns-redo))
|
|
|
|
|
(org-columns-update key)
|
|
|
|
|
(org-move-to-column col)))))
|
2008-04-09 13:42:36 +00:00
|
|
|
|
|
|
|
|
|
(defun org-columns-edit-allowed ()
|
|
|
|
|
"Edit the list of allowed values for the current property."
|
|
|
|
|
(interactive)
|
2009-09-25 08:48:59 +00:00
|
|
|
|
(let* ((pom (or (org-get-at-bol 'org-marker)
|
|
|
|
|
(org-get-at-bol 'org-hd-marker)
|
2008-04-15 09:02:10 +00:00
|
|
|
|
(point)))
|
2017-07-25 07:49:23 +00:00
|
|
|
|
(key (concat (or (get-char-property (point) 'org-columns-key)
|
|
|
|
|
(user-error "No column to edit at point"))
|
|
|
|
|
"_ALL"))
|
|
|
|
|
(allowed (org-entry-get pom key t))
|
|
|
|
|
(new-value (read-string "Allowed: " allowed)))
|
2008-04-09 13:42:36 +00:00
|
|
|
|
;; FIXME: Cover editing TODO, TAGS etc in-buffer settings.????
|
2008-04-15 09:02:10 +00:00
|
|
|
|
;; FIXME: Write back to #+PROPERTY setting if that is needed.
|
2008-04-09 13:42:36 +00:00
|
|
|
|
(org-entry-put
|
|
|
|
|
(cond ((marker-position org-entry-property-inherited-from)
|
|
|
|
|
org-entry-property-inherited-from)
|
|
|
|
|
((marker-position org-columns-top-level-marker)
|
2008-04-15 09:02:10 +00:00
|
|
|
|
org-columns-top-level-marker)
|
|
|
|
|
(t pom))
|
2017-07-25 07:49:23 +00:00
|
|
|
|
key new-value)))
|
2008-04-09 13:42:36 +00:00
|
|
|
|
|
2016-06-24 07:57:53 +00:00
|
|
|
|
(defun org-columns--call (fun)
|
|
|
|
|
"Call function FUN while preserving heading visibility.
|
|
|
|
|
FUN is a function called with no argument."
|
|
|
|
|
(let ((hide-body (and (/= (line-end-position) (point-max))
|
|
|
|
|
(save-excursion
|
|
|
|
|
(move-beginning-of-line 2)
|
2022-01-16 07:11:04 +00:00
|
|
|
|
(org-at-heading-p)))))
|
2016-06-24 07:57:53 +00:00
|
|
|
|
(unwind-protect (funcall fun)
|
2022-01-16 07:07:25 +00:00
|
|
|
|
(when hide-body (org-fold-hide-entry)))))
|
2008-04-09 13:42:36 +00:00
|
|
|
|
|
|
|
|
|
(defun org-columns-previous-allowed-value ()
|
|
|
|
|
"Switch to the previous allowed value for this column."
|
|
|
|
|
(interactive)
|
|
|
|
|
(org-columns-next-allowed-value t))
|
|
|
|
|
|
2008-06-09 07:53:19 +00:00
|
|
|
|
(defun org-columns-next-allowed-value (&optional previous nth)
|
|
|
|
|
"Switch to the next allowed value for this column.
|
|
|
|
|
When PREVIOUS is set, go to the previous value. When NTH is
|
|
|
|
|
an integer, select that value."
|
2008-04-09 13:42:36 +00:00
|
|
|
|
(interactive)
|
|
|
|
|
(org-columns-check-computed)
|
2016-02-23 17:38:48 +00:00
|
|
|
|
(let* ((column (current-column))
|
2008-04-09 13:42:36 +00:00
|
|
|
|
(key (get-char-property (point) 'org-columns-key))
|
|
|
|
|
(value (get-char-property (point) 'org-columns-value))
|
2016-02-23 17:38:48 +00:00
|
|
|
|
(pom (or (get-text-property (line-beginning-position) 'org-hd-marker)
|
|
|
|
|
(point)))
|
2016-02-20 14:13:03 +00:00
|
|
|
|
(allowed
|
2016-02-23 17:38:48 +00:00
|
|
|
|
(let ((all
|
|
|
|
|
(or (org-property-get-allowed-values pom key)
|
|
|
|
|
(pcase (nth column org-columns-current-fmt-compiled)
|
|
|
|
|
(`(,_ ,_ ,_ ,(or "X" "X/" "X%") ,_) '("[ ]" "[X]")))
|
|
|
|
|
(org-colview-construct-allowed-dates value))))
|
|
|
|
|
(if previous (reverse all) all))))
|
|
|
|
|
(when (equal key "ITEM") (error "Cannot edit item headline from here"))
|
2012-08-30 14:42:13 +00:00
|
|
|
|
(unless (or allowed (member key '("SCHEDULED" "DEADLINE" "CLOCKSUM")))
|
2008-04-09 13:42:36 +00:00
|
|
|
|
(error "Allowed values for this property have not been defined"))
|
2016-02-23 17:38:48 +00:00
|
|
|
|
(let* ((l (length allowed))
|
|
|
|
|
(new
|
|
|
|
|
(cond
|
|
|
|
|
((member key '("SCHEDULED" "DEADLINE" "CLOCKSUM"))
|
|
|
|
|
(if previous 'earlier 'later))
|
|
|
|
|
((integerp nth)
|
|
|
|
|
(when (> (abs nth) l)
|
|
|
|
|
(user-error "Only %d allowed values for property `%s'" l key))
|
|
|
|
|
(nth (mod (1- nth) l) allowed))
|
|
|
|
|
((member value allowed)
|
|
|
|
|
(when (= l 1) (error "Only one allowed value for this property"))
|
|
|
|
|
(or (nth 1 (member value allowed)) (car allowed)))
|
|
|
|
|
(t (car allowed))))
|
2016-06-24 07:57:53 +00:00
|
|
|
|
(action (lambda () (org-entry-put pom key new))))
|
2008-06-09 07:53:19 +00:00
|
|
|
|
(cond
|
2016-09-25 15:29:06 +00:00
|
|
|
|
((eq major-mode 'org-agenda-mode)
|
2016-06-24 07:57:53 +00:00
|
|
|
|
(org-columns--call action)
|
2016-02-23 17:38:48 +00:00
|
|
|
|
;; The following let preserves the current format, and makes
|
|
|
|
|
;; sure that in only a single file things need to be updated.
|
2019-02-17 01:21:04 +00:00
|
|
|
|
(let* ((org-overriding-columns-format org-columns-current-fmt)
|
2016-02-23 17:38:48 +00:00
|
|
|
|
(buffer (marker-buffer pom))
|
|
|
|
|
(org-agenda-contributing-files
|
|
|
|
|
(list (with-current-buffer buffer
|
|
|
|
|
(buffer-file-name (buffer-base-buffer))))))
|
|
|
|
|
(org-agenda-columns)))
|
|
|
|
|
(t
|
|
|
|
|
(let ((inhibit-read-only t))
|
|
|
|
|
(remove-text-properties (line-end-position 0) (line-end-position)
|
|
|
|
|
'(read-only t))
|
2016-06-24 07:57:53 +00:00
|
|
|
|
(org-columns--call action))
|
2016-02-23 17:38:48 +00:00
|
|
|
|
;; Some properties can modify headline (e.g., "TODO"), and
|
|
|
|
|
;; possible shuffle overlays. Make sure they are still all at
|
|
|
|
|
;; the right place on the current line.
|
|
|
|
|
(let ((org-columns-inhibit-recalculation)) (org-columns-redo))
|
|
|
|
|
(org-columns-update key)
|
|
|
|
|
(org-move-to-column column))))))
|
2008-04-09 13:42:36 +00:00
|
|
|
|
|
2008-09-18 08:24:57 +00:00
|
|
|
|
(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."
|
2009-01-16 11:50:09 +00:00
|
|
|
|
(when (and s (string-match (concat "^" org-ts-regexp3 "$") s))
|
2008-09-18 08:24:57 +00:00
|
|
|
|
(let* ((time (org-parse-time-string s 'nodefaults))
|
|
|
|
|
(active (equal (string-to-char s) ?<))
|
2008-09-19 06:30:22 +00:00
|
|
|
|
(fmt (funcall (if (nth 1 time) 'cdr 'car) org-time-stamp-formats))
|
|
|
|
|
time-before time-after)
|
2008-09-18 08:24:57 +00:00
|
|
|
|
(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)))
|
2021-05-18 23:36:54 +00:00
|
|
|
|
(mapcar (lambda (x) (format-time-string fmt (apply #'encode-time x)))
|
2008-09-18 08:24:57 +00:00
|
|
|
|
(list time-before time time-after)))))
|
|
|
|
|
|
2008-04-09 13:42:36 +00:00
|
|
|
|
(defun org-columns-open-link (&optional arg)
|
|
|
|
|
(interactive "P")
|
|
|
|
|
(let ((value (get-char-property (point) 'org-columns-value)))
|
2018-11-26 23:04:41 +00:00
|
|
|
|
(org-link-open-from-string value arg)))
|
2008-04-09 13:42:36 +00:00
|
|
|
|
|
2013-11-15 05:53:59 +00:00
|
|
|
|
;;;###autoload
|
2008-04-09 13:42:36 +00:00
|
|
|
|
(defun org-columns-get-format-and-top-level ()
|
2012-08-12 21:00:55 +00:00
|
|
|
|
(let ((fmt (org-columns-get-format)))
|
2012-08-12 09:48:44 +00:00
|
|
|
|
(org-columns-goto-top-level)
|
|
|
|
|
fmt))
|
|
|
|
|
|
|
|
|
|
(defun org-columns-get-format (&optional fmt-string)
|
2016-02-23 14:11:58 +00:00
|
|
|
|
"Return columns format specifications.
|
|
|
|
|
When optional argument FMT-STRING is non-nil, use it as the
|
|
|
|
|
current specifications. This function also sets
|
|
|
|
|
`org-columns-current-fmt-compiled' and
|
|
|
|
|
`org-columns-current-fmt'."
|
2012-08-12 09:48:44 +00:00
|
|
|
|
(interactive)
|
2016-02-23 14:11:58 +00:00
|
|
|
|
(let ((format
|
|
|
|
|
(or fmt-string
|
|
|
|
|
(org-entry-get nil "COLUMNS" t)
|
|
|
|
|
(org-with-wide-buffer
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(catch :found
|
|
|
|
|
(let ((case-fold-search t))
|
|
|
|
|
(while (re-search-forward "^[ \t]*#\\+COLUMNS: .+$" nil t)
|
|
|
|
|
(let ((element (org-element-at-point)))
|
|
|
|
|
(when (eq (org-element-type element) 'keyword)
|
|
|
|
|
(throw :found (org-element-property :value element)))))
|
|
|
|
|
nil)))
|
|
|
|
|
org-columns-default-format)))
|
|
|
|
|
(setq org-columns-current-fmt format)
|
|
|
|
|
(org-columns-compile-format format)
|
|
|
|
|
format))
|
2008-04-09 13:42:36 +00:00
|
|
|
|
|
2012-08-12 09:48:44 +00:00
|
|
|
|
(defun org-columns-goto-top-level ()
|
2015-08-12 12:49:02 +00:00
|
|
|
|
"Move to the beginning of the column view area.
|
|
|
|
|
Also sets `org-columns-top-level-marker' to the new position."
|
2017-07-25 07:49:23 +00:00
|
|
|
|
(unless (markerp org-columns-top-level-marker)
|
|
|
|
|
(setq org-columns-top-level-marker (make-marker)))
|
2015-08-12 12:49:02 +00:00
|
|
|
|
(goto-char
|
|
|
|
|
(move-marker
|
|
|
|
|
org-columns-top-level-marker
|
|
|
|
|
(cond ((org-before-first-heading-p) (point-min))
|
|
|
|
|
((org-entry-get nil "COLUMNS" t) org-entry-property-inherited-from)
|
|
|
|
|
(t (org-back-to-heading) (point))))))
|
2012-08-12 09:48:44 +00:00
|
|
|
|
|
Update autoloads.
* org.el: Don't dynamically autoload already autoloaded
functions.
(org-clock-update-time-maybe): Move to org-clock.el.
* org-exp.el (org-insert-export-options-template): Remove
autoload cookie.
* org-clock.el (org-resolve-clocks, org-clock-in)
(org-clock-out, org-clock-cancel, org-clock-goto)
(org-clock-sum, org-clock-display, org-clock-report)
(org-dblock-write:clocktable): Add autoload cookie.
(org-clock-update-time-maybe): Moved from org.el.
* org-beamer.el (org-beamer-sectioning, org-beamer-mode): Ditto.
* org-ascii.el (org-export-ascii-preprocess): Ditto.
* org-archive.el (org-archive-subtree)
(org-archive-to-archive-sibling, org-toggle-archive-tag): Add
autoload cookie.
* org-colview.el (org-columns, org-dblock-write:columnview)
(org-insert-columns-dblock, org-agenda-columns): Ditto.
* org-table.el (org-table-create-with-table.el)
(org-table-create-or-convert-from-region, org-table-create)
(org-table-convert-region, org-table-import)
(org-table-export, org-table-align)
(org-table-justify-field-maybe, org-table-next-field)
(org-table-previous-field, org-table-next-row)
(org-table-copy-down, org-table-field-info)
(org-table-current-dline, org-table-goto-column)
(org-table-insert-column, org-table-delete-column)
(org-table-move-column-right, org-table-move-column-left)
(org-table-move-column, org-table-move-row-down)
(org-table-move-row-up, org-table-move-row)
(org-table-insert-row, org-table-insert-hline)
(org-table-hline-and-move, org-table-kill-row)
(org-table-sort-lines, org-table-cut-region)
(org-table-copy-region, org-table-paste-rectangle)
(org-table-convert, org-table-wrap-region)
(org-table-edit-field, org-table-sum)
(org-table-get-stored-formulas)
(org-table-maybe-eval-formula)
(org-table-rotate-recalc-marks)
(org-table-maybe-recalculate-line, org-table-eval-formula)
(org-table-recalculate, org-table-iterate)
(org-table-edit-formulas)
(org-table-toggle-coordinate-overlays)
(org-table-toggle-formula-debugger, orgtbl-to-generic)
(orgtbl-to-tsv, orgtbl-to-csv, orgtbl-to-latex)
(orgtbl-to-html, orgtbl-to-texinfo, orgtbl-to-orgtbl): Ditto.
2012-10-02 08:52:17 +00:00
|
|
|
|
;;;###autoload
|
2016-02-14 21:25:49 +00:00
|
|
|
|
(defun org-columns (&optional global columns-fmt-string)
|
|
|
|
|
"Turn on column view on an Org mode file.
|
|
|
|
|
|
2021-05-03 12:49:11 +00:00
|
|
|
|
Column view applies to the whole buffer if point is before the first
|
|
|
|
|
headline. Otherwise, it applies to the first ancestor setting
|
|
|
|
|
\"COLUMNS\" property. If there is none, it defaults to the current
|
|
|
|
|
headline. With a `\\[universal-argument]' prefix \ argument, GLOBAL,
|
|
|
|
|
turn on column view for the whole buffer unconditionally.
|
2016-02-14 21:25:49 +00:00
|
|
|
|
|
2012-08-12 09:48:44 +00:00
|
|
|
|
When COLUMNS-FMT-STRING is non-nil, use it as the column format."
|
2016-02-14 21:25:49 +00:00
|
|
|
|
(interactive "P")
|
2008-04-09 13:42:36 +00:00
|
|
|
|
(org-columns-remove-overlays)
|
2018-07-07 07:27:04 +00:00
|
|
|
|
(save-excursion
|
|
|
|
|
(when global (goto-char (point-min)))
|
|
|
|
|
(if (markerp org-columns-begin-marker)
|
|
|
|
|
(move-marker org-columns-begin-marker (point))
|
|
|
|
|
(setq org-columns-begin-marker (point-marker)))
|
|
|
|
|
(org-columns-goto-top-level)
|
|
|
|
|
;; Initialize `org-columns-current-fmt' and
|
|
|
|
|
;; `org-columns-current-fmt-compiled'.
|
2017-10-21 02:40:09 +00:00
|
|
|
|
(let ((org-columns--time (float-time)))
|
2018-07-07 07:27:04 +00:00
|
|
|
|
(org-columns-get-format columns-fmt-string)
|
|
|
|
|
(unless org-columns-inhibit-recalculation (org-columns-compute-all))
|
2016-02-17 14:16:22 +00:00
|
|
|
|
(save-restriction
|
|
|
|
|
(when (and (not global) (org-at-heading-p))
|
|
|
|
|
(narrow-to-region (point) (org-end-of-subtree t t)))
|
2016-02-22 09:48:00 +00:00
|
|
|
|
(when (assoc "CLOCKSUM" org-columns-current-fmt-compiled)
|
2016-02-17 14:16:22 +00:00
|
|
|
|
(org-clock-sum))
|
2016-02-22 09:48:00 +00:00
|
|
|
|
(when (assoc "CLOCKSUM_T" org-columns-current-fmt-compiled)
|
2016-02-17 14:16:22 +00:00
|
|
|
|
(org-clock-sum-today))
|
|
|
|
|
(let ((cache
|
|
|
|
|
;; Collect contents of columns ahead of time so as to
|
|
|
|
|
;; compute their maximum width.
|
2021-05-03 12:49:11 +00:00
|
|
|
|
(org-scan-tags
|
|
|
|
|
(lambda () (cons (point) (org-columns--collect-values))) t org--matcher-tags-todo-only)))
|
2016-02-17 14:16:22 +00:00
|
|
|
|
(when cache
|
2016-02-22 11:19:22 +00:00
|
|
|
|
(org-columns--set-widths cache)
|
2016-02-17 14:16:22 +00:00
|
|
|
|
(org-columns--display-here-title)
|
|
|
|
|
(when (setq-local org-columns-flyspell-was-active
|
2016-06-23 12:18:38 +00:00
|
|
|
|
(bound-and-true-p flyspell-mode))
|
2016-02-17 14:16:22 +00:00
|
|
|
|
(flyspell-mode 0))
|
|
|
|
|
(unless (local-variable-p 'org-colview-initial-truncate-line-value)
|
|
|
|
|
(setq-local org-colview-initial-truncate-line-value
|
|
|
|
|
truncate-lines))
|
2021-05-02 00:05:09 +00:00
|
|
|
|
(if (not global-visual-line-mode)
|
2021-09-29 07:22:47 +00:00
|
|
|
|
(setq truncate-lines t))
|
2016-02-17 14:16:22 +00:00
|
|
|
|
(dolist (entry cache)
|
|
|
|
|
(goto-char (car entry))
|
|
|
|
|
(org-columns--display-here (cdr entry)))))))))
|
|
|
|
|
|
2016-02-23 15:22:17 +00:00
|
|
|
|
(defun org-columns-new (&optional spec &rest attributes)
|
|
|
|
|
"Insert a new column, to the left of the current column.
|
|
|
|
|
Interactively fill attributes for new column. When column format
|
|
|
|
|
specification SPEC is provided, edit it instead.
|
|
|
|
|
|
|
|
|
|
When optional argument attributes can be a list of columns
|
|
|
|
|
specifications attributes to create the new column
|
|
|
|
|
non-interactively. See `org-columns-compile-format' for
|
|
|
|
|
details."
|
2008-04-09 13:42:36 +00:00
|
|
|
|
(interactive)
|
2016-02-23 15:22:17 +00:00
|
|
|
|
(let ((new (or attributes
|
|
|
|
|
(let ((prop
|
|
|
|
|
(completing-read
|
2016-02-20 14:13:03 +00:00
|
|
|
|
"Property: "
|
2016-02-23 15:22:17 +00:00
|
|
|
|
(mapcar #'list (org-buffer-property-keys t nil t))
|
|
|
|
|
nil nil (nth 0 spec))))
|
|
|
|
|
(list prop
|
|
|
|
|
(read-string (format "Column title [%s]: " prop)
|
|
|
|
|
(nth 1 spec))
|
|
|
|
|
;; Use `read-string' instead of `read-number'
|
|
|
|
|
;; to allow empty width.
|
|
|
|
|
(let ((w (read-string
|
|
|
|
|
"Column width: "
|
|
|
|
|
(and (nth 2 spec)
|
|
|
|
|
(number-to-string (nth 2 spec))))))
|
|
|
|
|
(and (org-string-nw-p w) (string-to-number w)))
|
|
|
|
|
(org-string-nw-p
|
|
|
|
|
(completing-read
|
|
|
|
|
"Summary: "
|
|
|
|
|
(delete-dups
|
|
|
|
|
(cons '("") ;Allow empty operator.
|
|
|
|
|
(mapcar (lambda (x) (list (car x)))
|
|
|
|
|
(append
|
|
|
|
|
org-columns-summary-types
|
|
|
|
|
org-columns-summary-types-default))))
|
|
|
|
|
nil t (nth 3 spec)))
|
|
|
|
|
(org-string-nw-p
|
|
|
|
|
(read-string "Format: " (nth 4 spec))))))))
|
|
|
|
|
(if spec
|
|
|
|
|
(progn (setcar spec (car new))
|
|
|
|
|
(setcdr spec (cdr new)))
|
|
|
|
|
(push new (nthcdr (current-column) org-columns-current-fmt-compiled)))
|
2008-04-09 13:42:36 +00:00
|
|
|
|
(org-columns-store-format)
|
|
|
|
|
(org-columns-redo)))
|
|
|
|
|
|
|
|
|
|
(defun org-columns-delete ()
|
|
|
|
|
"Delete the column at point from columns view."
|
|
|
|
|
(interactive)
|
2016-02-24 23:33:28 +00:00
|
|
|
|
(let ((spec (nth (current-column) org-columns-current-fmt-compiled)))
|
|
|
|
|
(when (y-or-n-p (format "Are you sure you want to remove column %S? "
|
|
|
|
|
(nth 1 spec)))
|
2008-04-09 13:42:36 +00:00
|
|
|
|
(setq org-columns-current-fmt-compiled
|
2016-02-24 23:33:28 +00:00
|
|
|
|
(delq spec org-columns-current-fmt-compiled))
|
2008-04-09 13:42:36 +00:00
|
|
|
|
(org-columns-store-format)
|
2016-02-24 23:33:28 +00:00
|
|
|
|
;; This may leave a now wrong value in a node property. However
|
|
|
|
|
;; updating it may prove counter-intuitive. See comments in
|
|
|
|
|
;; `org-columns-move-right' for details.
|
|
|
|
|
(let ((org-columns-inhibit-recalculation t)) (org-columns-redo))
|
|
|
|
|
(when (>= (current-column) (length org-columns-current-fmt-compiled))
|
|
|
|
|
(backward-char)))))
|
2008-04-09 13:42:36 +00:00
|
|
|
|
|
|
|
|
|
(defun org-columns-edit-attributes ()
|
|
|
|
|
"Edit the attributes of the current column."
|
|
|
|
|
(interactive)
|
2016-02-23 15:22:17 +00:00
|
|
|
|
(org-columns-new (nth (current-column) org-columns-current-fmt-compiled)))
|
2008-04-09 13:42:36 +00:00
|
|
|
|
|
|
|
|
|
(defun org-columns-widen (arg)
|
|
|
|
|
"Make the column wider by ARG characters."
|
|
|
|
|
(interactive "p")
|
|
|
|
|
(let* ((n (current-column))
|
|
|
|
|
(entry (nth n org-columns-current-fmt-compiled))
|
2016-02-22 11:19:22 +00:00
|
|
|
|
(width (aref org-columns-current-maxwidths n)))
|
2008-04-09 13:42:36 +00:00
|
|
|
|
(setq width (max 1 (+ width arg)))
|
|
|
|
|
(setcar (nthcdr 2 entry) width)
|
|
|
|
|
(org-columns-store-format)
|
2016-02-24 23:33:28 +00:00
|
|
|
|
(let ((org-columns-inhibit-recalculation t)) (org-columns-redo))))
|
2008-04-09 13:42:36 +00:00
|
|
|
|
|
|
|
|
|
(defun org-columns-narrow (arg)
|
2008-12-16 14:49:08 +00:00
|
|
|
|
"Make the column narrower by ARG characters."
|
2008-04-09 13:42:36 +00:00
|
|
|
|
(interactive "p")
|
|
|
|
|
(org-columns-widen (- arg)))
|
|
|
|
|
|
|
|
|
|
(defun org-columns-move-right ()
|
|
|
|
|
"Swap this column with the one to the right."
|
|
|
|
|
(interactive)
|
|
|
|
|
(let* ((n (current-column))
|
|
|
|
|
(cell (nthcdr n org-columns-current-fmt-compiled))
|
|
|
|
|
e)
|
|
|
|
|
(when (>= n (1- (length org-columns-current-fmt-compiled)))
|
|
|
|
|
(error "Cannot shift this column further to the right"))
|
|
|
|
|
(setq e (car cell))
|
|
|
|
|
(setcar cell (car (cdr cell)))
|
|
|
|
|
(setcdr cell (cons e (cdr (cdr cell))))
|
|
|
|
|
(org-columns-store-format)
|
2016-02-23 14:26:57 +00:00
|
|
|
|
;; Do not compute again properties, since we're just moving
|
|
|
|
|
;; columns around. It can put a property value a bit off when
|
|
|
|
|
;; switching between an non-computed and a computed value for the
|
|
|
|
|
;; same property, e.g. from "%A %A{+}" to "%A{+} %A".
|
|
|
|
|
;;
|
|
|
|
|
;; In this case, the value needs to be updated since the first
|
|
|
|
|
;; column related to a property determines how its value is
|
|
|
|
|
;; computed. However, (correctly) updating the value could be
|
|
|
|
|
;; surprising, so we leave it as-is nonetheless.
|
|
|
|
|
(let ((org-columns-inhibit-recalculation t)) (org-columns-redo))
|
2008-04-09 13:42:36 +00:00
|
|
|
|
(forward-char 1)))
|
|
|
|
|
|
|
|
|
|
(defun org-columns-move-left ()
|
|
|
|
|
"Swap this column with the one to the left."
|
|
|
|
|
(interactive)
|
|
|
|
|
(let* ((n (current-column)))
|
|
|
|
|
(when (= n 0)
|
|
|
|
|
(error "Cannot shift this column further to the left"))
|
|
|
|
|
(backward-char 1)
|
|
|
|
|
(org-columns-move-right)
|
|
|
|
|
(backward-char 1)))
|
|
|
|
|
|
|
|
|
|
(defun org-columns-store-format ()
|
2016-02-22 21:42:03 +00:00
|
|
|
|
"Store the text version of the current columns format.
|
|
|
|
|
The format is stored either in the COLUMNS property of the node
|
|
|
|
|
starting the current column display, or in a #+COLUMNS line of
|
|
|
|
|
the current buffer."
|
|
|
|
|
(let ((fmt (org-columns-uncompile-format org-columns-current-fmt-compiled)))
|
2015-11-05 16:47:38 +00:00
|
|
|
|
(setq-local org-columns-current-fmt fmt)
|
2017-07-25 07:49:23 +00:00
|
|
|
|
(when org-columns-overlays
|
|
|
|
|
(org-with-point-at org-columns-top-level-marker
|
|
|
|
|
(if (and (org-at-heading-p) (org-entry-get nil "COLUMNS"))
|
|
|
|
|
(org-entry-put nil "COLUMNS" fmt)
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(let ((case-fold-search t))
|
|
|
|
|
;; Try to replace the first COLUMNS keyword available.
|
|
|
|
|
(catch :found
|
|
|
|
|
(while (re-search-forward "^[ \t]*#\\+COLUMNS:\\(.*\\)" nil t)
|
|
|
|
|
(let ((element (save-match-data (org-element-at-point))))
|
|
|
|
|
(when (and (eq (org-element-type element) 'keyword)
|
|
|
|
|
(equal (org-element-property :key element)
|
|
|
|
|
"COLUMNS"))
|
|
|
|
|
(replace-match (concat " " fmt) t t nil 1)
|
|
|
|
|
(throw :found nil))))
|
|
|
|
|
;; No COLUMNS keyword in the buffer. Insert one at the
|
|
|
|
|
;; beginning, right before the first heading, if any.
|
|
|
|
|
(goto-char (point-min))
|
2022-01-16 07:11:04 +00:00
|
|
|
|
(unless (org-at-heading-p) (outline-next-heading))
|
2017-07-25 07:49:23 +00:00
|
|
|
|
(let ((inhibit-read-only t))
|
|
|
|
|
(insert-before-markers "#+COLUMNS: " fmt "\n"))))
|
|
|
|
|
(setq-local org-columns-default-format fmt))))))
|
2008-04-09 13:42:36 +00:00
|
|
|
|
|
|
|
|
|
(defun org-columns-update (property)
|
|
|
|
|
"Recompute PROPERTY, and update the columns display for it."
|
|
|
|
|
(org-columns-compute property)
|
2016-02-17 21:38:39 +00:00
|
|
|
|
(org-with-wide-buffer
|
|
|
|
|
(let ((p (upcase property)))
|
|
|
|
|
(dolist (ov org-columns-overlays)
|
2016-02-22 14:00:31 +00:00
|
|
|
|
(let ((key (overlay-get ov 'org-columns-key)))
|
|
|
|
|
(when (and key (equal key p) (overlay-start ov))
|
|
|
|
|
(goto-char (overlay-start ov))
|
2016-02-24 23:36:05 +00:00
|
|
|
|
(let* ((spec (nth (current-column) org-columns-current-fmt-compiled))
|
2016-02-22 14:00:31 +00:00
|
|
|
|
(value
|
|
|
|
|
(or (cdr (assoc spec
|
|
|
|
|
(get-text-property (line-beginning-position)
|
|
|
|
|
'org-summaries)))
|
|
|
|
|
(org-entry-get (point) key))))
|
|
|
|
|
(when value
|
|
|
|
|
(let ((displayed (org-columns--displayed-value spec value))
|
|
|
|
|
(format (overlay-get ov 'org-columns-format))
|
|
|
|
|
(width
|
|
|
|
|
(aref org-columns-current-maxwidths (current-column))))
|
|
|
|
|
(overlay-put ov 'org-columns-value value)
|
|
|
|
|
(overlay-put ov 'org-columns-value-modified displayed)
|
|
|
|
|
(overlay-put ov
|
|
|
|
|
'display
|
|
|
|
|
(org-columns--overlay-text
|
|
|
|
|
displayed format width property value)))))))))))
|
2008-04-09 13:42:36 +00:00
|
|
|
|
|
2016-02-20 14:36:23 +00:00
|
|
|
|
(defun org-columns-redo ()
|
|
|
|
|
"Construct the column display again."
|
|
|
|
|
(interactive)
|
2017-07-25 07:49:23 +00:00
|
|
|
|
(when org-columns-overlays
|
|
|
|
|
(message "Recomputing columns...")
|
|
|
|
|
(org-with-point-at org-columns-begin-marker
|
|
|
|
|
(org-columns-remove-overlays)
|
|
|
|
|
(if (derived-mode-p 'org-mode)
|
|
|
|
|
;; Since we already know the columns format, provide it
|
|
|
|
|
;; instead of computing again.
|
|
|
|
|
(call-interactively #'org-columns org-columns-current-fmt)
|
|
|
|
|
(org-agenda-redo)
|
|
|
|
|
(call-interactively #'org-agenda-columns)))
|
|
|
|
|
(message "Recomputing columns...done")))
|
2016-02-20 14:36:23 +00:00
|
|
|
|
|
|
|
|
|
(defun org-columns-uncompile-format (compiled)
|
|
|
|
|
"Turn the compiled columns format back into a string representation.
|
Many small code improvements
* lisp/org-capture.el (org-capture-member): Make obsolete; the old
definition was identical to ‘org-capture-get’ anyway.
(org-capture-mode-map): Move the calls to ‘define-key’ up to where the
variable is defined.
(org-capture-mode-hook): Small docstring tweak.
(org-capture-mode): Fix typo in mode lighter.
(org-capture-set-target-location, org-capture-place-item):
(org-capture-place-plain-text, org-capture-narrow):
(org-capture-empty-lines-after):
(org-capture-import-remember-templates): ‘if’ without else -> ‘when’
* lisp/org-colview.el (org-columns-edit-value): Change an error to a
user-error.
(org-columns-uncompile-format): Improve docstring.
* lisp/org-compat.el (org-remove-from-invisibility-spec): Make
obsolete, the underlying emacs function exists since 1997, commit 31aa282e.
(org-in-invisibility-spec-p, org-count-lines): ‘if’ without else -> ‘when’.
* lisp/org-element.el (org-element-swap-A-B):
* lisp/org-entities.el (org-entities-create-table):
* lisp/org-list.el (org-insert-item):
* lisp/org-macs.el (org-with-point-at, org-base-buffer):
(org-preserve-local-variables, org-overlay-display):
(org-overlay-before-string): ‘if’ without else -> ‘when’.
* lisp/org-eshell.el (org-eshell-open): Fix docstring typo.
* lisp/org-pcomplete.el (pcomplete/org-mode/file-option/language):
(pcomplete/org-mode/file-option/startup):
(pcomplete/org-mode/file-option/options):
(pcomplete/org-mode/file-option/infojs_opt):
(pcomplete/org-mode/link, pcomplete/org-mode/tex):
(pcomplete/org-mode/todo, pcomplete/org-mode/searchhead):
(pcomplete/org-mode/tag, pcomplete/org-mode/prop): Avoid the formerly
misspelled ‘pcomplete-uniqify-list’ function. It has a defalias in
emacs >= 27; we add our own for older emacsen.
(pcomplete/org-mode/file-option/bind): ‘if’ without else -> ‘when’.
* lisp/org-protocol.el (org-protocol-capture):
(org-protocol-convert-query-to-plist): ‘if’ without else -> ‘when’.
(org-protocol-do-capture): Pacify byte compiler, simplify conditional
logic.
* lisp/org-table.el (org-table-create-with-table.el): Simplify conditional
logic.
(org-table-create, org-table-convert-region, org-table-next-field):
(org-table-beginning-of-field, org-table-end-of-field):
* lisp/org-w3m.el (org-w3m-copy-for-org-mode): ‘if’ without else ->
‘when’.
* lisp/org.el (org-babel-do-load-languages, org-previous-link):
(org-refile): Use ‘(foo ...)’ instead of ‘(funcall 'foo ...)’.
(org-add-log-note): Convert a long cond into a cl-case.
(org-priority): Improve docstring, show a deprecation warning if the
‘show’ argument is passed (which was previously silently ignored).
Also, use ?\s instead of ?\ as a character literal for space.
(org-fast-tag-insert): Fix docstring typo.
(org-fill-element): ‘if’ without else -> ‘when’.
(org-on-target-p): Remove ancient compatibility alias.
2018-05-10 01:02:35 +00:00
|
|
|
|
|
|
|
|
|
COMPILED is an alist, as returned by `org-columns-compile-format'."
|
2016-02-20 14:36:23 +00:00
|
|
|
|
(mapconcat
|
|
|
|
|
(lambda (spec)
|
|
|
|
|
(pcase spec
|
2016-02-22 13:12:48 +00:00
|
|
|
|
(`(,prop ,title ,width ,op ,printf)
|
2016-02-20 14:36:23 +00:00
|
|
|
|
(concat "%"
|
|
|
|
|
(and width (number-to-string width))
|
|
|
|
|
prop
|
|
|
|
|
(and title (not (equal prop title)) (format "(%s)" title))
|
|
|
|
|
(cond ((not op) nil)
|
|
|
|
|
(printf (format "{%s;%s}" op printf))
|
|
|
|
|
(t (format "{%s}" op)))))))
|
|
|
|
|
compiled " "))
|
|
|
|
|
|
|
|
|
|
(defun org-columns-compile-format (fmt)
|
|
|
|
|
"Turn a column format string FMT into an alist of specifications.
|
|
|
|
|
|
|
|
|
|
The alist has one entry for each column in the format. The elements of
|
|
|
|
|
that list are:
|
2016-02-22 09:48:00 +00:00
|
|
|
|
property the property name, as an upper-case string
|
|
|
|
|
title the title field for the columns, as a string
|
|
|
|
|
width the column width in characters, can be nil for automatic width
|
|
|
|
|
operator the summary operator, as a string, or nil
|
|
|
|
|
printf a printf format for computed values, as a string, or nil
|
2016-02-20 14:36:23 +00:00
|
|
|
|
|
|
|
|
|
This function updates `org-columns-current-fmt-compiled'."
|
|
|
|
|
(setq org-columns-current-fmt-compiled nil)
|
|
|
|
|
(let ((start 0))
|
|
|
|
|
(while (string-match
|
|
|
|
|
"%\\([0-9]+\\)?\\([[:alnum:]_-]+\\)\\(?:(\\([^)]+\\))\\)?\
|
|
|
|
|
\\(?:{\\([^}]+\\)}\\)?\\s-*"
|
|
|
|
|
fmt start)
|
|
|
|
|
(setq start (match-end 0))
|
|
|
|
|
(let* ((width (and (match-end 1) (string-to-number (match-string 1 fmt))))
|
2016-02-22 09:48:00 +00:00
|
|
|
|
(prop (match-string-no-properties 2 fmt))
|
|
|
|
|
(title (or (match-string-no-properties 3 fmt) prop))
|
|
|
|
|
(operator (match-string-no-properties 4 fmt)))
|
2016-02-22 13:12:48 +00:00
|
|
|
|
(push (if (not operator) (list (upcase prop) title width nil nil)
|
2016-02-20 23:16:51 +00:00
|
|
|
|
(let (printf)
|
|
|
|
|
(when (string-match ";" operator)
|
|
|
|
|
(setq printf (substring operator (match-end 0)))
|
|
|
|
|
(setq operator (substring operator 0 (match-beginning 0))))
|
2016-02-22 13:12:48 +00:00
|
|
|
|
(list (upcase prop) title width operator printf)))
|
2016-02-20 14:36:23 +00:00
|
|
|
|
org-columns-current-fmt-compiled)))
|
|
|
|
|
(setq org-columns-current-fmt-compiled
|
|
|
|
|
(nreverse org-columns-current-fmt-compiled))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;;; Column View Summary
|
|
|
|
|
|
2017-02-08 21:24:32 +00:00
|
|
|
|
(defun org-columns--age-to-minutes (s)
|
|
|
|
|
"Turn age string S into a number of minutes.
|
2016-02-20 21:42:51 +00:00
|
|
|
|
An age is either computed from a given time-stamp, or indicated
|
2017-02-08 21:24:32 +00:00
|
|
|
|
as a canonical duration, i.e., using units defined in
|
|
|
|
|
`org-duration-canonical-units'."
|
2016-02-20 21:42:51 +00:00
|
|
|
|
(cond
|
|
|
|
|
((string-match-p org-ts-regexp s)
|
2017-02-08 21:24:32 +00:00
|
|
|
|
(/ (- org-columns--time
|
2019-02-11 04:25:22 +00:00
|
|
|
|
(float-time (org-time-string-to-time s)))
|
2017-02-08 21:24:32 +00:00
|
|
|
|
60))
|
|
|
|
|
((org-duration-p s) (org-duration-to-minutes s t)) ;skip user units
|
2016-02-20 21:42:51 +00:00
|
|
|
|
(t (user-error "Invalid age: %S" s))))
|
|
|
|
|
|
2017-02-08 21:24:32 +00:00
|
|
|
|
(defun org-columns--format-age (minutes)
|
|
|
|
|
"Format MINUTES float as an age string."
|
|
|
|
|
(org-duration-from-minutes minutes
|
|
|
|
|
'(("d" . nil) ("h" . nil) ("min" . nil))
|
|
|
|
|
t)) ;ignore user's custom units
|
|
|
|
|
|
2016-02-20 21:42:51 +00:00
|
|
|
|
(defun org-columns--summary-apply-times (fun times)
|
|
|
|
|
"Apply FUN to time values TIMES.
|
2017-02-08 21:24:32 +00:00
|
|
|
|
Return the result as a duration."
|
|
|
|
|
(org-duration-from-minutes
|
2018-06-19 14:29:30 +00:00
|
|
|
|
(apply fun (mapcar #'org-duration-to-minutes times))
|
2017-02-08 21:24:32 +00:00
|
|
|
|
(org-duration-h:mm-only-p times)))
|
2016-02-20 21:42:51 +00:00
|
|
|
|
|
2016-02-22 14:00:31 +00:00
|
|
|
|
(defun org-columns--compute-spec (spec &optional update)
|
|
|
|
|
"Update tree according to SPEC.
|
|
|
|
|
SPEC is a column format specification. When optional argument
|
|
|
|
|
UPDATE is non-nil, summarized values can replace existing ones in
|
|
|
|
|
properties drawers."
|
2016-06-23 12:18:38 +00:00
|
|
|
|
(let* ((lmax (if (bound-and-true-p org-inlinetask-min-level)
|
2016-02-18 12:56:27 +00:00
|
|
|
|
org-inlinetask-min-level
|
|
|
|
|
29)) ;Hard-code deepest level.
|
|
|
|
|
(lvals (make-vector (1+ lmax) nil))
|
2008-04-09 13:42:36 +00:00
|
|
|
|
(level 0)
|
2016-02-18 12:56:27 +00:00
|
|
|
|
(inminlevel lmax)
|
2016-02-22 14:00:31 +00:00
|
|
|
|
(last-level lmax)
|
|
|
|
|
(property (car spec))
|
|
|
|
|
(printf (nth 4 spec))
|
2021-04-09 21:41:32 +00:00
|
|
|
|
;; Special properties cannot be collected nor summarized, as
|
|
|
|
|
;; they have their own way to be computed. Therefore, ignore
|
|
|
|
|
;; any operator attached to them.
|
|
|
|
|
(operator (and (not (member property org-special-properties))
|
|
|
|
|
(nth 3 spec)))
|
2017-09-08 19:26:56 +00:00
|
|
|
|
(collect (and operator (org-columns--collect operator)))
|
2021-04-09 21:41:32 +00:00
|
|
|
|
(summarize (and operator (org-columns--summarize operator))))
|
2016-02-18 10:33:33 +00:00
|
|
|
|
(org-with-wide-buffer
|
|
|
|
|
;; Find the region to compute.
|
|
|
|
|
(goto-char org-columns-top-level-marker)
|
|
|
|
|
(goto-char (condition-case nil (org-end-of-subtree t) (error (point-max))))
|
|
|
|
|
;; Walk the tree from the back and do the computations.
|
|
|
|
|
(while (re-search-backward
|
|
|
|
|
org-outline-regexp-bol org-columns-top-level-marker t)
|
|
|
|
|
(unless (or (= level 0) (eq level inminlevel))
|
|
|
|
|
(setq last-level level))
|
|
|
|
|
(setq level (org-reduced-level (org-outline-level)))
|
|
|
|
|
(let* ((pos (match-beginning 0))
|
2017-09-08 19:26:56 +00:00
|
|
|
|
(value (if collect (funcall collect property)
|
|
|
|
|
(org-entry-get (point) property)))
|
2016-02-18 10:33:33 +00:00
|
|
|
|
(value-set (org-string-nw-p value)))
|
|
|
|
|
(cond
|
|
|
|
|
((< level last-level)
|
|
|
|
|
;; Collect values from lower levels and inline tasks here
|
2016-02-22 14:00:31 +00:00
|
|
|
|
;; and summarize them using SUMMARIZE. Store them in text
|
|
|
|
|
;; property `org-summaries', in alist whose key is SPEC.
|
2016-02-18 10:33:33 +00:00
|
|
|
|
(let* ((summary
|
2016-02-22 14:00:31 +00:00
|
|
|
|
(and summarize
|
|
|
|
|
(let ((values (append (and (/= last-level inminlevel)
|
|
|
|
|
(aref lvals last-level))
|
|
|
|
|
(aref lvals inminlevel))))
|
|
|
|
|
(and values (funcall summarize values printf))))))
|
|
|
|
|
;; Leaf values are not summaries: do not mark them.
|
|
|
|
|
(when summary
|
|
|
|
|
(let* ((summaries-alist (get-text-property pos 'org-summaries))
|
|
|
|
|
(old (assoc spec summaries-alist)))
|
|
|
|
|
(if old (setcdr old summary)
|
|
|
|
|
(push (cons spec summary) summaries-alist)
|
2018-04-29 10:02:01 +00:00
|
|
|
|
(with-silent-modifications
|
|
|
|
|
(add-text-properties
|
|
|
|
|
pos (1+ pos) (list 'org-summaries summaries-alist)))))
|
2016-02-22 14:00:31 +00:00
|
|
|
|
;; When PROPERTY exists in current node, even if empty,
|
|
|
|
|
;; but its value doesn't match the one computed, use
|
|
|
|
|
;; the latter instead.
|
2017-05-22 12:17:01 +00:00
|
|
|
|
;;
|
|
|
|
|
;; Ignore leading or trailing white spaces that might
|
|
|
|
|
;; have been introduced in summary, since those are not
|
|
|
|
|
;; significant in properties value.
|
|
|
|
|
(let ((new-value (org-trim summary)))
|
|
|
|
|
(when (and update value (not (equal value new-value)))
|
|
|
|
|
(org-entry-put (point) property new-value))))
|
2016-02-18 10:33:33 +00:00
|
|
|
|
;; Add current to current level accumulator.
|
|
|
|
|
(when (or summary value-set)
|
2016-02-20 21:42:51 +00:00
|
|
|
|
(push (or summary value) (aref lvals level)))
|
2016-02-18 10:33:33 +00:00
|
|
|
|
;; Clear accumulators for deeper levels.
|
2016-02-22 14:00:31 +00:00
|
|
|
|
(cl-loop for l from (1+ level) to lmax do (aset lvals l nil))))
|
2016-02-20 21:42:51 +00:00
|
|
|
|
(value-set (push value (aref lvals level)))
|
2016-02-18 10:33:33 +00:00
|
|
|
|
(t nil)))))))
|
2008-04-09 13:42:36 +00:00
|
|
|
|
|
2016-02-22 14:00:31 +00:00
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun org-columns-compute (property)
|
|
|
|
|
"Summarize the values of PROPERTY hierarchically.
|
|
|
|
|
Also update existing values for PROPERTY according to the first
|
|
|
|
|
column specification."
|
|
|
|
|
(interactive)
|
|
|
|
|
(let ((main-flag t)
|
|
|
|
|
(upcase-prop (upcase property)))
|
|
|
|
|
(dolist (spec org-columns-current-fmt-compiled)
|
|
|
|
|
(pcase spec
|
|
|
|
|
(`(,(pred (equal upcase-prop)) . ,_)
|
|
|
|
|
(org-columns--compute-spec spec main-flag)
|
|
|
|
|
;; Only the first summary can update the property value.
|
|
|
|
|
(when main-flag (setq main-flag nil)))))))
|
|
|
|
|
|
2016-02-20 14:36:23 +00:00
|
|
|
|
(defun org-columns-compute-all ()
|
|
|
|
|
"Compute all columns that have operators defined."
|
2018-04-29 10:02:01 +00:00
|
|
|
|
(with-silent-modifications
|
|
|
|
|
(remove-text-properties (point-min) (point-max) '(org-summaries t)))
|
2019-02-13 00:46:03 +00:00
|
|
|
|
(let ((org-columns--time (float-time))
|
2016-02-22 14:00:31 +00:00
|
|
|
|
seen)
|
2016-02-20 14:36:23 +00:00
|
|
|
|
(dolist (spec org-columns-current-fmt-compiled)
|
2016-02-22 14:00:31 +00:00
|
|
|
|
(let ((property (car spec)))
|
|
|
|
|
;; Property value is updated only the first time a given
|
|
|
|
|
;; property is encountered.
|
|
|
|
|
(org-columns--compute-spec spec (not (member property seen)))
|
|
|
|
|
(push property seen)))))
|
2016-02-20 14:36:23 +00:00
|
|
|
|
|
2016-02-20 21:42:51 +00:00
|
|
|
|
(defun org-columns--summary-sum (values printf)
|
|
|
|
|
"Compute the sum of VALUES.
|
|
|
|
|
When PRINTF is non-nil, use it to format the result."
|
|
|
|
|
(format (or printf "%s") (apply #'+ (mapcar #'string-to-number values))))
|
|
|
|
|
|
|
|
|
|
(defun org-columns--summary-currencies (values _)
|
|
|
|
|
"Compute the sum of VALUES, with two decimals."
|
|
|
|
|
(format "%.2f" (apply #'+ (mapcar #'string-to-number values))))
|
|
|
|
|
|
|
|
|
|
(defun org-columns--summary-checkbox (check-boxes _)
|
|
|
|
|
"Summarize CHECK-BOXES with a check-box."
|
|
|
|
|
(let ((done (cl-count "[X]" check-boxes :test #'equal))
|
|
|
|
|
(all (length check-boxes)))
|
|
|
|
|
(cond ((= done all) "[X]")
|
|
|
|
|
((> done 0) "[-]")
|
|
|
|
|
(t "[ ]"))))
|
|
|
|
|
|
|
|
|
|
(defun org-columns--summary-checkbox-count (check-boxes _)
|
|
|
|
|
"Summarize CHECK-BOXES with a check-box cookie."
|
|
|
|
|
(format "[%d/%d]"
|
2017-05-21 09:08:11 +00:00
|
|
|
|
(cl-count-if (lambda (b) (or (equal b "[X]")
|
2021-09-29 07:22:47 +00:00
|
|
|
|
(string-match-p "\\[\\([1-9]\\)/\\1\\]" b)))
|
2017-05-21 09:08:11 +00:00
|
|
|
|
check-boxes)
|
2016-02-20 21:42:51 +00:00
|
|
|
|
(length check-boxes)))
|
|
|
|
|
|
|
|
|
|
(defun org-columns--summary-checkbox-percent (check-boxes _)
|
|
|
|
|
"Summarize CHECK-BOXES with a check-box percent."
|
|
|
|
|
(format "[%d%%]"
|
2017-05-21 09:08:11 +00:00
|
|
|
|
(round (* 100.0 (cl-count-if (lambda (b) (member b '("[X]" "[100%]")))
|
|
|
|
|
check-boxes))
|
|
|
|
|
(length check-boxes))))
|
2016-02-20 21:42:51 +00:00
|
|
|
|
|
|
|
|
|
(defun org-columns--summary-min (values printf)
|
|
|
|
|
"Compute the minimum of VALUES.
|
|
|
|
|
When PRINTF is non-nil, use it to format the result."
|
|
|
|
|
(format (or printf "%s")
|
|
|
|
|
(apply #'min (mapcar #'string-to-number values))))
|
|
|
|
|
|
|
|
|
|
(defun org-columns--summary-max (values printf)
|
|
|
|
|
"Compute the maximum of VALUES.
|
|
|
|
|
When PRINTF is non-nil, use it to format the result."
|
|
|
|
|
(format (or printf "%s")
|
|
|
|
|
(apply #'max (mapcar #'string-to-number values))))
|
|
|
|
|
|
|
|
|
|
(defun org-columns--summary-mean (values printf)
|
|
|
|
|
"Compute the mean of VALUES.
|
|
|
|
|
When PRINTF is non-nil, use it to format the result."
|
|
|
|
|
(format (or printf "%s")
|
|
|
|
|
(/ (apply #'+ (mapcar #'string-to-number values))
|
|
|
|
|
(float (length values)))))
|
|
|
|
|
|
|
|
|
|
(defun org-columns--summary-sum-times (times _)
|
|
|
|
|
"Sum TIMES."
|
|
|
|
|
(org-columns--summary-apply-times #'+ times))
|
|
|
|
|
|
|
|
|
|
(defun org-columns--summary-min-time (times _)
|
|
|
|
|
"Compute the minimum time among TIMES."
|
|
|
|
|
(org-columns--summary-apply-times #'min times))
|
|
|
|
|
|
|
|
|
|
(defun org-columns--summary-max-time (times _)
|
|
|
|
|
"Compute the maximum time among TIMES."
|
|
|
|
|
(org-columns--summary-apply-times #'max times))
|
|
|
|
|
|
|
|
|
|
(defun org-columns--summary-mean-time (times _)
|
|
|
|
|
"Compute the mean time among TIMES."
|
|
|
|
|
(org-columns--summary-apply-times
|
|
|
|
|
(lambda (&rest values) (/ (apply #'+ values) (float (length values))))
|
|
|
|
|
times))
|
|
|
|
|
|
|
|
|
|
(defun org-columns--summary-min-age (ages _)
|
2018-12-18 08:54:24 +00:00
|
|
|
|
"Compute the minimum age among AGES."
|
2017-02-08 21:24:32 +00:00
|
|
|
|
(org-columns--format-age
|
|
|
|
|
(apply #'min (mapcar #'org-columns--age-to-minutes ages))))
|
2016-02-20 21:42:51 +00:00
|
|
|
|
|
|
|
|
|
(defun org-columns--summary-max-age (ages _)
|
2018-12-18 08:54:24 +00:00
|
|
|
|
"Compute the maximum age among AGES."
|
2017-02-08 21:24:32 +00:00
|
|
|
|
(org-columns--format-age
|
|
|
|
|
(apply #'max (mapcar #'org-columns--age-to-minutes ages))))
|
2016-02-20 21:42:51 +00:00
|
|
|
|
|
|
|
|
|
(defun org-columns--summary-mean-age (ages _)
|
2018-12-18 08:54:24 +00:00
|
|
|
|
"Compute the mean age among AGES."
|
2017-02-08 21:24:32 +00:00
|
|
|
|
(org-columns--format-age
|
|
|
|
|
(/ (apply #'+ (mapcar #'org-columns--age-to-minutes ages))
|
2016-02-20 21:42:51 +00:00
|
|
|
|
(float (length ages)))))
|
|
|
|
|
|
2017-05-20 22:06:31 +00:00
|
|
|
|
(defun org-columns--summary-estimate (estimates _)
|
2016-02-20 14:36:23 +00:00
|
|
|
|
"Combine a list of estimates, using mean and variance.
|
|
|
|
|
The mean and variance of the result will be the sum of the means
|
|
|
|
|
and variances (respectively) of the individual estimates."
|
|
|
|
|
(let ((mean 0)
|
|
|
|
|
(var 0))
|
|
|
|
|
(dolist (e estimates)
|
2016-02-20 21:42:51 +00:00
|
|
|
|
(pcase (mapcar #'string-to-number (split-string e "-"))
|
2016-02-20 14:36:23 +00:00
|
|
|
|
(`(,low ,high)
|
|
|
|
|
(let ((m (/ (+ low high) 2.0)))
|
|
|
|
|
(cl-incf mean m)
|
|
|
|
|
(cl-incf var (- (/ (+ (* low low) (* high high)) 2.0) (* m m)))))
|
2016-02-20 21:42:51 +00:00
|
|
|
|
(`(,value) (cl-incf mean value))))
|
2016-02-20 14:36:23 +00:00
|
|
|
|
(let ((sd (sqrt var)))
|
2016-02-20 21:42:51 +00:00
|
|
|
|
(format "%s-%s"
|
2017-05-20 22:06:31 +00:00
|
|
|
|
(format "%.0f" (- mean sd))
|
|
|
|
|
(format "%.0f" (+ mean sd))))))
|
2008-04-09 13:42:36 +00:00
|
|
|
|
|
|
|
|
|
|
2016-02-14 13:06:32 +00:00
|
|
|
|
|
2008-04-09 13:42:36 +00:00
|
|
|
|
;;; Dynamic block for Column view
|
|
|
|
|
|
2018-07-04 12:27:24 +00:00
|
|
|
|
(defun org-columns--capture-view (maxlevel match skip-empty exclude-tags format local)
|
2016-02-14 13:06:32 +00:00
|
|
|
|
"Get the column view of the current buffer.
|
|
|
|
|
|
|
|
|
|
MAXLEVEL sets the level limit. SKIP-EMPTY tells whether to skip
|
2008-04-09 13:42:36 +00:00
|
|
|
|
empty rows, an empty row being one where all the column view
|
2018-07-04 12:27:24 +00:00
|
|
|
|
specifiers but ITEM are empty. EXCLUDE-TAGS is a list of tags
|
|
|
|
|
that will be excluded from the resulting view. FORMAT is a
|
|
|
|
|
format string for columns, or nil. When LOCAL is non-nil, only
|
|
|
|
|
capture headings in current subtree.
|
2016-02-14 13:06:32 +00:00
|
|
|
|
|
|
|
|
|
This function returns a list containing the title row and all
|
|
|
|
|
other rows. Each row is a list of fields, as strings, or
|
|
|
|
|
`hline'."
|
|
|
|
|
(org-columns (not local) format)
|
|
|
|
|
(goto-char org-columns-top-level-marker)
|
|
|
|
|
(let ((columns (length org-columns-current-fmt-compiled))
|
2016-02-22 09:48:00 +00:00
|
|
|
|
(has-item (assoc "ITEM" org-columns-current-fmt-compiled))
|
2016-02-14 13:06:32 +00:00
|
|
|
|
table)
|
|
|
|
|
(org-map-entries
|
|
|
|
|
(lambda ()
|
|
|
|
|
(when (get-char-property (point) 'org-columns-key)
|
|
|
|
|
(let (row)
|
|
|
|
|
(dotimes (i columns)
|
|
|
|
|
(let* ((col (+ (line-beginning-position) i))
|
|
|
|
|
(p (get-char-property col 'org-columns-key)))
|
|
|
|
|
(push (org-quote-vert
|
|
|
|
|
(get-char-property col
|
2016-02-22 09:48:00 +00:00
|
|
|
|
(if (string= p "ITEM")
|
2016-02-14 13:06:32 +00:00
|
|
|
|
'org-columns-value
|
|
|
|
|
'org-columns-value-modified)))
|
|
|
|
|
row)))
|
2018-07-04 12:27:24 +00:00
|
|
|
|
(unless (or
|
|
|
|
|
(and skip-empty
|
|
|
|
|
(let ((r (delete-dups (remove "" row))))
|
|
|
|
|
(or (null r) (and has-item (= (length r) 1)))))
|
|
|
|
|
(and exclude-tags
|
|
|
|
|
(cl-some (lambda (tag) (member tag exclude-tags))
|
|
|
|
|
(org-get-tags))))
|
2016-02-14 13:06:32 +00:00
|
|
|
|
(push (cons (org-reduced-level (org-current-level)) (nreverse row))
|
|
|
|
|
table)))))
|
2021-07-12 03:51:44 +00:00
|
|
|
|
(if match
|
|
|
|
|
(concat match (and maxlevel (format "+LEVEL<=%d" maxlevel)))
|
|
|
|
|
(and maxlevel (format "LEVEL<=%d" maxlevel)))
|
2016-02-14 13:06:32 +00:00
|
|
|
|
(and local 'tree)
|
|
|
|
|
'archive 'comment)
|
|
|
|
|
(org-columns-quit)
|
|
|
|
|
;; Add column titles and a horizontal rule in front of the table.
|
|
|
|
|
(cons (mapcar #'cadr org-columns-current-fmt-compiled)
|
|
|
|
|
(cons 'hline (nreverse table)))))
|
|
|
|
|
|
|
|
|
|
(defun org-columns--clean-item (item)
|
|
|
|
|
"Remove sensitive contents from string ITEM.
|
|
|
|
|
This includes objects that may not be duplicated within
|
|
|
|
|
a document, e.g., a target, or those forbidden in tables, e.g.,
|
|
|
|
|
an inline src-block."
|
|
|
|
|
(let ((data (org-element-parse-secondary-string
|
|
|
|
|
item (org-element-restriction 'headline))))
|
|
|
|
|
(org-element-map data
|
|
|
|
|
'(footnote-reference inline-babel-call inline-src-block target
|
|
|
|
|
radio-target statistics-cookie)
|
|
|
|
|
#'org-element-extract-element)
|
|
|
|
|
(org-no-properties (org-element-interpret-data data))))
|
2008-04-09 13:42:36 +00:00
|
|
|
|
|
Update autoloads.
* org.el: Don't dynamically autoload already autoloaded
functions.
(org-clock-update-time-maybe): Move to org-clock.el.
* org-exp.el (org-insert-export-options-template): Remove
autoload cookie.
* org-clock.el (org-resolve-clocks, org-clock-in)
(org-clock-out, org-clock-cancel, org-clock-goto)
(org-clock-sum, org-clock-display, org-clock-report)
(org-dblock-write:clocktable): Add autoload cookie.
(org-clock-update-time-maybe): Moved from org.el.
* org-beamer.el (org-beamer-sectioning, org-beamer-mode): Ditto.
* org-ascii.el (org-export-ascii-preprocess): Ditto.
* org-archive.el (org-archive-subtree)
(org-archive-to-archive-sibling, org-toggle-archive-tag): Add
autoload cookie.
* org-colview.el (org-columns, org-dblock-write:columnview)
(org-insert-columns-dblock, org-agenda-columns): Ditto.
* org-table.el (org-table-create-with-table.el)
(org-table-create-or-convert-from-region, org-table-create)
(org-table-convert-region, org-table-import)
(org-table-export, org-table-align)
(org-table-justify-field-maybe, org-table-next-field)
(org-table-previous-field, org-table-next-row)
(org-table-copy-down, org-table-field-info)
(org-table-current-dline, org-table-goto-column)
(org-table-insert-column, org-table-delete-column)
(org-table-move-column-right, org-table-move-column-left)
(org-table-move-column, org-table-move-row-down)
(org-table-move-row-up, org-table-move-row)
(org-table-insert-row, org-table-insert-hline)
(org-table-hline-and-move, org-table-kill-row)
(org-table-sort-lines, org-table-cut-region)
(org-table-copy-region, org-table-paste-rectangle)
(org-table-convert, org-table-wrap-region)
(org-table-edit-field, org-table-sum)
(org-table-get-stored-formulas)
(org-table-maybe-eval-formula)
(org-table-rotate-recalc-marks)
(org-table-maybe-recalculate-line, org-table-eval-formula)
(org-table-recalculate, org-table-iterate)
(org-table-edit-formulas)
(org-table-toggle-coordinate-overlays)
(org-table-toggle-formula-debugger, orgtbl-to-generic)
(orgtbl-to-tsv, orgtbl-to-csv, orgtbl-to-latex)
(orgtbl-to-html, orgtbl-to-texinfo, orgtbl-to-orgtbl): Ditto.
2012-10-02 08:52:17 +00:00
|
|
|
|
;;;###autoload
|
2008-04-09 13:42:36 +00:00
|
|
|
|
(defun org-dblock-write:columnview (params)
|
|
|
|
|
"Write the column view table.
|
2018-12-18 10:08:48 +00:00
|
|
|
|
|
2008-04-09 13:42:36 +00:00
|
|
|
|
PARAMS is a property list of parameters:
|
|
|
|
|
|
2018-12-18 10:08:48 +00:00
|
|
|
|
`:id' (mandatory)
|
|
|
|
|
|
|
|
|
|
The ID property of the entry where the columns view should be
|
|
|
|
|
built. When the symbol `local', call locally. When `global'
|
|
|
|
|
call column view with the cursor at the beginning of the
|
|
|
|
|
buffer (usually this means that the whole buffer switches to
|
|
|
|
|
column view). When \"file:path/to/file.org\", invoke column
|
|
|
|
|
view at the start of that file. Otherwise, the ID is located
|
|
|
|
|
using `org-id-find'.
|
|
|
|
|
|
|
|
|
|
`:exclude-tags'
|
|
|
|
|
|
|
|
|
|
List of tags to exclude from column view table.
|
|
|
|
|
|
|
|
|
|
`:format'
|
|
|
|
|
|
|
|
|
|
When non-nil, specify the column view format to use.
|
|
|
|
|
|
|
|
|
|
`:hlines'
|
|
|
|
|
|
|
|
|
|
When non-nil, insert a hline before each item. When
|
|
|
|
|
a number, insert a hline before each level inferior or equal
|
|
|
|
|
to that number.
|
|
|
|
|
|
|
|
|
|
`:indent'
|
|
|
|
|
|
|
|
|
|
When non-nil, indent each ITEM field according to its level.
|
|
|
|
|
|
|
|
|
|
`:match'
|
|
|
|
|
|
|
|
|
|
When set to a string, use this as a tags/property match filter.
|
|
|
|
|
|
|
|
|
|
`:maxlevel'
|
|
|
|
|
|
|
|
|
|
When set to a number, don't capture headlines below this level.
|
|
|
|
|
|
|
|
|
|
`:skip-empty-rows'
|
|
|
|
|
|
|
|
|
|
When non-nil, skip rows where all specifiers other than ITEM
|
|
|
|
|
are empty.
|
|
|
|
|
|
|
|
|
|
`:vlines'
|
|
|
|
|
|
|
|
|
|
When non-nil, make each column a column group to enforce
|
|
|
|
|
vertical lines."
|
2016-02-14 13:06:32 +00:00
|
|
|
|
(let ((table
|
|
|
|
|
(let ((id (plist-get params :id))
|
|
|
|
|
view-file view-pos)
|
|
|
|
|
(pcase id
|
|
|
|
|
(`global nil)
|
|
|
|
|
((or `local `nil) (setq view-pos (point)))
|
|
|
|
|
((and (let id-string (format "%s" id))
|
|
|
|
|
(guard (string-match "^file:\\(.*\\)" id-string)))
|
|
|
|
|
(setq view-file (match-string-no-properties 1 id-string))
|
|
|
|
|
(unless (file-exists-p view-file)
|
|
|
|
|
(user-error "No such file: %S" id-string)))
|
2016-02-27 08:21:11 +00:00
|
|
|
|
((and (let idpos (org-find-entry-with-id id)) (guard idpos))
|
2016-02-14 13:06:32 +00:00
|
|
|
|
(setq view-pos idpos))
|
|
|
|
|
((let `(,filename . ,position) (org-id-find id))
|
|
|
|
|
(setq view-file filename)
|
|
|
|
|
(setq view-pos position))
|
|
|
|
|
(_ (user-error "Cannot find entry with :ID: %s" id)))
|
|
|
|
|
(with-current-buffer (if view-file (get-file-buffer view-file)
|
|
|
|
|
(current-buffer))
|
|
|
|
|
(org-with-wide-buffer
|
|
|
|
|
(when view-pos (goto-char view-pos))
|
|
|
|
|
(org-columns--capture-view (plist-get params :maxlevel)
|
2017-12-29 17:18:14 +00:00
|
|
|
|
(plist-get params :match)
|
2016-02-14 13:06:32 +00:00
|
|
|
|
(plist-get params :skip-empty-rows)
|
2018-07-04 12:27:24 +00:00
|
|
|
|
(plist-get params :exclude-tags)
|
2016-02-14 13:06:32 +00:00
|
|
|
|
(plist-get params :format)
|
|
|
|
|
view-pos))))))
|
|
|
|
|
(when table
|
|
|
|
|
;; Prune level information from the table. Also normalize
|
|
|
|
|
;; headings: remove stars, add indentation entities, if
|
|
|
|
|
;; required, and possibly precede some of them with a horizontal
|
|
|
|
|
;; rule.
|
2016-02-11 23:38:52 +00:00
|
|
|
|
(let ((item-index
|
2016-02-22 09:48:00 +00:00
|
|
|
|
(let ((p (assoc "ITEM" org-columns-current-fmt-compiled)))
|
2016-02-11 23:38:52 +00:00
|
|
|
|
(and p (cl-position p
|
|
|
|
|
org-columns-current-fmt-compiled
|
|
|
|
|
:test #'equal))))
|
|
|
|
|
(hlines (plist-get params :hlines))
|
2016-02-14 13:06:32 +00:00
|
|
|
|
(indent (plist-get params :indent))
|
|
|
|
|
new-table)
|
|
|
|
|
;; Copy header and first rule.
|
|
|
|
|
(push (pop table) new-table)
|
|
|
|
|
(push (pop table) new-table)
|
|
|
|
|
(dolist (row table (setq table (nreverse new-table)))
|
|
|
|
|
(let ((level (car row)))
|
|
|
|
|
(when (and (not (eq (car new-table) 'hline))
|
|
|
|
|
(or (eq hlines t)
|
|
|
|
|
(and (numberp hlines) (<= level hlines))))
|
|
|
|
|
(push 'hline new-table))
|
|
|
|
|
(when item-index
|
|
|
|
|
(let ((item (org-columns--clean-item (nth item-index (cdr row)))))
|
|
|
|
|
(setf (nth item-index (cdr row))
|
|
|
|
|
(if (and indent (> level 1))
|
|
|
|
|
(concat "\\_" (make-string (* 2 (1- level)) ?\s) item)
|
|
|
|
|
item))))
|
|
|
|
|
(push (cdr row) new-table))))
|
|
|
|
|
(when (plist-get params :vlines)
|
|
|
|
|
(setq table
|
|
|
|
|
(let ((size (length org-columns-current-fmt-compiled)))
|
|
|
|
|
(append (mapcar (lambda (x) (if (eq 'hline x) x (cons "" x)))
|
|
|
|
|
table)
|
|
|
|
|
(list (cons "/" (make-list size "<>")))))))
|
|
|
|
|
(let ((content-lines (org-split-string (plist-get params :content) "\n"))
|
|
|
|
|
recalc)
|
|
|
|
|
;; Insert affiliated keywords before the table.
|
|
|
|
|
(when content-lines
|
|
|
|
|
(while (string-match-p "\\`[ \t]*#\\+" (car content-lines))
|
|
|
|
|
(insert (pop content-lines) "\n")))
|
|
|
|
|
(save-excursion
|
|
|
|
|
;; Insert table at point.
|
|
|
|
|
(insert
|
|
|
|
|
(mapconcat (lambda (row)
|
|
|
|
|
(if (eq row 'hline) "|-|"
|
|
|
|
|
(format "|%s|" (mapconcat #'identity row "|"))))
|
|
|
|
|
table
|
|
|
|
|
"\n"))
|
|
|
|
|
;; Insert TBLFM lines following table.
|
|
|
|
|
(let ((case-fold-search t))
|
|
|
|
|
(dolist (line content-lines)
|
|
|
|
|
(when (string-match-p "\\`[ \t]*#\\+TBLFM:" line)
|
|
|
|
|
(insert "\n" line)
|
|
|
|
|
(unless recalc (setq recalc t))))))
|
|
|
|
|
(when recalc (org-table-recalculate 'all t))
|
2008-09-08 07:43:41 +00:00
|
|
|
|
(org-table-align)))))
|
2008-04-09 13:42:36 +00:00
|
|
|
|
|
Update autoloads.
* org.el: Don't dynamically autoload already autoloaded
functions.
(org-clock-update-time-maybe): Move to org-clock.el.
* org-exp.el (org-insert-export-options-template): Remove
autoload cookie.
* org-clock.el (org-resolve-clocks, org-clock-in)
(org-clock-out, org-clock-cancel, org-clock-goto)
(org-clock-sum, org-clock-display, org-clock-report)
(org-dblock-write:clocktable): Add autoload cookie.
(org-clock-update-time-maybe): Moved from org.el.
* org-beamer.el (org-beamer-sectioning, org-beamer-mode): Ditto.
* org-ascii.el (org-export-ascii-preprocess): Ditto.
* org-archive.el (org-archive-subtree)
(org-archive-to-archive-sibling, org-toggle-archive-tag): Add
autoload cookie.
* org-colview.el (org-columns, org-dblock-write:columnview)
(org-insert-columns-dblock, org-agenda-columns): Ditto.
* org-table.el (org-table-create-with-table.el)
(org-table-create-or-convert-from-region, org-table-create)
(org-table-convert-region, org-table-import)
(org-table-export, org-table-align)
(org-table-justify-field-maybe, org-table-next-field)
(org-table-previous-field, org-table-next-row)
(org-table-copy-down, org-table-field-info)
(org-table-current-dline, org-table-goto-column)
(org-table-insert-column, org-table-delete-column)
(org-table-move-column-right, org-table-move-column-left)
(org-table-move-column, org-table-move-row-down)
(org-table-move-row-up, org-table-move-row)
(org-table-insert-row, org-table-insert-hline)
(org-table-hline-and-move, org-table-kill-row)
(org-table-sort-lines, org-table-cut-region)
(org-table-copy-region, org-table-paste-rectangle)
(org-table-convert, org-table-wrap-region)
(org-table-edit-field, org-table-sum)
(org-table-get-stored-formulas)
(org-table-maybe-eval-formula)
(org-table-rotate-recalc-marks)
(org-table-maybe-recalculate-line, org-table-eval-formula)
(org-table-recalculate, org-table-iterate)
(org-table-edit-formulas)
(org-table-toggle-coordinate-overlays)
(org-table-toggle-formula-debugger, orgtbl-to-generic)
(orgtbl-to-tsv, orgtbl-to-csv, orgtbl-to-latex)
(orgtbl-to-html, orgtbl-to-texinfo, orgtbl-to-orgtbl): Ditto.
2012-10-02 08:52:17 +00:00
|
|
|
|
;;;###autoload
|
2016-02-17 14:54:07 +00:00
|
|
|
|
(defun org-columns-insert-dblock ()
|
2008-04-09 13:42:36 +00:00
|
|
|
|
"Create a dynamic block capturing a column view table."
|
|
|
|
|
(interactive)
|
2016-02-17 14:54:07 +00:00
|
|
|
|
(let ((id (completing-read
|
2008-04-09 13:42:36 +00:00
|
|
|
|
"Capture columns (local, global, entry with :ID: property) [local]: "
|
|
|
|
|
(append '(("global") ("local"))
|
2015-12-22 13:49:23 +00:00
|
|
|
|
(mapcar #'list (org-property-values "ID"))))))
|
2016-02-17 14:54:07 +00:00
|
|
|
|
(org-create-dblock
|
|
|
|
|
(list :name "columnview"
|
|
|
|
|
:hlines 1
|
|
|
|
|
:id (cond ((string= id "global") 'global)
|
|
|
|
|
((member id '("" "local")) 'local)
|
|
|
|
|
(id)))))
|
|
|
|
|
(org-update-dblock))
|
|
|
|
|
|
2020-05-05 03:13:25 +00:00
|
|
|
|
;;;###autoload
|
|
|
|
|
(eval-after-load 'org
|
|
|
|
|
'(progn
|
|
|
|
|
(org-dynamic-block-define "columnview" #'org-columns-insert-dblock)))
|
2016-02-14 13:06:32 +00:00
|
|
|
|
|
|
|
|
|
|
2008-04-15 12:01:59 +00:00
|
|
|
|
;;; Column view in the agenda
|
|
|
|
|
|
Update autoloads.
* org.el: Don't dynamically autoload already autoloaded
functions.
(org-clock-update-time-maybe): Move to org-clock.el.
* org-exp.el (org-insert-export-options-template): Remove
autoload cookie.
* org-clock.el (org-resolve-clocks, org-clock-in)
(org-clock-out, org-clock-cancel, org-clock-goto)
(org-clock-sum, org-clock-display, org-clock-report)
(org-dblock-write:clocktable): Add autoload cookie.
(org-clock-update-time-maybe): Moved from org.el.
* org-beamer.el (org-beamer-sectioning, org-beamer-mode): Ditto.
* org-ascii.el (org-export-ascii-preprocess): Ditto.
* org-archive.el (org-archive-subtree)
(org-archive-to-archive-sibling, org-toggle-archive-tag): Add
autoload cookie.
* org-colview.el (org-columns, org-dblock-write:columnview)
(org-insert-columns-dblock, org-agenda-columns): Ditto.
* org-table.el (org-table-create-with-table.el)
(org-table-create-or-convert-from-region, org-table-create)
(org-table-convert-region, org-table-import)
(org-table-export, org-table-align)
(org-table-justify-field-maybe, org-table-next-field)
(org-table-previous-field, org-table-next-row)
(org-table-copy-down, org-table-field-info)
(org-table-current-dline, org-table-goto-column)
(org-table-insert-column, org-table-delete-column)
(org-table-move-column-right, org-table-move-column-left)
(org-table-move-column, org-table-move-row-down)
(org-table-move-row-up, org-table-move-row)
(org-table-insert-row, org-table-insert-hline)
(org-table-hline-and-move, org-table-kill-row)
(org-table-sort-lines, org-table-cut-region)
(org-table-copy-region, org-table-paste-rectangle)
(org-table-convert, org-table-wrap-region)
(org-table-edit-field, org-table-sum)
(org-table-get-stored-formulas)
(org-table-maybe-eval-formula)
(org-table-rotate-recalc-marks)
(org-table-maybe-recalculate-line, org-table-eval-formula)
(org-table-recalculate, org-table-iterate)
(org-table-edit-formulas)
(org-table-toggle-coordinate-overlays)
(org-table-toggle-formula-debugger, orgtbl-to-generic)
(orgtbl-to-tsv, orgtbl-to-csv, orgtbl-to-latex)
(orgtbl-to-html, orgtbl-to-texinfo, orgtbl-to-orgtbl): Ditto.
2012-10-02 08:52:17 +00:00
|
|
|
|
;;;###autoload
|
2008-04-15 12:01:59 +00:00
|
|
|
|
(defun org-agenda-columns ()
|
2008-04-18 13:24:58 +00:00
|
|
|
|
"Turn on or update column view in the agenda."
|
2008-04-15 12:01:59 +00:00
|
|
|
|
(interactive)
|
|
|
|
|
(org-columns-remove-overlays)
|
2017-07-25 07:49:23 +00:00
|
|
|
|
(if (markerp org-columns-begin-marker)
|
|
|
|
|
(move-marker org-columns-begin-marker (point))
|
|
|
|
|
(setq org-columns-begin-marker (point-marker)))
|
2017-10-21 02:40:09 +00:00
|
|
|
|
(let* ((org-columns--time (float-time))
|
2020-10-19 05:29:05 +00:00
|
|
|
|
(org-done-keywords org-done-keywords-for-agenda)
|
2016-12-11 00:34:55 +00:00
|
|
|
|
(fmt
|
|
|
|
|
(cond
|
2019-02-17 01:21:04 +00:00
|
|
|
|
((bound-and-true-p org-overriding-columns-format))
|
|
|
|
|
((bound-and-true-p org-local-columns-format))
|
2019-08-15 07:18:10 +00:00
|
|
|
|
((bound-and-true-p org-columns-default-format-for-agenda))
|
2016-12-11 00:34:55 +00:00
|
|
|
|
((let ((m (org-get-at-bol 'org-hd-marker)))
|
|
|
|
|
(and m
|
|
|
|
|
(or (org-entry-get m "COLUMNS" t)
|
|
|
|
|
(with-current-buffer (marker-buffer m)
|
|
|
|
|
org-columns-default-format)))))
|
|
|
|
|
((and (local-variable-p 'org-columns-current-fmt)
|
|
|
|
|
org-columns-current-fmt))
|
|
|
|
|
((let ((m (next-single-property-change (point-min) 'org-hd-marker)))
|
|
|
|
|
(and m
|
|
|
|
|
(let ((m (get-text-property m 'org-hd-marker)))
|
|
|
|
|
(or (org-entry-get m "COLUMNS" t)
|
|
|
|
|
(with-current-buffer (marker-buffer m)
|
|
|
|
|
org-columns-default-format))))))
|
|
|
|
|
(t org-columns-default-format)))
|
|
|
|
|
(compiled-fmt (org-columns-compile-format fmt)))
|
|
|
|
|
(setq org-columns-current-fmt fmt)
|
2008-04-17 16:26:27 +00:00
|
|
|
|
(when org-agenda-columns-compute-summary-properties
|
|
|
|
|
(org-agenda-colview-compute org-columns-current-fmt-compiled))
|
2008-04-15 12:01:59 +00:00
|
|
|
|
(save-excursion
|
2015-06-02 19:56:50 +00:00
|
|
|
|
;; Collect properties for each headline in current view.
|
2008-04-15 12:01:59 +00:00
|
|
|
|
(goto-char (point-min))
|
2015-06-02 19:56:50 +00:00
|
|
|
|
(let (cache)
|
2016-02-14 09:17:14 +00:00
|
|
|
|
(while (not (eobp))
|
2017-04-27 22:23:49 +00:00
|
|
|
|
(let ((m (org-get-at-bol 'org-hd-marker)))
|
2016-02-14 09:17:14 +00:00
|
|
|
|
(when m
|
|
|
|
|
(push (cons (line-beginning-position)
|
2016-12-11 00:34:55 +00:00
|
|
|
|
;; `org-columns-current-fmt-compiled' is
|
|
|
|
|
;; initialized but only set locally to the
|
|
|
|
|
;; agenda buffer. Since current buffer is
|
|
|
|
|
;; changing, we need to force the original
|
|
|
|
|
;; compiled-fmt there.
|
2016-02-14 09:17:14 +00:00
|
|
|
|
(org-with-point-at m
|
2016-12-11 00:34:55 +00:00
|
|
|
|
(org-columns--collect-values compiled-fmt)))
|
2016-02-14 09:17:14 +00:00
|
|
|
|
cache)))
|
|
|
|
|
(forward-line))
|
2015-06-02 19:56:50 +00:00
|
|
|
|
(when cache
|
2016-02-22 11:19:22 +00:00
|
|
|
|
(org-columns--set-widths cache)
|
2016-02-14 09:17:14 +00:00
|
|
|
|
(org-columns--display-here-title)
|
2015-11-05 16:47:38 +00:00
|
|
|
|
(when (setq-local org-columns-flyspell-was-active
|
2016-06-23 12:18:38 +00:00
|
|
|
|
(bound-and-true-p flyspell-mode))
|
2015-06-02 19:56:50 +00:00
|
|
|
|
(flyspell-mode 0))
|
2016-02-14 09:17:14 +00:00
|
|
|
|
(dolist (entry cache)
|
|
|
|
|
(goto-char (car entry))
|
|
|
|
|
(org-columns--display-here (cdr entry)))
|
2020-01-27 22:39:25 +00:00
|
|
|
|
(setq-local org-agenda-columns-active t)
|
2015-06-02 19:56:50 +00:00
|
|
|
|
(when org-agenda-columns-show-summaries
|
|
|
|
|
(org-agenda-colview-summarize cache)))))))
|
2008-04-15 12:01:59 +00:00
|
|
|
|
|
|
|
|
|
(defun org-agenda-colview-summarize (cache)
|
|
|
|
|
"Summarize the summarizable columns in column view in the agenda.
|
|
|
|
|
This will add overlays to the date lines, to show the summary for each day."
|
2016-02-14 09:17:14 +00:00
|
|
|
|
(let ((fmt (mapcar
|
|
|
|
|
(lambda (spec)
|
|
|
|
|
(pcase spec
|
|
|
|
|
(`(,property ,title ,width . ,_)
|
2016-02-22 09:48:00 +00:00
|
|
|
|
(if (member property '("CLOCKSUM" "CLOCKSUM_T"))
|
2016-02-22 13:12:48 +00:00
|
|
|
|
(list property title width ":" nil)
|
2016-02-14 09:17:14 +00:00
|
|
|
|
spec))))
|
2017-01-17 11:00:49 +00:00
|
|
|
|
org-columns-current-fmt-compiled)))
|
2016-02-14 09:17:14 +00:00
|
|
|
|
;; Ensure there's at least one summation column.
|
2016-02-20 14:13:03 +00:00
|
|
|
|
(when (cl-some (lambda (spec) (nth 3 spec)) fmt)
|
2016-02-14 09:17:14 +00:00
|
|
|
|
(goto-char (point-max))
|
2017-01-17 10:35:05 +00:00
|
|
|
|
(catch :complete
|
|
|
|
|
(while t
|
|
|
|
|
(when (or (get-text-property (point) 'org-date-line)
|
2017-01-17 11:00:49 +00:00
|
|
|
|
(eq (get-text-property (point) 'face)
|
|
|
|
|
'org-agenda-structure))
|
2017-01-17 10:35:05 +00:00
|
|
|
|
;; OK, this is a date line that should be used.
|
2017-01-17 11:00:49 +00:00
|
|
|
|
(let (entries)
|
|
|
|
|
(let (rest)
|
|
|
|
|
(dolist (c cache)
|
|
|
|
|
(if (> (car c) (point))
|
|
|
|
|
(push c entries)
|
|
|
|
|
(push c rest)))
|
|
|
|
|
(setq cache rest))
|
|
|
|
|
;; ENTRIES contains entries below the current one.
|
|
|
|
|
;; CACHE is the rest. Compute the summaries for the
|
|
|
|
|
;; properties we want, set nil properties for the rest.
|
|
|
|
|
(when (setq entries (mapcar #'cdr entries))
|
|
|
|
|
(org-columns--display-here
|
|
|
|
|
(mapcar
|
|
|
|
|
(lambda (spec)
|
|
|
|
|
(pcase spec
|
|
|
|
|
(`("ITEM" . ,_)
|
|
|
|
|
;; Replace ITEM with current date. Preserve
|
|
|
|
|
;; properties for fontification.
|
|
|
|
|
(let ((date (buffer-substring
|
|
|
|
|
(line-beginning-position)
|
|
|
|
|
(line-end-position))))
|
|
|
|
|
(list spec date date)))
|
|
|
|
|
(`(,_ ,_ ,_ nil ,_) (list spec "" ""))
|
|
|
|
|
(`(,_ ,_ ,_ ,operator ,printf)
|
|
|
|
|
(let* ((summarize (org-columns--summarize operator))
|
|
|
|
|
(values
|
|
|
|
|
;; Use real values for summary, not
|
|
|
|
|
;; those prepared for display.
|
|
|
|
|
(delq nil
|
|
|
|
|
(mapcar
|
|
|
|
|
(lambda (e) (org-string-nw-p
|
2021-09-29 07:22:47 +00:00
|
|
|
|
(nth 1 (assoc spec e))))
|
2017-01-17 11:00:49 +00:00
|
|
|
|
entries)))
|
|
|
|
|
(final (if values
|
|
|
|
|
(funcall summarize values printf)
|
|
|
|
|
"")))
|
|
|
|
|
(unless (equal final "")
|
|
|
|
|
(put-text-property 0 (length final)
|
|
|
|
|
'face 'bold final))
|
|
|
|
|
(list spec final final)))))
|
|
|
|
|
fmt)
|
2020-01-27 22:39:25 +00:00
|
|
|
|
'dateline))))
|
2017-01-17 10:35:05 +00:00
|
|
|
|
(if (bobp) (throw :complete t) (forward-line -1)))))))
|
2008-04-15 12:01:59 +00:00
|
|
|
|
|
|
|
|
|
(defun org-agenda-colview-compute (fmt)
|
|
|
|
|
"Compute the relevant columns in the contributing source buffers."
|
2017-07-25 07:49:23 +00:00
|
|
|
|
(dolist (file org-agenda-contributing-files)
|
|
|
|
|
(let ((b (find-buffer-visiting file)))
|
|
|
|
|
(with-current-buffer (or (buffer-base-buffer b) b)
|
|
|
|
|
(org-with-wide-buffer
|
2018-04-29 10:02:01 +00:00
|
|
|
|
(with-silent-modifications
|
|
|
|
|
(remove-text-properties (point-min) (point-max) '(org-summaries t)))
|
2017-07-25 07:49:23 +00:00
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(org-columns-get-format-and-top-level)
|
|
|
|
|
(dolist (spec fmt)
|
|
|
|
|
(let ((prop (car spec)))
|
|
|
|
|
(cond
|
|
|
|
|
((equal prop "CLOCKSUM") (org-clock-sum))
|
|
|
|
|
((equal prop "CLOCKSUM_T") (org-clock-sum-today))
|
|
|
|
|
((and (nth 3 spec)
|
|
|
|
|
(let ((a (assoc prop org-columns-current-fmt-compiled)))
|
|
|
|
|
(equal (nth 3 a) (nth 3 spec))))
|
|
|
|
|
(org-columns-compute prop))))))))))
|
2008-04-15 12:01:59 +00:00
|
|
|
|
|
2009-08-28 12:50:51 +00:00
|
|
|
|
|
2008-04-09 13:42:36 +00:00
|
|
|
|
(provide 'org-colview)
|
|
|
|
|
|
2020-02-18 22:37:24 +00:00
|
|
|
|
;; Local variables:
|
|
|
|
|
;; generated-autoload-file: "org-loaddefs.el"
|
|
|
|
|
;; End:
|
|
|
|
|
|
2008-04-29 05:15:41 +00:00
|
|
|
|
;;; org-colview.el ends here
|