summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRasmus <rasmus@gmx.us>2017-12-21 12:55:35 +0100
committerRasmus <rasmus@gmx.us>2018-04-08 12:47:12 +0200
commitb56df737b7392845c6e00d4cc52801e64c105f8b (patch)
tree710988ff3e43395a5989c5dcab736f3188581670
parentac4d5fe1b3c782011ef2a3d78cbd44b042da7c12 (diff)
downloadorg-mode-b56df737b7392845c6e00d4cc52801e64c105f8b.tar.gz
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.
-rw-r--r--doc/org-manual.org7
-rw-r--r--etc/ORG-NEWS4
-rw-r--r--lisp/org-tempo.el16
-rw-r--r--lisp/org.el140
-rw-r--r--testing/lisp/test-org-tempo.el9
5 files changed, 130 insertions, 46 deletions
diff --git a/doc/org-manual.org b/doc/org-manual.org
index d787e5d..8263944 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 0edd771..bfb5a2d 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 047c4cb..a41c994 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 dc75165..bcf8b59 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 20062fe..6c751d4 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))))