[PATCH] Improved org-assign-fast-keys.

[Mikael Fornius <mfo@abc.se>]

[-- Attachment #1: Type: text/plain, Size: 534 bytes --]


I have 30+ TODO-keywords defined in some org-files.

When using C-c C-t to alter state I got weird keys assigned.

I suggest changing org-assign-fast-keys as attached patch describes.

I was bold enough to remove the FIXME comment already there but if one
has more than 70 keywords it can cause ugly keys again. But no one uses
more than 70 keywords?

I have tested it and, "it works for me". :-)

Anyway, Carsten, feel free to use this patch in org-mode if you like it.

Thanks for a great piece of software and community, cheers!


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: org-assign-fast-keys patch --]
[-- Type: text/x-patch, Size: 2133 bytes --]

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 2dc260d..c662d89 100755
--- a/lisp/ChangeLog
+++ b/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-latex.el (org-export-latex-preprocess): More consistent
diff --git a/lisp/org.el b/lisp/org.el
index cd378b4..d92e335 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

[-- Attachment #3: Type: text/plain, Size: 20 bytes --]


-- 
Mikael Fornius

[-- Attachment #4: Type: text/plain, Size: 201 bytes --]

_______________________________________________
Emacs-orgmode mailing list
Please use `Reply All' to send replies to the list.
Emacs-orgmode@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-orgmode