1

I wonder if there is any easy way to configure effort selection dialogue to allow selecting effort value from the list using single key.

Currently I have configured Effort_ALL in the following way:

(add-to-list 'org-global-properties
         '("Effort_ALL". "0:05 0:15 0:30 1:00 2:00"))

and am using org-set-effort to pop up the dialogue. However the dialogue that it shows is just a regular narrow-list-of-candidates dialogue which takes multiple keystrokes (either arrows or partial string followed by return) to select the option I need.

What I would rather have instead is a org-fast-tag-selection-single-key-style dialogue that allows to select an entry from the list by just pressing a single button (e.g. 1, 2, 3, etc).

I've tried to look at the code for the org-set-effort and google for the ivy-like list-narrowing modules, but so far wasn't able to find much.

2
+50

I'm just getting into using effort properties myself and stumbled on your question. Here is a function modified from org-fast-todo-selection which maps the index of the effort value to that number key (e.q. 0 -> 0:05 and 1 -> 0:15 per your provided EFFORT_ALL property).

(defun org-fast-effort-selection ()
  "Modification of `org-fast-todo-selection' for use with org-set-effert. Select an effort value with single keys.
Returns the new effort value, or nil if no state change should occur.

Motivated by https://emacs.stackexchange.com/questions/59424/org-set-effort-fast-effort-selection"
  ;; Format effort values into an alist keyed by index
  (let* ((fulltable (seq-map-indexed (lambda (e i) (cons (car e) (string-to-char (int-to-string i))))
                                     (org-property-get-allowed-values nil org-effort-property t)))
         (maxlen (apply 'max (mapcar
                              (lambda (x)
                                (if (stringp (car x)) (string-width (car x)) 0))
                              fulltable)))
         (expert (equal org-use-fast-todo-selection 'expert))
         (prompt "")
         (fwidth (+ maxlen 3 1 3))
         (ncol (/ (- (window-width) 4) fwidth))
         tg cnt e c tbl subtable)
    (save-excursion
      (save-window-excursion
        (if expert
            (set-buffer (get-buffer-create " *Org effort"))
          (delete-other-windows)
          (set-window-buffer (split-window-vertically) (get-buffer-create " *Org effort*"))
          (org-switch-to-buffer-other-window " *Org effort*"))
        (erase-buffer)
        (setq tbl fulltable cnt 0)
        (while (setq e (pop tbl))
          (setq tg (car e)
                c (cdr e))
          (print (char-to-string c))
          (when (and (= cnt 0))
            (insert "  "))
          (setq prompt (concat prompt "[" (char-to-string c) "] " tg " "))
          (insert "[" c "] " tg (make-string
                                 (- fwidth 4 (length tg)) ?\ ))
          (when (and (= (setq cnt (1+ cnt)) ncol)
                     ;; Avoid lines with just a closing delimiter.
                     (not (equal (car tbl) '(:endgroup))))
            (insert "\n")
            (setq cnt 0)))
        (insert "\n")
        (goto-char (point-min))
        (unless expert (org-fit-window-to-buffer))
        (message (concat "[1-9..]:Set [SPC]:clear"
                         (if expert (concat "\n" prompt) "")))
        (setq c (let ((inhibit-quit t)) (read-char-exclusive)))
        (setq subtable (nreverse subtable))
        (cond
         ((or (= c ?\C-g)
              (and (= c ?q) (not (rassoc c fulltable))))
          (setq quit-flag t))
         ((= c ?\ ) nil)
         ((setq e (or (rassoc c subtable) (rassoc c fulltable))
                tg (car e))
          tg)
         (t (setq quit-flag t)))))))

Using with org-set-effort and binding to a key:

(define-key org-mode-map
  (kbd "C-M-e") (lambda () (interactive) (org-set-effort nil (org-fast-set-effort))))

Update 07/27/2020

A possibly less intrusive solution is to add a case to org-set-effort where, if org-use-fast-todo-selection is set to 'expert, use org-fast-effort-selection as defined above.

The advantages are that you won't have to bind it to a specific key, and it will also work with org-agenda-set-effort out of the box.

I made a commit in my fork of org-mode showing how this can be done. After I use it a bit to make sure there's no edge cases that are being missed, I may submit it to the org-mode maintainers.

2
  • Thanks much! Will need to ponder the code a bit more to figure out the specifics, but it definitely does the job
    – whoever
    Jul 6 '20 at 21:56
  • Had to wrap it in some additional helpers to make it work from the agenda view (otherwise it was complaining that the agenda buffer is read-only) ``` (defun invoke-fast-effort-selection () (interactive) (save-excursion (save-window-excursion (org-agenda-switch-to) (org-set-effort nil (org-fast-set-effort)))) (org-agenda-redo)) ``` Maybe you can add it to the answer as well?
    – whoever
    Jul 8 '20 at 11:52
1

based on tuh8888's answer https://emacs.stackexchange.com/a/59475/33499 i have an enhanced version to contribute:

I patched his solution using el-patch.el to:

  • number the choices from 1..0 (use 0 for the 10th choice)
    • using dash.el because of readability (feel free to change this)
  • only include the first 10 choices (-zip-with limits to shortest argument-list)
  • provide the current effort-value via SPC (or abort like q when current is nil)
    • current value is an optional argument, can be provided from the calling function
(el-patch-defun org-fast-effort-selection ((el-patch-add &optional current))
  "Modification of `org-fast-todo-selection' for use with org-set-effert. Select an effort value with single keys.
Returns the new effort value, or nil if no state change should occur.

Motivated by https://emacs.stackexchange.com/questions/59424/org-set-effort-fast-effort-selection"
  ;; Format effort values into an alist keyed by index
  (let* ((fulltable (el-patch-swap (seq-map-indexed (lambda (e i) (cons (car e) (string-to-char (int-to-string i))))
                                                    (org-property-get-allowed-values nil org-effort-property t))
                                   (-zip-with (lambda (e i) (cons (car e) (string-to-char (int-to-string i))))
                                              (org-property-get-allowed-values nil org-effort-property t)
                                              '(1 2 3 4 5 6 7 8 9 0))))
         (maxlen (apply 'max (mapcar
                              (lambda (x)
                                (if (stringp (car x)) (string-width (car x)) 0))
                              fulltable)))
         (expert (equal org-use-fast-todo-selection 'expert))
         (prompt "")
         (fwidth (+ maxlen 3 1 3))
         (ncol (/ (- (window-width) 4) fwidth))
         tg cnt e c tbl subtable)
    (save-excursion
      (save-window-excursion
        (if expert
            (set-buffer (get-buffer-create " *Org effort"))
          (delete-other-windows)
          (set-window-buffer (split-window-vertically) (get-buffer-create " *Org effort*"))
          (org-switch-to-buffer-other-window " *Org effort*"))
        (erase-buffer)
        (setq tbl fulltable cnt 0)
        (while (setq e (pop tbl))
          (setq tg (car e)
                c (cdr e))
          (print (char-to-string c))
          (when (and (= cnt 0))
            (insert "  "))
          (setq prompt (concat prompt "[" (char-to-string c) "] " tg " "))
          (insert "[" c "] " tg (make-string
                                 (- fwidth 4 (length tg)) ?\ ))
          (when (and (= (setq cnt (1+ cnt)) ncol)
                     ;; Avoid lines with just a closing delimiter.
                     (not (equal (car tbl) '(:endgroup))))
            (insert "\n")
            (setq cnt 0)))
        (insert "\n")
        (goto-char (point-min))
        (unless expert (org-fit-window-to-buffer))
        (message (concat (el-patch-swap "[1-9..]:Set [SPC]:clear" (format "[1-9..]:Set [SPC]: %s" (or current "abort")))
                         (if expert (concat "\n" prompt) "")))
        (setq c (let ((inhibit-quit t)) (read-char-exclusive)))
        (setq subtable (nreverse subtable))
        (cond
         ((or (= c ?\C-g)
              (and (= c ?q) (not (rassoc c fulltable))))
          (setq quit-flag t))
         ((= c ?\ ) (el-patch-swap nil
                                   (or current ; gebe alten wert zurück wenn non-nil sonst quit
                                       (setq quit-flag t))))
         ((setq e (or (rassoc c subtable) (rassoc c fulltable))
                tg (car e))
          tg)
         (t (setq quit-flag t)))))))


(el-patch-defun org-set-effort (&optional increment value)
  "Set the effort property of the current entry.
If INCREMENT is non-nil, set the property to the next allowed
value. Otherwise, if optional argument VALUE is provided, use it.
Eventually, prompt for the new value if none of the previous
variables is set."
  (interactive "P")
  (let* ((allowed (org-property-get-allowed-values nil org-effort-property t))
         (current (org-entry-get nil org-effort-property))
         (value
          (cond
           (increment
            (unless allowed (user-error "Allowed effort values are not set"))
            (or (cl-caadr (member (list current) allowed))
                (user-error "Unknown value %S among allowed values" current)))
           (value
            (if (stringp value) value
              (error "Invalid effort value: %S" value)))
           (el-patch-add ((eq org-use-fast-todo-selection 'expert) (org-fast-effort-selection current)))
           (t
            (let ((must-match
                   (and allowed
                        (not (get-text-property 0 'org-unrestricted
                                                (caar allowed))))))
              (completing-read "Effort: " allowed nil must-match))))))
    ;; Test whether the value can be interpreted as a duration before
    ;; inserting it in the buffer:
    (org-duration-to-minutes value)
    ;; Maybe update the effort value:
    (unless (equal current value)
      (org-entry-put nil org-effort-property value))
    (org-refresh-property '((effort . identity)
                            (effort-minutes . org-duration-to-minutes))
                          value)
    (when (equal (org-get-heading t t t t)
                 (bound-and-true-p org-clock-current-task))
      (setq org-clock-effort value)
      (org-clock-update-mode-line))
    (message "%s is now %s" org-effort-property value)))

1
  • I am sorry, I dont understand the Problem here. How would you say i can contribute to this question? I reframed my answer. I hope this is more acceptable? I fear if i delete it now, i will not be able to repost it later (because of time constraints). Will i eventually get more reputation just by waiting?
    – bitclick
    Apr 18 at 5:52

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.