Emacsには何と表現してよいのかわからない最強のツール、Org-modeというも のがある。Org-modeの機能は多岐に渡る。その中の機能の一つにタスク管理が あり、それを効率的に操作するためのorg-agendaという機能がある。そして org-agendaの不足している機能を補う形でサードパーティパッケージとして org-super-agendaがある。

タスク管理のための機能はかなり充実しているが、 そもそもタスク管理というのは個人やチームのニーズによって、その要求はかなり差がある。

今回はorg-agenda(org-super-agenda)のラベルに見積り(Effortの値)を集計した合計値を表示するようにしたかった。 設定だけでは実現できなかったため、以下のようにorg-super-agendaの関数をいくつか上書きするようにした

(require 'org-super-agenda)


(defun org-super-agenda-get-effort (item)
  (if-let ((item-todo-state (get-text-property 0 'todo-state item)))
      (get-text-property 0 'effort-minutes item-todo-state)))

(defun org-super-agenda-summary-effort (items)
  (apply #'+
	  (lambda (it) it)
	  (mapcar #'org-super-agenda-get-effort items))))

(defun org-super-agenda--make-agenda-header (name &optional items)
  "Return agenda header named NAME.
If NAME is nil or `none', return empty string.  Otherwise, return
string NAME prepended with `org-super-agenda-header-separator',
which see.  NAME has the face `org-super-agenda-header' appended,
and the text properties `keymap' and `local-map' set to the value
of `org-super-agenda-header-map', which see."
  (pcase name
    ((or `nil 'none) "")
    (_ (let* ((properties (text-properties-at 0 name))
              (header (concat org-super-agenda-header-prefix name))
               (cl-etypecase org-super-agenda-header-separator
                 (character (concat (make-string (window-width) org-super-agenda-header-separator)
                 (string org-super-agenda-header-separator))))
         (set-text-properties 0 (length header) properties header)
         (add-face-text-property 0 (length header) 'org-super-agenda-header t header)
         (org-add-props header org-super-agenda-header-properties
           'keymap org-super-agenda-header-map
           ;; NOTE: According to the manual, only `keymap' should be necessary, but in my
           ;; testing, it only takes effect in Agenda buffers when `local-map' is set, so
           ;; we'll use both.
           'local-map org-super-agenda-header-map)
         ;; Don't apply faces and properties to the separator part of the string.
         (concat separator header
		 (format " (Effort => %d)"
			 (org-super-agenda-summary-effort items)))))))

(defun org-super-agenda--group-items (all-items)
  "Divide ALL-ITEMS into groups based on `org-super-agenda-groups'."
  (if (bound-and-true-p org-super-agenda-groups)
      ;; Transform groups
      (let ((org-super-agenda-groups (org-super-agenda--transform-groups org-super-agenda-groups)))
        ;; Collect and insert groups
        (cl-loop with section-name
                 for filter in org-super-agenda-groups
                 for custom-section-name = (plist-get filter :name)
                 for order = (or (plist-get filter :order) 0)  ; Lowest number first, 0 by default
                 for (auto-section-name non-matching matching) = (org-super-agenda--group-dispatch all-items filter)

                 do (when org-super-agenda-keep-order
                      (setf matching (sort matching #'org-entries-lessp)))

                 ;; Transformer
                 for transformer = (plist-get filter :transformer)
                 when transformer
                 do (setq matching (-map (pcase transformer
                                           (`(function ,transformer) transformer)
                                           ((pred symbolp) transformer)
                                           (_ `(lambda (it) ,transformer)))

                 ;; Face
                 for face = (plist-get filter :face)
                 when face
                 do (let ((append (plist-get face :append)))
                      (when append (cl-remf face :append))
                      (--each matching
                        (add-face-text-property 0 (length it) face append it)))

                 ;; Auto category/group
                 if (cl-member auto-section-name org-super-agenda-auto-selector-keywords)
                 do (setq section-name (or custom-section-name "Auto category/group"))
                 and append (cl-loop for group in matching
                                     collect (list :name (plist-get group :name)
                                                   :items (plist-get group :items)
                                                   :order order))
                 into sections
                 and do (setq all-items non-matching)

                 ;; Manual groups
                 do (setq section-name (or custom-section-name auto-section-name))
                 and collect (list :name section-name :items matching :order order) into sections
                 and do (setq all-items non-matching)

                 ;; Sort sections by :order then :name
                 finally do (setq non-matching (list :name org-super-agenda-unmatched-name
                                                     :items non-matching
                                                     :order org-super-agenda-unmatched-order))
                 finally do (setq sections (--sort (let ((o-it (plist-get it :order))
                                                         (o-other (plist-get other :order)))
                                                     (cond ((and
                                                             ;; FIXME: This is now quite ugly.  I'm not sure that all of these tests
                                                             ;; are necessary, but at the moment it works, so I'm leaving it alone.
                                                             (equal o-it o-other)
                                                             (not (equal o-it 0))
                                                             (stringp (plist-get it :name))
                                                             (stringp (plist-get other :name)))
                                                            ;; Sort by string only for items with a set order
                                                            (string< (plist-get it :name)
                                                                     (plist-get other :name)))
                                                           ((and (numberp o-it)
                                                                 (numberp o-other))
                                                            (< o-it o-other))
                                                           (t nil)))
                                                   (push non-matching sections)))
                 ;; Insert sections
                 finally return (cl-loop for (_ name _ items) in sections
                                         when items
                                         collect (org-super-agenda--make-agenda-header name items)
                                         and append items)))
    ;; No super-filters; return list unmodified