From 2038d614638d1230fc9cb77e994e82fce0643bdc Mon Sep 17 00:00:00 2001 From: Carsten Dominik Date: Thu, 28 Jan 2010 19:26:41 +0100 Subject: [PATCH] Improve automatic letter selection for TODO keywords Path by Mikael Fornius --- lisp/ChangeLog | 7 +++++++ lisp/org.el | 34 ++++++++++++++-------------------- 2 files changed, 21 insertions(+), 20 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 09052269f..1661a199b 100755 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,10 @@ +2010-01-28 Mikael Fornius + + * org.el (org-assign-fast-keys): Prefer keys used in keyword name + when assigning. Begin using numerical characters when all in name + is used up. This is to spare alphanumeric characters for better + match with other keywords. + 2010-01-28 Carsten Dominik * org-exp.el (org-export-preprocess-hook): Improve documentation. diff --git a/lisp/org.el b/lisp/org.el index cd378b4ab..d92e3359c 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -4129,30 +4129,24 @@ This will extract info from a string like \"WAIT(w@/!)\"." x)) list)) -;; FIXME: this could be done much better, using second characters etc. (defun org-assign-fast-keys (alist) "Assign fast keys to a keyword-key alist. Respect keys that are already there." - (let (new e k c c1 c2 (char ?a)) + (let (new e (alt ?0)) (while (setq e (pop alist)) - (cond - ((equal e '(:startgroup)) (push e new)) - ((equal e '(:endgroup)) (push e new)) - ((equal e '(:newline)) (push e new)) - (t - (setq k (car e) c2 nil) - (if (cdr e) - (setq c (cdr e)) - ;; automatically assign a character. - (setq c1 (string-to-char - (downcase (substring - k (if (= (string-to-char k) ?@) 1 0))))) - (if (or (rassoc c1 new) (rassoc c1 alist)) - (while (or (rassoc char new) (rassoc char alist)) - (setq char (1+ char))) - (setq c2 c1)) - (setq c (or c2 char))) - (push (cons k c) new)))) + (if (or (memq (car e) '(:newline :endgroup :startgroup)) + (cdr e)) ;; Key already assigned. + (push e new) + (let ((clist (string-to-list (downcase (car e)))) + (used (append new alist))) + (when (= (car clist) ?@) + (pop clist)) + (while (and clist (rassoc (car clist) used)) + (pop clist)) + (unless clist + (while (rassoc alt used) + (incf alt))) + (push (cons (car e) (or (car clist) alt)) new)))) (nreverse new))) ;;; Some variables used in various places