Browse Source

Improve automatic letter selection for TODO keywords

Path by Mikael Fornius
Carsten Dominik 15 years ago
parent
commit
2038d61463
2 changed files with 21 additions and 20 deletions
  1. 7 0
      lisp/ChangeLog
  2. 14 20
      lisp/org.el

+ 7 - 0
lisp/ChangeLog

@@ -1,3 +1,10 @@
+2010-01-28  Mikael Fornius  <mfo@abc.se>
+
+	* 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  <carsten.dominik@gmail.com>
 
 	* org-exp.el (org-export-preprocess-hook): Improve documentation.

+ 14 - 20
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