>From 369a79e2190726aed2aa5dbe71fe2e99d9a59b86 Mon Sep 17 00:00:00 2001
From: Rasmus
Date: Thu, 21 Dec 2017 12:55:35 +0100
Subject: [PATCH 2/4] org-structure-template-alist: Use string keys
* lisp/org-tempo.el (org-tempo-keywords-alist):
(org-tempo-setup):
(org-tempo-add-templates): Use string keys
* 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 block selection.
fix
---
lisp/org-tempo.el | 13 ++++----
lisp/org.el | 98 +++++++++++++++++++++++++++++++++++++++++++------------
2 files changed, 85 insertions(+), 26 deletions(-)
diff --git a/lisp/org-tempo.el b/lisp/org-tempo.el
index 86e7b51eb..92a97c752 100644
--- a/lisp/org-tempo.el
+++ b/lisp/org-tempo.el
@@ -51,10 +51,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
@@ -76,6 +76,7 @@ For example \" n n
@@ -114,7 +115,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 e66e6d543..10e7682af 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -11876,16 +11876,16 @@ 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
@@ -11898,20 +11898,78 @@ corresponding structure is inserted, with \"#+BEGIN_\" and
(string :tag "Template")))
:package-version '(Org . "9.2"))
+(autoload 'org-mks "org-capture" "Select a member of an alist with multiple keys." t)
+
+(defun org-insert-structure-template--mks ()
+ "Present `org-structure-template-alist' with `org-mks'.
+
+- Menus are added if keys require more than one stroke.
+- 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
+ (keys (mapcar 'car org-structure-template-alist))
+ (start-letters (delete-dups (mapcar (lambda (key) (substring key 0 1)) keys)))
+ (mks (mapcar (lambda (letter)
+ (list letter
+ (cl-remove-if-not
+ (apply-partially 'string-match-p (concat "^" letter))
+ org-structure-template-alist :key 'car)))
+ start-letters)))
+ (org-mks
+ (apply 'append
+ (mapcar (lambda (sublist)
+ (if (eq 1 (length (cadr sublist)))
+ (mapcar (lambda (elm)
+ (list (substring (car elm) 0 1)
+ (cdr elm) ""))
+ (cadr sublist))
+ (let* ((topkey (car sublist))
+ (elms (cadr sublist))
+ (keys (mapcar 'car elms))
+ (longp (> (length elms) 3)))
+ (append
+ (list (list topkey
+ (concat
+ (mapconcat 'cdr
+ (cl-subseq elms 0 (if longp 3 (length elms)))
+ ", ")
+ (when longp ", ..."))))
+ (cl-mapcar 'list
+ (org-insert-structure-template--unique-keys keys)
+ (mapcar 'cdr elms)
+ (make-list (length elms) ""))))))
+ mks))
+ "Select a key\n============"
+ "Key: ")))
+
+(defun org-insert-structure-template--unique-keys (keys)
+ "Make each key in KEYS unique and two characters long.
+
+For keys more than two characters, find the first unique
+combination of the first letter and subsequent letters."
+ (cl-loop for key in keys
+ ;; There should at most be one key that is of length one.
+ if (eq 1 (length key))
+ collect (concat key "\t") into new-keys
+ ;; All keys of two characters should be unique.
+ else if (eq (length key) 2)
+ collect key into new-keys
+ else
+ collect
+ (cl-find-if-not (lambda (k) (member k new-keys))
+ (mapcar (apply-partially 'concat (substring key 0 1))
+ (split-string (substring key 1) "" t)))
+ into new-keys
+ finally return new-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 , prompt the
-user for a string to use. With an active region, wrap the region
-in the block. Otherwise, insert an empty block."
+First read keys, which can be one of the keys in
+`org-structure-template-alist'. 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))))
+ (let ((struct-string (nth 1 (org-insert-structure-template--mks))))
struct-string)))
(let* ((region? (use-region-p))
(s (if region? (region-beginning) (point)))
--
2.15.1