diff options
author | Rasmus <rasmus@gmx.us> | 2017-12-21 12:55:35 +0100 |
---|---|---|
committer | Rasmus <rasmus@gmx.us> | 2018-04-08 12:47:12 +0200 |
commit | b56df737b7392845c6e00d4cc52801e64c105f8b (patch) | |
tree | 710988ff3e43395a5989c5dcab736f3188581670 | |
parent | ac4d5fe1b3c782011ef2a3d78cbd44b042da7c12 (diff) | |
download | org-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.org | 7 | ||||
-rw-r--r-- | etc/ORG-NEWS | 4 | ||||
-rw-r--r-- | lisp/org-tempo.el | 16 | ||||
-rw-r--r-- | lisp/org.el | 140 | ||||
-rw-r--r-- | 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 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)))) |