>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