>From b56df737b7392845c6e00d4cc52801e64c105f8b Mon Sep 17 00:00:00 2001
From: Rasmus <address@hidden>
Date: Thu, 21 Dec 2017 12:55:35 +0100
Subject: [PATCH 3/6] org: org-structure-template-alist uses string keys

* lisp/org-tempo.el (org-tempo-keywords-alist):
  (org-tempo-setup):
  (org-tempo-add-templates):
* testing/lisp/test-org-tempo.el (test-org-tempo/add-new-templates):
* lisp/org.el (org-structure-template-alist): Use string keys.
  (org--insert-structure-template-mks):
  (org--insert-structure-template-unique-keys): New functions for block selection.
  (org-insert-structure-template): Use new functions.
* etc/ORG-NEWS:
* doc/org-manual.org: Reflect changes.
---
 doc/org-manual.org             |   7 +-
 etc/ORG-NEWS                   |   4 +-
 lisp/org-tempo.el              |  16 ++--
 lisp/org.el                    | 140 ++++++++++++++++++++++++++-------
 testing/lisp/test-org-tempo.el |   9 ++-
 5 files changed, 130 insertions(+), 46 deletions(-)

diff --git a/doc/org-manual.org b/doc/org-manual.org
index d787e5da4..82639445c 100644
--- a/doc/org-manual.org
+++ b/doc/org-manual.org
@@ -18174,9 +18174,10 @@ text in such a block.
 
      Prompt for a type of block structure, and insert the block at
      point.  If the region is active, it is wrapped in the block.
-     First prompts the user for a key, which is used to look up
-     a structure type from the values below.  If the key is
-     {{{kbd(TAB)}}}, the user is prompted to enter a type.
+     First prompts the user for keys, which are used to look up a
+     structure type from the variable below.  If the key is
+     {{{kbd(TAB)}}}, {{{kbd(RET)}}}, or {{{kbd(SPC)}}}, the user is
+     prompted to enter a block type.
 
 #+vindex: org-structure-template-alist
 Available structure types are defined in
diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index 0edd77115..bfb5a2dc2 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -65,8 +65,8 @@ details.
 *** Change ~org-structure-template-alist~ value
 
 With the new template expansion mechanism (see
-[[*~org-insert-structure-template~]]), the variable changed its data type.
-See docstring for details.
+[[*~org-insert-structure-template~]] and =org-tempo.el=), the variable
+changed its data type.  See docstring for details.
 
 *** Change ~org-set-effort~ signature
 See docstring for details.
diff --git a/lisp/org-tempo.el b/lisp/org-tempo.el
index 047c4cb4a..a41c99465 100644
--- a/lisp/org-tempo.el
+++ b/lisp/org-tempo.el
@@ -54,10 +54,10 @@
   "Tempo tags for Org mode")
 
 (defcustom org-tempo-keywords-alist
-  '((?L . "latex")
-    (?H . "html")
-    (?A . "ascii")
-    (?i . "index"))
+  '(("L" . "latex")
+    ("H" . "html")
+    ("A" . "ascii")
+    ("i" . "index"))
   "Keyword completion elements.
 
 Like `org-structure-template-alist' this alist of KEY characters
@@ -67,7 +67,7 @@ value.
 For example \"<l\" at the beginning of a line is expanded to
 #+latex:"
   :group 'org-tempo
-  :type '(repeat (cons (character :tag "Key")
+  :type '(repeat (cons (string :tag "Key")
 		       (string :tag "Keyword")))
   :package-version '(Org . "9.2"))
 
@@ -78,7 +78,7 @@ For example \"<l\" at the beginning of a line is expanded to
 (defun org-tempo-setup ()
   (org-tempo-add-templates)
   (tempo-use-tag-list 'org-tempo-tags)
-  (setq-local tempo-match-finder "^ *\\(<[[:word:]]\\)\\="))
+  (setq-local tempo-match-finder "^ *\\(<[[:word:]]+\\)\\="))
 
 (defun org-tempo-add-templates ()
   "Update all Org Tempo templates.
@@ -101,7 +101,7 @@ Goes through `org-structure-template-alist' and
 
 (defun org-tempo-add-block (entry)
   "Add block entry from `org-structure-template-alist'."
-  (let* ((key (format "<%c" (car entry)))
+  (let* ((key (format "<%s" (car entry)))
 	 (name (cdr entry)))
     (tempo-define-template (format "org-%s" (replace-regexp-in-string " " "-" name))
 			   `(,(format "#+begin_%s " name) p '> n n
@@ -113,7 +113,7 @@ Goes through `org-structure-template-alist' and
 
 (defun org-tempo-add-keyword (entry)
   "Add keyword entry from `org-tempo-keywords-alist'."
-  (let* ((key (format "<%c" (car entry)))
+  (let* ((key (format "<%s" (car entry)))
 	 (name (cdr entry)))
     (tempo-define-template (format "org-%s" (replace-regexp-in-string " " "-" name))
 			   `(,(format "#+%s: " name) p '>)
diff --git a/lisp/org.el b/lisp/org.el
index dc751656f..bcf8b5986 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -11642,43 +11642,125 @@ keywords relative to each registered export back-end."
     "TITLE:" "TODO:" "TYP_TODO:" "SELECT_TAGS:" "EXCLUDE_TAGS:"))
 
 (defcustom org-structure-template-alist
-  '((?a . "export ascii")
-    (?c . "center")
-    (?C . "comment")
-    (?e . "example")
-    (?E . "export")
-    (?h . "export html")
-    (?l . "export latex")
-    (?q . "quote")
-    (?s . "src")
-    (?v . "verse"))
+  '(("a" . "export ascii")
+    ("c" . "center")
+    ("C" . "comment")
+    ("e" . "example")
+    ("E" . "export")
+    ("h" . "export html")
+    ("l" . "export latex")
+    ("q" . "quote")
+    ("s" . "src")
+    ("v" . "verse"))
   "Structure completion elements.
-This is an alist of characters and values.  When
-`org-insert-structure-template' is called, an additional key is
-read.  The key is first looked up in this alist, and the
-corresponding structure is inserted, with \"#+BEGIN_\" and
-\"#+END_\" added automatically."
+This is an alist of keys and block types.  With
+`org-insert-structure-template' a block can be inserted through a
+menu. The block type is inserted, with \"#+BEGIN_\" and
+\"#+END_\" added automatically.  The menukeys are determined
+based on the key elements in the `org-structure-template-alist'.
+If two entries have the keys \"a\" and \"aa\" respectively, the
+former will be inserted by typing \"a TAB/RET/SPC\" and the
+latter will be inserted by typing \"aa\".  If an entry with the
+key \"aab\" is later added it would be inserted by typing \"ab\".
+
+If loaded, Org Tempo also uses `org-structure-template-alist'.  A
+block can be inserted by pressing TAB after the string \"<KEY\".
+"
   :group 'org-edit-structure
   :type '(repeat
-	  (cons (character :tag "Key")
+	  (cons (string :tag "Key")
 		(string :tag "Template")))
   :package-version '(Org . "9.2"))
 
+(defun org--insert-structure-template-mks ()
+  "Present `org-structure-template-alist' with `org-mks'.
+
+Menus are added if keys require more than one keystroke.
+Tabs are added to single key entires when needing more than one stroke.
+Keys longer than two characters are reduced to two characters."
+  (let* (case-fold-search
+	 (templates (append org-structure-template-alist
+			    '(("\t" . "Press TAB, RET or SPC to write block name"))))
+         (keys (mapcar #'car templates))
+         (start-letters (delete-dups (mapcar (lambda (key) (substring key 0 1)) keys)))
+	 ;; Sort each element of `org-structure-template-alist' into
+	 ;; sublists according to the first letter.
+         (superlist (mapcar (lambda (letter)
+                              (list letter
+				    (cl-remove-if-not
+				     (apply-partially #'string-match-p (concat "^" letter))
+				     templates :key #'car)))
+			    start-letters)))
+    (org-mks
+     (apply #'append
+	    ;; Make an `org-mks' table.  If only one element is
+	    ;; present in a sublist, make it part of the top-menu,
+	    ;; otherwise make a submenu according to the starting
+	    ;; letter and populate it.
+	    (mapcar (lambda (sublist)
+		      (if (eq 1 (length (cadr sublist)))
+                          (mapcar (lambda (elm)
+				    (list (substring (car elm) 0 1)
+                                          (cdr elm) ""))
+                                  (cadr sublist))
+			;; Create submenu.
+                        (let* ((topkey (car sublist))
+			       (elms (cadr sublist))
+			       (keys (mapcar #'car elms))
+			       (long (> (length elms) 3)))
+                          (append
+			   (list
+			    ;; Make a description of the submenu.
+			    (list topkey
+				  (concat
+				   (mapconcat #'cdr
+					      (cl-subseq elms 0 (if long 3 (length elms)))
+					      ", ")
+                                   (when long ", ..."))))
+			   ;; List of entries in submenu.
+			   (cl-mapcar #'list
+				      (org--insert-structure-template-unique-keys keys)
+				      (mapcar #'cdr elms)
+				      (make-list (length elms) ""))))))
+		    superlist))
+     "Select a key\n============"
+     "Key: ")))
+
+(defun org--insert-structure-template-unique-keys (keys)
+  "Make list of unique, two character long elements from KEYS.
+
+Elements of length one have a tab appended.  Elements of length
+two are kept as is.  Longer elements are truncated to length two.
+
+If an element cannot be made unique an error is raised."
+  (let ((orderd-keys (cl-sort (copy-sequence keys) #'< :key #'length))
+	menu-keys)
+    (dolist (key orderd-keys)
+      (let ((potential-key
+	     (cl-case (length key)
+	       (1 (concat key "\t"))
+	       (2 key)
+	       (otherwise
+		(cl-find-if-not (lambda (k) (assoc k menu-keys))
+				(mapcar (apply-partially #'concat (substring  key 0 1))
+					(split-string (substring key 1) "" t)))))))
+	(if (or (not potential-key) (assoc potential-key menu-keys))
+	    (user-error "Could not make unique key for %s." key)
+	  (push (cons potential-key key) menu-keys))))
+    (mapcar #'car
+	    (cl-sort menu-keys #'<
+		     :key (lambda (elm) (cl-position (cdr elm) keys))))))
+
 (defun org-insert-structure-template (type)
-  "Insert a block structure of the type #+begin_foo/#+end_foo.
-First read a character, which can be one of the keys in
-`org-structure-template-alist'.  When it is <TAB>, prompt the
-user for a string to use.  With an active region, wrap the region
-in the block.  Otherwise, insert an empty block."
+    "Insert a block structure of the type #+begin_foo/#+end_foo.
+First choose a block based on `org-structure-template-alist'.
+Alternatively, type RET, TAB or SPC to write the block type.
+With an active region, wrap the region in the block.  Otherwise,
+insert an empty block."
   (interactive
-   (list
-    (let* ((key (read-key "Key: "))
-	   (struct-string
-	    (or (cdr (assq key org-structure-template-alist))
-		(and (= key ?\t)
-		     (read-string "Structure type: "))
-		(user-error "`%c' has no structure definition" key))))
-      struct-string)))
+   (list (pcase (org--insert-structure-template-mks)
+	   (`("\t" . ,_) (read-string "Structure type: "))
+	   (`(,_ ,choice . ,_) choice))))
   (let* ((region? (use-region-p))
 	 (s (if region? (region-beginning) (point)))
 	 (e (copy-marker (if region? (region-end) (point)) t))
diff --git a/testing/lisp/test-org-tempo.el b/testing/lisp/test-org-tempo.el
index 20062feeb..6c751d4f8 100644
--- a/testing/lisp/test-org-tempo.el
+++ b/testing/lisp/test-org-tempo.el
@@ -61,13 +61,14 @@
 
 (ert-deftest test-org-tempo/add-new-templates ()
   "Test that new structures and keywords are added correctly."
-  ;; Check that deleted keys are not kept
+  ;; New blocks should be added.
   (should
-   (let ((org-structure-template-alist '((?n . "new_block"))))
+   (let ((org-structure-template-alist '(("n" . "new_block"))))
      (org-tempo-add-templates)
-     (assoc "<n" org-tempo-tags)))
+     (assoc "<l" org-tempo-tags)))
+  ;; New keys should be added.
   (should
-   (let ((org-tempo-keywords-alist '((?N . "new_keyword"))))
+   (let ((org-tempo-keywords-alist '(("N" . "new_keyword"))))
      (org-tempo-add-templates)
      (assoc "<N" org-tempo-tags))))
 
-- 
2.17.0