emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
* [patch] Improved block insertion
@ 2018-04-07 19:01 Rasmus
  2018-04-08  7:55 ` Nicolas Goaziou
  0 siblings, 1 reply; 4+ messages in thread
From: Rasmus @ 2018-04-07 19:01 UTC (permalink / raw)
  To: emacs-orgmode

[-- Attachment #1: Type: text/plain, Size: 1689 bytes --]

Hi,

These patches improve the block insertion mechanisms using both the
keyboard binding and org-tempo.

I first sent these patches at Christmas, but did not have time to finish
them due to unexpected events.

On the Tempo side the cursor placement is a bit more clever.  For an
"empty" source blocks, the cursor will be placed after "#+begin_src ".
For other blocks, the cursor is placed on the first line after the
"#+begin"-line.  A better job is being done to detect changes.  Also, long
keys arre supported!

I have added a menu system to ‘org-insert-structure-template’ based on
‘org-mks’ to accommodate long keys.  It tries to make a menu of max two
keystrokes to insert a block.  One can also insert a manually typed block
by clicking tab/space/ret in the top menu.  An example of menu keys is
shown in the comments below.

Conflict resolution is somewhat brutal as the user is prevented from using
the system if keys are conflicting.  E.g. if the following was my
org-structure-template-alist, ‘org-insert-structure-template’ would raise
an error.

    (("c"    . "c1")  ; "c[\r\t ]",
     ("co"   . "c2")  ; "co"
     ("com"  . "c3")  ; "cm"
     ("como" . "c4")) ; error as both "co" and "cm" are used

The alternative of dropping duplicates silently or with a warning is worse
IMO.

I have tried to make org-insert-structure-template respect indentation and
insert more space in patch 5.

Patch 6 changes the key binding of blocks to "C-c C-," as discussed in
December 2017.  Let me know if this key is OK and if the old key should
still be kept.

Comments are appreciated as I’d hope to merge them ASAP.

Rasmus

-- 
Slaa Patienten ihjel, saa siger Feberen Pas

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-org-macs-Move-org-mks-from-org-capture-to-org-macs.patch --]
[-- Type: text/x-patch, Size: 8534 bytes --]

From 06ab656f4250ee7a765550f353743056aed31c8d Mon Sep 17 00:00:00 2001
From: Rasmus <rasmus@gmx.us>
Date: Sat, 7 Apr 2018 12:58:51 +0200
Subject: [PATCH 1/6] org-macs: Move org-mks from org-capture to org-macs

* lisp/org-capture.el (org-mks): Moved to org-macs.el.
* lisp/org-macs.el (org-mks): Added from org-capture.el.

The move is being done to accommodate the usage of org-mks in other
Org libraries.
---
 lisp/org-capture.el | 88 ---------------------------------------------
 lisp/org-macs.el    | 87 ++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 87 insertions(+), 88 deletions(-)

diff --git a/lisp/org-capture.el b/lisp/org-capture.el
index fd4706538..630166c21 100644
--- a/lisp/org-capture.el
+++ b/lisp/org-capture.el
@@ -1479,94 +1479,6 @@ Use PREFIX as a prefix for the name of the indirect buffer."
   (unless (org-kill-is-subtree-p tree)
     (error "Template is not a valid Org entry or tree")))
 
-(defun org-mks (table title &optional prompt specials)
-  "Select a member of an alist with multiple keys.
-
-TABLE is the alist which should contain entries where the car is a string.
-There should be two types of entries.
-
-1. prefix descriptions like (\"a\" \"Description\")
-   This indicates that `a' is a prefix key for multi-letter selection, and
-   that there are entries following with keys like \"ab\", \"ax\"...
-
-2. Select-able members must have more than two elements, with the first
-   being the string of keys that lead to selecting it, and the second a
-   short description string of the item.
-
-The command will then make a temporary buffer listing all entries
-that can be selected with a single key, and all the single key
-prefixes.  When you press the key for a single-letter entry, it is selected.
-When you press a prefix key, the commands (and maybe further prefixes)
-under this key will be shown and offered for selection.
-
-TITLE will be placed over the selection in the temporary buffer,
-PROMPT will be used when prompting for a key.  SPECIAL is an
-alist with (\"key\" \"description\") entries.  When one of these
-is selected, only the bare key is returned."
-  (save-window-excursion
-    (let ((inhibit-quit t)
-	  (buffer (org-switch-to-buffer-other-window "*Org Select*"))
-	  (prompt (or prompt "Select: "))
-	  current)
-      (unwind-protect
-	  (catch 'exit
-	    (while t
-	      (erase-buffer)
-	      (insert title "\n\n")
-	      (let ((des-keys nil)
-		    (allowed-keys '("\C-g"))
-		    (cursor-type nil))
-		;; Populate allowed keys and descriptions keys
-		;; available with CURRENT selector.
-		(let ((re (format "\\`%s\\(.\\)\\'"
-				  (if current (regexp-quote current) "")))
-		      (prefix (if current (concat current " ") "")))
-		  (dolist (entry table)
-		    (pcase entry
-		      ;; Description.
-		      (`(,(and key (pred (string-match re))) ,desc)
-		       (let ((k (match-string 1 key)))
-			 (push k des-keys)
-			 (push k allowed-keys)
-			 (insert prefix "[" k "]" "..." "  " desc "..." "\n")))
-		      ;; Usable entry.
-		      (`(,(and key (pred (string-match re))) ,desc . ,_)
-		       (let ((k (match-string 1 key)))
-			 (insert prefix "[" k "]" "     " desc "\n")
-			 (push k allowed-keys)))
-		      (_ nil))))
-		;; Insert special entries, if any.
-		(when specials
-		  (insert "----------------------------------------------------\
----------------------------\n")
-		  (pcase-dolist (`(,key ,description) specials)
-		    (insert (format "[%s]     %s\n" key description))
-		    (push key allowed-keys)))
-		;; Display UI and let user select an entry or
-		;; a sub-level prefix.
-		(goto-char (point-min))
-		(unless (pos-visible-in-window-p (point-max))
-		  (org-fit-window-to-buffer))
-		(message prompt)
-		(let ((pressed (char-to-string (read-char-exclusive))))
-		  (while (not (member pressed allowed-keys))
-		    (message "Invalid key `%s'" pressed) (sit-for 1)
-		    (message prompt)
-		    (setq pressed (char-to-string (read-char-exclusive))))
-		  (setq current (concat current pressed))
-		  (cond
-		   ((equal pressed "\C-g") (user-error "Abort"))
-		   ;; Selection is a prefix: open a new menu.
-		   ((member pressed des-keys))
-		   ;; Selection matches an association: return it.
-		   ((let ((entry (assoc current table)))
-		      (and entry (throw 'exit entry))))
-		   ;; Selection matches a special entry: return the
-		   ;; selection prefix.
-		   ((assoc current specials) (throw 'exit current))
-		   (t (error "No entry available")))))))
-	(when buffer (kill-buffer buffer))))))
-
 ;;; The template code
 (defun org-capture-select-template (&optional keys)
   "Select a capture template.
diff --git a/lisp/org-macs.el b/lisp/org-macs.el
index d4531c25a..007882b79 100644
--- a/lisp/org-macs.el
+++ b/lisp/org-macs.el
@@ -244,6 +244,93 @@ error when the user input is empty."
       'org-time-stamp-inactive)
     (apply #'completing-read args)))
 
+(defun org-mks (table title &optional prompt specials)
+  "Select a member of an alist with multiple keys.
+
+TABLE is the alist which should contain entries where the car is a string.
+There should be two types of entries.
+
+1. prefix descriptions like (\"a\" \"Description\")
+   This indicates that `a' is a prefix key for multi-letter selection, and
+   that there are entries following with keys like \"ab\", \"ax\"...
+
+2. Select-able members must have more than two elements, with the first
+   being the string of keys that lead to selecting it, and the second a
+   short description string of the item.
+
+The command will then make a temporary buffer listing all entries
+that can be selected with a single key, and all the single key
+prefixes.  When you press the key for a single-letter entry, it is selected.
+When you press a prefix key, the commands (and maybe further prefixes)
+under this key will be shown and offered for selection.
+
+TITLE will be placed over the selection in the temporary buffer,
+PROMPT will be used when prompting for a key.  SPECIAL is an
+alist with (\"key\" \"description\") entries.  When one of these
+is selected, only the bare key is returned."
+  (save-window-excursion
+    (let ((inhibit-quit t)
+	  (buffer (org-switch-to-buffer-other-window "*Org Select*"))
+	  (prompt (or prompt "Select: "))
+	  current)
+      (unwind-protect
+	  (catch 'exit
+	    (while t
+	      (erase-buffer)
+	      (insert title "\n\n")
+	      (let ((des-keys nil)
+		    (allowed-keys '("\C-g"))
+		    (cursor-type nil))
+		;; Populate allowed keys and descriptions keys
+		;; available with CURRENT selector.
+		(let ((re (format "\\`%s\\(.\\)\\'"
+				  (if current (regexp-quote current) "")))
+		      (prefix (if current (concat current " ") "")))
+		  (dolist (entry table)
+		    (pcase entry
+		      ;; Description.
+		      (`(,(and key (pred (string-match re))) ,desc)
+		       (let ((k (match-string 1 key)))
+			 (push k des-keys)
+			 (push k allowed-keys)
+			 (insert prefix "[" k "]" "..." "  " desc "..." "\n")))
+		      ;; Usable entry.
+		      (`(,(and key (pred (string-match re))) ,desc . ,_)
+		       (let ((k (match-string 1 key)))
+			 (insert prefix "[" k "]" "     " desc "\n")
+			 (push k allowed-keys)))
+		      (_ nil))))
+		;; Insert special entries, if any.
+		(when specials
+		  (insert "----------------------------------------------------\
+---------------------------\n")
+		  (pcase-dolist (`(,key ,description) specials)
+		    (insert (format "[%s]     %s\n" key description))
+		    (push key allowed-keys)))
+		;; Display UI and let user select an entry or
+		;; a sub-level prefix.
+		(goto-char (point-min))
+		(unless (pos-visible-in-window-p (point-max))
+		  (org-fit-window-to-buffer))
+		(message prompt)
+		(let ((pressed (char-to-string (read-char-exclusive))))
+		  (while (not (member pressed allowed-keys))
+		    (message "Invalid key `%s'" pressed) (sit-for 1)
+		    (message prompt)
+		    (setq pressed (char-to-string (read-char-exclusive))))
+		  (setq current (concat current pressed))
+		  (cond
+		   ((equal pressed "\C-g") (user-error "Abort"))
+		   ;; Selection is a prefix: open a new menu.
+		   ((member pressed des-keys))
+		   ;; Selection matches an association: return it.
+		   ((let ((entry (assoc current table)))
+		      (and entry (throw 'exit entry))))
+		   ;; Selection matches a special entry: return the
+		   ;; selection prefix.
+		   ((assoc current specials) (throw 'exit current))
+		   (t (error "No entry available")))))))
+	(when buffer (kill-buffer buffer))))))
 
 \f
 ;;; Logic
-- 
2.17.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-org-macs-Make-tab-space-and-RET-equivalent-in-org-mk.patch --]
[-- Type: text/x-patch, Size: 2725 bytes --]

From 3c635136a80e9a5c56e37176860bbb0c97637a93 Mon Sep 17 00:00:00 2001
From: Rasmus <rasmus@gmx.us>
Date: Sat, 7 Apr 2018 14:24:36 +0200
Subject: [PATCH 2/6] org-macs: Make tab, space and RET equivalent in org-mks

* lisp/org-macs.el (org--mks-read-key): New function.
  (org-mks): Use new function and make space, tab and RET equivalent.
---
 lisp/org-macs.el | 27 ++++++++++++++++++++-------
 1 file changed, 20 insertions(+), 7 deletions(-)

diff --git a/lisp/org-macs.el b/lisp/org-macs.el
index 007882b79..c1c57fd10 100644
--- a/lisp/org-macs.el
+++ b/lisp/org-macs.el
@@ -244,6 +244,20 @@ error when the user input is empty."
       'org-time-stamp-inactive)
     (apply #'completing-read args)))
 
+(defun org--mks-read-key (allowed-keys prompt)
+  "Read a key and ensure it is a member of ALLOWED-KEYS.
+
+Tab, space and RET are treated equivalently."
+  (let* ((char (read-char-exclusive prompt))
+	 (key (char-to-string
+	       (cond ((memq char '(?\s ?\t ?\r)) ?\t)
+		     (t char)))))
+    (if (member key allowed-keys)
+        key
+      (message "Invalid key: `%s'" key)
+      (sit-for 1)
+      (org--mks-read-key allowed-keys prompt))))
+
 (defun org-mks (table title &optional prompt specials)
   "Select a member of an alist with multiple keys.
 
@@ -280,6 +294,7 @@ is selected, only the bare key is returned."
 	      (insert title "\n\n")
 	      (let ((des-keys nil)
 		    (allowed-keys '("\C-g"))
+		    (tab-alternatives '("\s" "\t" "\r"))
 		    (cursor-type nil))
 		;; Populate allowed keys and descriptions keys
 		;; available with CURRENT selector.
@@ -292,7 +307,10 @@ is selected, only the bare key is returned."
 		      (`(,(and key (pred (string-match re))) ,desc)
 		       (let ((k (match-string 1 key)))
 			 (push k des-keys)
-			 (push k allowed-keys)
+			 ;; Keys ending in tab, space or RET are equivalent.
+			 (if (member k tab-alternatives)
+			     (push "\t" allowed-keys)
+			   (push k allowed-keys))
 			 (insert prefix "[" k "]" "..." "  " desc "..." "\n")))
 		      ;; Usable entry.
 		      (`(,(and key (pred (string-match re))) ,desc . ,_)
@@ -312,12 +330,7 @@ is selected, only the bare key is returned."
 		(goto-char (point-min))
 		(unless (pos-visible-in-window-p (point-max))
 		  (org-fit-window-to-buffer))
-		(message prompt)
-		(let ((pressed (char-to-string (read-char-exclusive))))
-		  (while (not (member pressed allowed-keys))
-		    (message "Invalid key `%s'" pressed) (sit-for 1)
-		    (message prompt)
-		    (setq pressed (char-to-string (read-char-exclusive))))
+		(let ((pressed (org--mks-read-key allowed-keys prompt)))
 		  (setq current (concat current pressed))
 		  (cond
 		   ((equal pressed "\C-g") (user-error "Abort"))
-- 
2.17.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0003-org-org-structure-template-alist-uses-string-keys.patch --]
[-- Type: text/x-patch, Size: 11888 bytes --]

From a53e43e90e53856b4afa0b4bc43e95ddac8de03b Mon Sep 17 00:00:00 2001
From: Rasmus <rasmus@gmx.us>
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                    | 142 ++++++++++++++++++++++++++-------
 testing/lisp/test-org-tempo.el |   9 ++-
 5 files changed, 132 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..8e775e4ea 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -11642,43 +11642,127 @@ 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 space to give a manual 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)))
+    (let ((menu-choice (org--insert-structure-template-mks)))
+      (if (equal (nth 0 menu-choice) "\t")
+	  (read-string "Structure type: ")
+	(nth 1 menu-choice)))))
   (let* ((region? (use-region-p))
 	 (s (if region? (region-beginning) (point)))
 	 (e (copy-marker (if region? (region-end) (point)) t))
@@ -13568,7 +13652,7 @@ headlines matching this string."
 	  ;; compile tags for current headline
 	  (setq tags-list
 		(if org-use-tag-inheritance
-		    (apply 'append (mapcar 'cdr (reverse tags-alist)))
+		    (apply #'append (mapcar 'cdr (reverse tags-alist)))
 		  tags)
 		org-scanner-tags tags-list)
 	  (when org-use-tag-inheritance
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


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0004-org-tempo-Various-improvements.patch --]
[-- Type: text/x-patch, Size: 6486 bytes --]

From 0d2539e97d04c096a2f56a26f15b37066c5b4397 Mon Sep 17 00:00:00 2001
From: Rasmus <rasmus@gmx.us>
Date: Thu, 21 Dec 2017 12:59:36 +0100
Subject: [PATCH 4/6] org-tempo: Various improvements

* lisp/org-tempo.el (org-tempo-keywords-alist): Improve docstring.
(org-tempo--update-maybe):
(org-tempo--keys): New function.
(org-tempo-complete-tag):
(org-tempo-setup):
(org-tempo-add-templates): Use new functions.
(org-tempo-add-block): Smarter position of point.
* testing/lisp/test-org-tempo.el (test-org-tempo/cursor-placement):
 (test-org-tempo/space-first-line): New tests.
* testing/lisp/test-org-tempo.el (test-org-tempo/completion): Adapt
  test to changes.

Org Tempo more carefully checks for new definitions.  When inserting
blocks point will differ depending on whether it is source block.
---
 lisp/org-tempo.el              | 34 +++++++++++++++++++---------
 testing/lisp/test-org-tempo.el | 41 +++++++++++++++++++++++++++++++++-
 2 files changed, 63 insertions(+), 12 deletions(-)

diff --git a/lisp/org-tempo.el b/lisp/org-tempo.el
index a41c99465..a929daf06 100644
--- a/lisp/org-tempo.el
+++ b/lisp/org-tempo.el
@@ -34,7 +34,7 @@
 ;;
 ;; `tempo' can also be used to define more sophisticated keywords
 ;; completions.  See the section "Additional keywords" below for
-;; additional details.
+;; examples.
 ;;
 ;;; Code:
 
@@ -65,7 +65,9 @@ and KEYWORD.  The tempo snippet \"<KEY\" is expand to the KEYWORD
 value.
 
 For example \"<l\" at the beginning of a line is expanded to
-#+latex:"
+\"#+latex:\".
+
+Note: the tempo function for \"#+include\" is defined elsewhere."
   :group 'org-tempo
   :type '(repeat (cons (string :tag "Key")
 		       (string :tag "Keyword")))
@@ -76,23 +78,31 @@ For example \"<l\" at the beginning of a line is expanded to
 ;;; Org Tempo functions and setup.
 
 (defun org-tempo-setup ()
-  (org-tempo-add-templates)
+  (org-tempo--update-maybe)
   (tempo-use-tag-list 'org-tempo-tags)
   (setq-local tempo-match-finder "^ *\\(<[[:word:]]+\\)\\="))
 
+(defun org-tempo--keys ()
+  (mapcar (lambda (pair) (format "<%s" (car pair)))
+	  (append org-structure-template-alist
+		  org-tempo-keywords-alist)))
+
+(defun org-tempo--update-maybe ()
+  "Test if new tags have been added."
+  (unless (cl-every (lambda (key) (assoc key org-tempo-tags))
+		    (org-tempo--keys))
+    (org-tempo-add-templates)))
+
 (defun org-tempo-add-templates ()
   "Update all Org Tempo templates.
 
 Goes through `org-structure-template-alist' and
 `org-tempo-keywords-alist'."
-  (let ((keys (mapcar (lambda (pair) (format "<%c" (car pair)))
-		      (append org-structure-template-alist
-			      org-tempo-keywords-alist))))
+  (let ((keys (org-tempo--keys)))
     ;; Check for duplicated snippet keys and warn if any are found.
     (when (> (length keys) (length (delete-dups keys)))
       (warn
        "Duplicated keys in `org-structure-template-alist' and `org-tempo-keywords-alist'"))
-
     ;; Remove any keys already defined in case they have been updated.
     (setq org-tempo-tags
 	  (cl-remove-if (lambda (tag) (member (car tag) keys)) org-tempo-tags))
@@ -102,9 +112,11 @@ Goes through `org-structure-template-alist' and
 (defun org-tempo-add-block (entry)
   "Add block entry from `org-structure-template-alist'."
   (let* ((key (format "<%s" (car entry)))
-	 (name (cdr entry)))
+	 (name (cdr entry))
+	 (special (member name '("src" "export"))))
     (tempo-define-template (format "org-%s" (replace-regexp-in-string " " "-" name))
-			   `(,(format "#+begin_%s " name) p '> n n
+			   `(,(format "#+begin_%s%s" name (if special " " ""))
+			     ,(when special 'p) '> n '> ,(unless special 'p) n
 			     ,(format "#+end_%s" (car (split-string name " ")))
 			     >)
 			   key
@@ -126,10 +138,12 @@ Goes through `org-structure-template-alist' and
 Unlike to `tempo-complete-tag', do not give a signal if a partial
 completion or no match at all is found.  Return nil if expansion
 didn't succeed."
+  (org-tempo--update-maybe)
   ;; `tempo-complete-tag' returns its SILENT argument when there is no
   ;; completion available at all.
   (not (eq 'fail (tempo-complete-tag 'fail))))
 
+\f
 ;;; Additional keywords
 
 (defun org-tempo--include-file ()
@@ -160,8 +174,6 @@ didn't succeed."
 (add-hook 'org-mode-hook 'org-tempo-setup)
 (add-hook 'org-tab-before-tab-emulation-hook 'org-tempo-complete-tag)
 
-(org-tempo-add-templates)
-
 ;; Enable Org Tempo in all open Org buffers.
 (dolist (b (org-buffer-list 'files))
   (with-current-buffer b (org-tempo-setup)))
diff --git a/testing/lisp/test-org-tempo.el b/testing/lisp/test-org-tempo.el
index 6c751d4f8..1840b35bc 100644
--- a/testing/lisp/test-org-tempo.el
+++ b/testing/lisp/test-org-tempo.el
@@ -41,7 +41,7 @@
 	    (org-tempo-setup)
 	    (call-interactively 'org-cycle)
 	    (buffer-string))
-	  "#+begin_export latex \n\n#+end_export"))
+	  "#+begin_export latex\n\n#+end_export"))
   ;; Tab should work for expansion.
   (should
    (equal (org-test-with-temp-text "<L<point>"
@@ -59,6 +59,45 @@
 	    (buffer-string))
 	 "<k"))
 
+(ert-deftest test-org-tempo/space-first-line ()
+  "Test space on first line after expansion."
+  ;; Normal blocks should have no space at the end of the first line.
+  (should (zerop
+	   (org-test-with-temp-text "<l<point>"
+	     (org-tempo-setup)
+	     (tempo-complete-tag)
+	     (goto-char (point-min))
+	     (end-of-line)
+	     (skip-chars-backward " "))))
+  ;; src blocks, export blocks and keywords should have one space at
+  ;; the end of the first line.
+  (should (cl-every (apply-partially 'eq 1)
+		    (mapcar (lambda (s)
+			      (org-test-with-temp-text (format "<%s<point>" s)
+				(org-tempo-setup)
+				(tempo-complete-tag)
+				(goto-char (point-min))
+				(end-of-line)
+				(abs (skip-chars-backward " "))))
+			    '("s" "E" "L")))))
+
+(ert-deftest test-org-tempo/cursor-placement ()
+  "Test the placement of the cursor after tempo expand"
+  ;; Normal blocks place point "inside" block.
+  (should
+   (eq (org-test-with-temp-text "<l<point>"
+	  (org-tempo-setup)
+	  (tempo-complete-tag)
+	  (point))
+       (length "#\\+begin_export latex\n")))
+  ;; Special block stop at end of #+begin line.
+  (should
+   (eq (org-test-with-temp-text "<s<point>"
+	  (org-tempo-setup)
+	  (tempo-complete-tag)
+	  (point))
+       (length "#\\+begin_src "))))
+
 (ert-deftest test-org-tempo/add-new-templates ()
   "Test that new structures and keywords are added correctly."
   ;; New blocks should be added.
-- 
2.17.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #6: 0005-org-Change-structure-insertion.patch --]
[-- Type: text/x-patch, Size: 5755 bytes --]

From f47e04d4844eb0fda2ae51a3ab6b788781af1a7f Mon Sep 17 00:00:00 2001
From: Rasmus <rasmus@gmx.us>
Date: Thu, 21 Dec 2017 14:37:06 +0100
Subject: [PATCH 5/6] org: Change structure insertion

* lisp/org.el (org-insert-structure-template): Change newline
  behavior.
* testing/lisp/test-org.el (test-org/insert-template): New tests.

`org-insert-structure-template' considers indentation and also insert
newlines between the beginning and the end of the block.
---
 lisp/org.el              | 81 +++++++++++++++++++++++++++-------------
 testing/lisp/test-org.el | 35 +++++++++++++++--
 2 files changed, 87 insertions(+), 29 deletions(-)

diff --git a/lisp/org.el b/lisp/org.el
index 8e775e4ea..363a4ed57 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -11764,33 +11764,62 @@ Otherwise, insert an empty block."
 	  (read-string "Structure type: ")
 	(nth 1 menu-choice)))))
   (let* ((region? (use-region-p))
-	 (s (if region? (region-beginning) (point)))
-	 (e (copy-marker (if region? (region-end) (point)) t))
-	 column)
-    (when (string-match-p
-	   (concat "\\`" (regexp-opt '("example" "export" "src")))
-	   type)
-      (org-escape-code-in-region s e))
-    (goto-char s)
-    (setq column (current-indentation))
-    (beginning-of-line)
-    (indent-to column)
-    (insert (format "#+begin_%s%s\n" type (if (string-equal "src" type) " " "")))
-    (goto-char e)
-    (if (bolp)
-	(progn
-	  (skip-chars-backward " \n\t")
-	  (forward-line))
-      (end-of-line)
+	 (col (current-indentation))
+	 (indent (make-string col ?\s))
+	 (special? (string-match-p "\\(src\\|export\\)\\'" type))
+	 (region-string (and region?
+			     (buffer-substring (region-beginning)
+					       (region-end))))
+	 (region-end-blank (and region?
+				(save-excursion
+				  (goto-char (region-end))
+				  (when (looking-at "[ \t]*$")
+				    (replace-match "")
+				    t))))
+	 s)
+    (when region? (delete-region (region-beginning) (region-end)))
+    (unless (save-excursion (skip-chars-backward "[ \t]") (bolp))
       (insert "\n"))
-    (indent-to column)
-    (insert (format "#+end_%s\n"
-		    (car (split-string type))))
-    (when (or (not region?)
-	      (string-match-p "src\\|\\`export\\'" type))
-      (goto-char s)
-      (end-of-line))
-    (set-marker e nil)))
+    (beginning-of-line)
+    (save-excursion
+      (insert
+       (with-temp-buffer
+	 (when region?
+	   (insert region-string "\n")
+	   (when (string-match-p
+		  (concat "\\`" (regexp-opt '("example" "export" "src")))
+		  type)
+	     (org-escape-code-in-region (point-min) (point-max))))
+	 (goto-char (point-min))
+	 ;; Delete trailing white-lines.
+	 (when region?
+	   (while (looking-at-p "^[ \t]*$")
+	     (delete-region (line-beginning-position)
+			    (line-beginning-position 2))))
+	 (save-excursion
+	   (while (not (eobp))
+	     (unless (looking-at-p indent)
+	       (insert indent))
+	     (forward-line)))
+	 (insert
+	  indent
+	  (format "#+begin_%s%s\n" type (if special? " " "")))
+	 (unless region? (indent-to col))
+	 (setq s (point))
+	 (goto-char (point-max))
+	 (skip-chars-backward "[ \t\n]" s)
+	 (delete-region (line-end-position) (point-max))
+	 (insert "\n" indent
+		 (format "#+end_%s" (car (split-string type)))
+		 (if region-end-blank "" "\n"))
+	 (buffer-substring (point-min) (point))))
+      (when (and (eobp) (not (bolp))) (insert "\n")))
+    (cond (special?
+	   (end-of-line))
+	  (t
+	   (forward-line)
+	   (skip-chars-forward "[ \t]*")))))
+
 
 ;;;; TODO, DEADLINE, Comments
 
diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el
index 8d8b36f86..5ab35f7de 100644
--- a/testing/lisp/test-org.el
+++ b/testing/lisp/test-org.el
@@ -4047,17 +4047,35 @@ Text.
   "Test `org-insert-structure-template'."
   ;; Test in empty buffer.
   (should
-   (string= "#+begin_foo\n#+end_foo\n"
+   (string= "#+begin_foo\n\n#+end_foo\n"
 	    (org-test-with-temp-text ""
 	      (org-insert-structure-template "foo")
 	      (buffer-string))))
   ;; Test with multiple lines in buffer.
   (should
-   (string= "#+begin_foo\nI'm a paragraph\n#+end_foo\n\nI'm a second paragraph"
+   (string= "#+begin_foo\nI'm a paragraph\n#+end_foo\nI'm a second paragraph"
 	    (org-test-with-temp-text "I'm a paragraph\n\nI'm a second paragraph"
 	      (org-mark-element)
 	      (org-insert-structure-template "foo")
 	      (buffer-string))))
+  ;; Mark only the current line.
+  (should
+   (string= "#+begin_foo\nI'm a paragraph\n#+end_foo\n\nI'm a second paragraph"
+	    (org-test-with-temp-text "I'm a paragraph\n\nI'm a second paragraph"
+	      (set-mark (point-min))
+	      (end-of-line)
+	      (activate-mark)
+	      (org-insert-structure-template "foo")
+	      (buffer-string))))
+  ;; Middle of paragraph
+  (should
+   (string= "p1\n#+begin_foo\np2\n#+end_foo\np3"
+	    (org-test-with-temp-text "p1\n<point>p2\np3"
+	      (set-mark (line-beginning-position))
+	      (end-of-line)
+	      (activate-mark)
+	      (org-insert-structure-template "foo")
+	      (buffer-string))))
   ;; Test with text in buffer, no region, no final newline.
   (should
    (string= "#+begin_foo\nI'm a paragraph.\n#+end_foo\n"
@@ -4086,7 +4104,18 @@ Text.
 	    (org-test-with-temp-text "  This is a paragraph"
 	      (org-mark-element)
 	      (org-insert-structure-template "foo")
-	      (buffer-string)))))
+	      (buffer-string))))
+  ;; Test point location.
+  (should
+   (eq (length "#\\+begin_foo\n")
+       (org-test-with-temp-text ""
+	 (org-insert-structure-template "foo")
+	 (point))))
+  (should
+   (eq (length "#\\+begin_src ")
+       (org-test-with-temp-text ""
+	 (org-insert-structure-template "src")
+	 (point)))))
 
 (ert-deftest test-org/previous-block ()
   "Test `org-previous-block' specifications."
-- 
2.17.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #7: 0006-org-Change-org-insert-structure-template-to-C-c-C.patch --]
[-- Type: text/x-patch, Size: 1882 bytes --]

From 5ff19d87a454db1e1a0c0491b31ee29ace18573f Mon Sep 17 00:00:00 2001
From: Rasmus <rasmus@gmx.us>
Date: Sat, 7 Apr 2018 20:16:56 +0200
Subject: [PATCH 6/6] org: Change org-insert-structure-template to C-c C-,

* lisp/org.el (org-mode-map):
* doc/org-manual.org (With): Change keybinding of
  org-insert-structure-template.

See the thread titled "Poll: new keybinding for
org-insert-structure-template?" in December 2017 for details.
---
 doc/org-manual.org | 2 +-
 lisp/org.el        | 3 +--
 2 files changed, 2 insertions(+), 3 deletions(-)

diff --git a/doc/org-manual.org b/doc/org-manual.org
index 82639445c..fc53957bd 100644
--- a/doc/org-manual.org
+++ b/doc/org-manual.org
@@ -18170,7 +18170,7 @@ With just a few keystrokes, it is possible to insert empty structural
 blocks, such as =#+BEGIN_SRC= ... =#+END_SRC=, or to wrap existing
 text in such a block.
 
-- {{{kbd(C-c C-x w)}}} (~org-insert-structure-template~) ::
+- {{{kbd(C-c C-,)}}} (~org-insert-structure-template~) ::
 
      Prompt for a type of block structure, and insert the block at
      point.  If the region is active, it is wrapped in the block.
diff --git a/lisp/org.el b/lisp/org.el
index 363a4ed57..db14352d3 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -19159,8 +19159,7 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names."
 (org-defkey org-mode-map (kbd "C-c C-x E") #'org-inc-effort)
 (org-defkey org-mode-map (kbd "C-c C-x o") #'org-toggle-ordered-property)
 (org-defkey org-mode-map (kbd "C-c C-x i") #'org-columns-insert-dblock)
-(org-defkey org-mode-map (kbd "C-c C-x w") #'org-insert-structure-template)
-
+(org-defkey org-mode-map (kbd "C-c C-,") #'org-insert-structure-template)
 (org-defkey org-mode-map (kbd "C-c C-x .") #'org-timer)
 (org-defkey org-mode-map (kbd "C-c C-x -") #'org-timer-item)
 (org-defkey org-mode-map (kbd "C-c C-x 0") #'org-timer-start)
-- 
2.17.0


^ permalink raw reply	[flat|nested] 4+ messages in thread

* Re: [patch] Improved block insertion
  2018-04-07 19:01 [patch] Improved block insertion Rasmus
@ 2018-04-08  7:55 ` Nicolas Goaziou
  2018-04-08 10:59   ` Rasmus
  0 siblings, 1 reply; 4+ messages in thread
From: Nicolas Goaziou @ 2018-04-08  7:55 UTC (permalink / raw)
  To: Rasmus; +Cc: emacs-orgmode

Hello,

Rasmus <rasmus@gmx.us> writes:

> These patches improve the block insertion mechanisms using both the
> keyboard binding and org-tempo.

Thank you. Some quick comments follow.

> Patch 6 changes the key binding of blocks to "C-c C-," as discussed in
> December 2017.  Let me know if this key is OK and if the old key should
> still be kept.

I don't think the old key-binding should be kept.

> +(defun org--mks-read-key (allowed-keys prompt)
> +  "Read a key and ensure it is a member of ALLOWED-KEYS.
> +
> +Tab, space and RET are treated equivalently."

Nitpick: No need for a blank line in the docstring.

Also: TAB, SPC and RET are ...

> +  (let* ((char (read-char-exclusive prompt))
> +	 (key (char-to-string
> +	       (cond ((memq char '(?\s ?\t ?\r)) ?\t)
> +		     (t char)))))

Suggestion:

  (key (pcase (read-char-exclusive prompt)
        ((or ?\s ?\t ?\r) ?\t)
        (char char)))

> +    (let ((menu-choice (org--insert-structure-template-mks)))
> +      (if (equal (nth 0 menu-choice) "\t")
> +	  (read-string "Structure type: ")
> +	(nth 1 menu-choice)))))

(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))
> @@ -13568,7 +13652,7 @@ headlines matching this string."
>  	  ;; compile tags for current headline
>  	  (setq tags-list
>  		(if org-use-tag-inheritance
> -		    (apply 'append (mapcar 'cdr (reverse tags-alist)))
> +		    (apply #'append (mapcar 'cdr (reverse tags-alist)))

Nitpick: (mapcar #'cdr ...)

> +(defun org-tempo--keys ()
> +  (mapcar (lambda (pair) (format "<%s" (car pair)))
> +	  (append org-structure-template-alist
> +		  org-tempo-keywords-alist)))

Missing docstring.

> +(defun org-tempo--update-maybe ()
> +  "Test if new tags have been added."

I think you should clarify the docstring. It doesn't only test if new
tags have been added, but it also add templates.

Regards,

-- 
Nicolas Goaziou

^ permalink raw reply	[flat|nested] 4+ messages in thread

* Re: [patch] Improved block insertion
  2018-04-08  7:55 ` Nicolas Goaziou
@ 2018-04-08 10:59   ` Rasmus
  2018-04-08 13:22     ` Nicolas Goaziou
  0 siblings, 1 reply; 4+ messages in thread
From: Rasmus @ 2018-04-08 10:59 UTC (permalink / raw)
  To: emacs-orgmode

[-- Attachment #1: Type: text/plain, Size: 849 bytes --]

Hi,

Thanks for the comments!

I have fixed up the patches.  

> I don't think the old key-binding should be kept.

OK.

> Suggestion:
>
>   (key (pcase (read-char-exclusive prompt)
>         ((or ?\s ?\t ?\r) ?\t)
>         (char char)))


Ha, actually I used pcase at first but then changed it to something more
simple.  Are there any performance issues with pcase or can it be used
unconditionally?

>> +    (let ((menu-choice (org--insert-structure-template-mks)))
>> +      (if (equal (nth 0 menu-choice) "\t")
>> +	  (read-string "Structure type: ")
>> +	(nth 1 menu-choice)))))
>
> (pcase (org--insert-structure-template-mks)
>   (`("\t" . ,_) (read-string "Structure type: "))
>   (`(,_ ,choice . ,_) choice))

Thanks, that’s nice. 

Any worries about pushing the patches now?

Rasmus

-- 
I hear there's rumors on the, uh, Internets. . .

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-org-macs-Move-org-mks-from-org-capture-to-org-macs.patch --]
[-- Type: text/x-patch, Size: 8534 bytes --]

From 06ab656f4250ee7a765550f353743056aed31c8d Mon Sep 17 00:00:00 2001
From: Rasmus <rasmus@gmx.us>
Date: Sat, 7 Apr 2018 12:58:51 +0200
Subject: [PATCH 1/6] org-macs: Move org-mks from org-capture to org-macs

* lisp/org-capture.el (org-mks): Moved to org-macs.el.
* lisp/org-macs.el (org-mks): Added from org-capture.el.

The move is being done to accommodate the usage of org-mks in other
Org libraries.
---
 lisp/org-capture.el | 88 ---------------------------------------------
 lisp/org-macs.el    | 87 ++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 87 insertions(+), 88 deletions(-)

diff --git a/lisp/org-capture.el b/lisp/org-capture.el
index fd4706538..630166c21 100644
--- a/lisp/org-capture.el
+++ b/lisp/org-capture.el
@@ -1479,94 +1479,6 @@ Use PREFIX as a prefix for the name of the indirect buffer."
   (unless (org-kill-is-subtree-p tree)
     (error "Template is not a valid Org entry or tree")))
 
-(defun org-mks (table title &optional prompt specials)
-  "Select a member of an alist with multiple keys.
-
-TABLE is the alist which should contain entries where the car is a string.
-There should be two types of entries.
-
-1. prefix descriptions like (\"a\" \"Description\")
-   This indicates that `a' is a prefix key for multi-letter selection, and
-   that there are entries following with keys like \"ab\", \"ax\"...
-
-2. Select-able members must have more than two elements, with the first
-   being the string of keys that lead to selecting it, and the second a
-   short description string of the item.
-
-The command will then make a temporary buffer listing all entries
-that can be selected with a single key, and all the single key
-prefixes.  When you press the key for a single-letter entry, it is selected.
-When you press a prefix key, the commands (and maybe further prefixes)
-under this key will be shown and offered for selection.
-
-TITLE will be placed over the selection in the temporary buffer,
-PROMPT will be used when prompting for a key.  SPECIAL is an
-alist with (\"key\" \"description\") entries.  When one of these
-is selected, only the bare key is returned."
-  (save-window-excursion
-    (let ((inhibit-quit t)
-	  (buffer (org-switch-to-buffer-other-window "*Org Select*"))
-	  (prompt (or prompt "Select: "))
-	  current)
-      (unwind-protect
-	  (catch 'exit
-	    (while t
-	      (erase-buffer)
-	      (insert title "\n\n")
-	      (let ((des-keys nil)
-		    (allowed-keys '("\C-g"))
-		    (cursor-type nil))
-		;; Populate allowed keys and descriptions keys
-		;; available with CURRENT selector.
-		(let ((re (format "\\`%s\\(.\\)\\'"
-				  (if current (regexp-quote current) "")))
-		      (prefix (if current (concat current " ") "")))
-		  (dolist (entry table)
-		    (pcase entry
-		      ;; Description.
-		      (`(,(and key (pred (string-match re))) ,desc)
-		       (let ((k (match-string 1 key)))
-			 (push k des-keys)
-			 (push k allowed-keys)
-			 (insert prefix "[" k "]" "..." "  " desc "..." "\n")))
-		      ;; Usable entry.
-		      (`(,(and key (pred (string-match re))) ,desc . ,_)
-		       (let ((k (match-string 1 key)))
-			 (insert prefix "[" k "]" "     " desc "\n")
-			 (push k allowed-keys)))
-		      (_ nil))))
-		;; Insert special entries, if any.
-		(when specials
-		  (insert "----------------------------------------------------\
----------------------------\n")
-		  (pcase-dolist (`(,key ,description) specials)
-		    (insert (format "[%s]     %s\n" key description))
-		    (push key allowed-keys)))
-		;; Display UI and let user select an entry or
-		;; a sub-level prefix.
-		(goto-char (point-min))
-		(unless (pos-visible-in-window-p (point-max))
-		  (org-fit-window-to-buffer))
-		(message prompt)
-		(let ((pressed (char-to-string (read-char-exclusive))))
-		  (while (not (member pressed allowed-keys))
-		    (message "Invalid key `%s'" pressed) (sit-for 1)
-		    (message prompt)
-		    (setq pressed (char-to-string (read-char-exclusive))))
-		  (setq current (concat current pressed))
-		  (cond
-		   ((equal pressed "\C-g") (user-error "Abort"))
-		   ;; Selection is a prefix: open a new menu.
-		   ((member pressed des-keys))
-		   ;; Selection matches an association: return it.
-		   ((let ((entry (assoc current table)))
-		      (and entry (throw 'exit entry))))
-		   ;; Selection matches a special entry: return the
-		   ;; selection prefix.
-		   ((assoc current specials) (throw 'exit current))
-		   (t (error "No entry available")))))))
-	(when buffer (kill-buffer buffer))))))
-
 ;;; The template code
 (defun org-capture-select-template (&optional keys)
   "Select a capture template.
diff --git a/lisp/org-macs.el b/lisp/org-macs.el
index d4531c25a..007882b79 100644
--- a/lisp/org-macs.el
+++ b/lisp/org-macs.el
@@ -244,6 +244,93 @@ error when the user input is empty."
       'org-time-stamp-inactive)
     (apply #'completing-read args)))
 
+(defun org-mks (table title &optional prompt specials)
+  "Select a member of an alist with multiple keys.
+
+TABLE is the alist which should contain entries where the car is a string.
+There should be two types of entries.
+
+1. prefix descriptions like (\"a\" \"Description\")
+   This indicates that `a' is a prefix key for multi-letter selection, and
+   that there are entries following with keys like \"ab\", \"ax\"...
+
+2. Select-able members must have more than two elements, with the first
+   being the string of keys that lead to selecting it, and the second a
+   short description string of the item.
+
+The command will then make a temporary buffer listing all entries
+that can be selected with a single key, and all the single key
+prefixes.  When you press the key for a single-letter entry, it is selected.
+When you press a prefix key, the commands (and maybe further prefixes)
+under this key will be shown and offered for selection.
+
+TITLE will be placed over the selection in the temporary buffer,
+PROMPT will be used when prompting for a key.  SPECIAL is an
+alist with (\"key\" \"description\") entries.  When one of these
+is selected, only the bare key is returned."
+  (save-window-excursion
+    (let ((inhibit-quit t)
+	  (buffer (org-switch-to-buffer-other-window "*Org Select*"))
+	  (prompt (or prompt "Select: "))
+	  current)
+      (unwind-protect
+	  (catch 'exit
+	    (while t
+	      (erase-buffer)
+	      (insert title "\n\n")
+	      (let ((des-keys nil)
+		    (allowed-keys '("\C-g"))
+		    (cursor-type nil))
+		;; Populate allowed keys and descriptions keys
+		;; available with CURRENT selector.
+		(let ((re (format "\\`%s\\(.\\)\\'"
+				  (if current (regexp-quote current) "")))
+		      (prefix (if current (concat current " ") "")))
+		  (dolist (entry table)
+		    (pcase entry
+		      ;; Description.
+		      (`(,(and key (pred (string-match re))) ,desc)
+		       (let ((k (match-string 1 key)))
+			 (push k des-keys)
+			 (push k allowed-keys)
+			 (insert prefix "[" k "]" "..." "  " desc "..." "\n")))
+		      ;; Usable entry.
+		      (`(,(and key (pred (string-match re))) ,desc . ,_)
+		       (let ((k (match-string 1 key)))
+			 (insert prefix "[" k "]" "     " desc "\n")
+			 (push k allowed-keys)))
+		      (_ nil))))
+		;; Insert special entries, if any.
+		(when specials
+		  (insert "----------------------------------------------------\
+---------------------------\n")
+		  (pcase-dolist (`(,key ,description) specials)
+		    (insert (format "[%s]     %s\n" key description))
+		    (push key allowed-keys)))
+		;; Display UI and let user select an entry or
+		;; a sub-level prefix.
+		(goto-char (point-min))
+		(unless (pos-visible-in-window-p (point-max))
+		  (org-fit-window-to-buffer))
+		(message prompt)
+		(let ((pressed (char-to-string (read-char-exclusive))))
+		  (while (not (member pressed allowed-keys))
+		    (message "Invalid key `%s'" pressed) (sit-for 1)
+		    (message prompt)
+		    (setq pressed (char-to-string (read-char-exclusive))))
+		  (setq current (concat current pressed))
+		  (cond
+		   ((equal pressed "\C-g") (user-error "Abort"))
+		   ;; Selection is a prefix: open a new menu.
+		   ((member pressed des-keys))
+		   ;; Selection matches an association: return it.
+		   ((let ((entry (assoc current table)))
+		      (and entry (throw 'exit entry))))
+		   ;; Selection matches a special entry: return the
+		   ;; selection prefix.
+		   ((assoc current specials) (throw 'exit current))
+		   (t (error "No entry available")))))))
+	(when buffer (kill-buffer buffer))))))
 
 \f
 ;;; Logic
-- 
2.17.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-org-macs-Make-tab-space-and-RET-equivalent-in-org-mk.patch --]
[-- Type: text/x-patch, Size: 2704 bytes --]

From ac4d5fe1b3c782011ef2a3d78cbd44b042da7c12 Mon Sep 17 00:00:00 2001
From: Rasmus <rasmus@gmx.us>
Date: Sat, 7 Apr 2018 14:24:36 +0200
Subject: [PATCH 2/6] org-macs: Make tab, space and RET equivalent in org-mks

* lisp/org-macs.el (org--mks-read-key): New function.
  (org-mks): Use new function and make space, tab and RET equivalent.
---
 lisp/org-macs.el | 26 +++++++++++++++++++-------
 1 file changed, 19 insertions(+), 7 deletions(-)

diff --git a/lisp/org-macs.el b/lisp/org-macs.el
index 007882b79..78c841453 100644
--- a/lisp/org-macs.el
+++ b/lisp/org-macs.el
@@ -244,6 +244,19 @@ error when the user input is empty."
       'org-time-stamp-inactive)
     (apply #'completing-read args)))
 
+(defun org--mks-read-key (allowed-keys prompt)
+  "Read a key and ensure it is a member of ALLOWED-KEYS.
+TAB, SPC and RET are treated equivalently."
+  (let* ((key (char-to-string
+	       (pcase (read-char-exclusive prompt)
+		 ((or ?\s ?\t ?\r) ?\t)
+		 (char char)))))
+    (if (member key allowed-keys)
+        key
+      (message "Invalid key: `%s'" key)
+      (sit-for 1)
+      (org--mks-read-key allowed-keys prompt))))
+
 (defun org-mks (table title &optional prompt specials)
   "Select a member of an alist with multiple keys.
 
@@ -280,6 +293,7 @@ is selected, only the bare key is returned."
 	      (insert title "\n\n")
 	      (let ((des-keys nil)
 		    (allowed-keys '("\C-g"))
+		    (tab-alternatives '("\s" "\t" "\r"))
 		    (cursor-type nil))
 		;; Populate allowed keys and descriptions keys
 		;; available with CURRENT selector.
@@ -292,7 +306,10 @@ is selected, only the bare key is returned."
 		      (`(,(and key (pred (string-match re))) ,desc)
 		       (let ((k (match-string 1 key)))
 			 (push k des-keys)
-			 (push k allowed-keys)
+			 ;; Keys ending in tab, space or RET are equivalent.
+			 (if (member k tab-alternatives)
+			     (push "\t" allowed-keys)
+			   (push k allowed-keys))
 			 (insert prefix "[" k "]" "..." "  " desc "..." "\n")))
 		      ;; Usable entry.
 		      (`(,(and key (pred (string-match re))) ,desc . ,_)
@@ -312,12 +329,7 @@ is selected, only the bare key is returned."
 		(goto-char (point-min))
 		(unless (pos-visible-in-window-p (point-max))
 		  (org-fit-window-to-buffer))
-		(message prompt)
-		(let ((pressed (char-to-string (read-char-exclusive))))
-		  (while (not (member pressed allowed-keys))
-		    (message "Invalid key `%s'" pressed) (sit-for 1)
-		    (message prompt)
-		    (setq pressed (char-to-string (read-char-exclusive))))
+		(let ((pressed (org--mks-read-key allowed-keys prompt)))
 		  (setq current (concat current pressed))
 		  (cond
 		   ((equal pressed "\C-g") (user-error "Abort"))
-- 
2.17.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0003-org-org-structure-template-alist-uses-string-keys.patch --]
[-- Type: text/x-patch, Size: 11509 bytes --]

From b56df737b7392845c6e00d4cc52801e64c105f8b Mon Sep 17 00:00:00 2001
From: Rasmus <rasmus@gmx.us>
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


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0004-org-tempo-Various-improvements.patch --]
[-- Type: text/x-patch, Size: 6719 bytes --]

From e5f6cb6c8b6c26772a92410a657b6986842dd23e Mon Sep 17 00:00:00 2001
From: Rasmus <rasmus@gmx.us>
Date: Thu, 21 Dec 2017 12:59:36 +0100
Subject: [PATCH 4/6] org-tempo: Various improvements

* lisp/org-tempo.el (org-tempo-keywords-alist): Improve docstring.
(org-tempo--update-maybe):
(org-tempo--keys): New function.
(org-tempo-complete-tag):
(org-tempo-setup):
(org-tempo-add-templates): Use new functions.
(org-tempo-add-block): Smarter position of point.
* testing/lisp/test-org-tempo.el (test-org-tempo/cursor-placement):
 (test-org-tempo/space-first-line): New tests.
* testing/lisp/test-org-tempo.el (test-org-tempo/completion): Adapt
  test to changes.

Org Tempo more carefully checks for new definitions.  When inserting
blocks point will differ depending on whether it is source block.
---
 lisp/org-tempo.el              | 38 ++++++++++++++++++++++---------
 testing/lisp/test-org-tempo.el | 41 +++++++++++++++++++++++++++++++++-
 2 files changed, 67 insertions(+), 12 deletions(-)

diff --git a/lisp/org-tempo.el b/lisp/org-tempo.el
index a41c99465..e1268b893 100644
--- a/lisp/org-tempo.el
+++ b/lisp/org-tempo.el
@@ -34,7 +34,7 @@
 ;;
 ;; `tempo' can also be used to define more sophisticated keywords
 ;; completions.  See the section "Additional keywords" below for
-;; additional details.
+;; examples.
 ;;
 ;;; Code:
 
@@ -65,7 +65,9 @@ and KEYWORD.  The tempo snippet \"<KEY\" is expand to the KEYWORD
 value.
 
 For example \"<l\" at the beginning of a line is expanded to
-#+latex:"
+\"#+latex:\".
+
+Note: the tempo function for \"#+include\" is defined elsewhere."
   :group 'org-tempo
   :type '(repeat (cons (string :tag "Key")
 		       (string :tag "Keyword")))
@@ -76,23 +78,35 @@ For example \"<l\" at the beginning of a line is expanded to
 ;;; Org Tempo functions and setup.
 
 (defun org-tempo-setup ()
-  (org-tempo-add-templates)
+  (org-tempo--update-maybe)
   (tempo-use-tag-list 'org-tempo-tags)
   (setq-local tempo-match-finder "^ *\\(<[[:word:]]+\\)\\="))
 
+(defun org-tempo--keys ()
+  "Return a list of all Org Tempo expansion strings, like \"<s\"."
+  (mapcar (lambda (pair) (format "<%s" (car pair)))
+	  (append org-structure-template-alist
+		  org-tempo-keywords-alist)))
+
+(defun org-tempo--update-maybe ()
+  "Check and add new Org Tempo templates if necessary.
+In particular, if new entries were added to
+`org-structure-template-alist' or `org-tempo-keywords-alist', new
+Tempo templates will be added."
+  (unless (cl-every (lambda (key) (assoc key org-tempo-tags))
+		    (org-tempo--keys))
+    (org-tempo-add-templates)))
+
 (defun org-tempo-add-templates ()
   "Update all Org Tempo templates.
 
 Goes through `org-structure-template-alist' and
 `org-tempo-keywords-alist'."
-  (let ((keys (mapcar (lambda (pair) (format "<%c" (car pair)))
-		      (append org-structure-template-alist
-			      org-tempo-keywords-alist))))
+  (let ((keys (org-tempo--keys)))
     ;; Check for duplicated snippet keys and warn if any are found.
     (when (> (length keys) (length (delete-dups keys)))
       (warn
        "Duplicated keys in `org-structure-template-alist' and `org-tempo-keywords-alist'"))
-
     ;; Remove any keys already defined in case they have been updated.
     (setq org-tempo-tags
 	  (cl-remove-if (lambda (tag) (member (car tag) keys)) org-tempo-tags))
@@ -102,9 +116,11 @@ Goes through `org-structure-template-alist' and
 (defun org-tempo-add-block (entry)
   "Add block entry from `org-structure-template-alist'."
   (let* ((key (format "<%s" (car entry)))
-	 (name (cdr entry)))
+	 (name (cdr entry))
+	 (special (member name '("src" "export"))))
     (tempo-define-template (format "org-%s" (replace-regexp-in-string " " "-" name))
-			   `(,(format "#+begin_%s " name) p '> n n
+			   `(,(format "#+begin_%s%s" name (if special " " ""))
+			     ,(when special 'p) '> n '> ,(unless special 'p) n
 			     ,(format "#+end_%s" (car (split-string name " ")))
 			     >)
 			   key
@@ -126,10 +142,12 @@ Goes through `org-structure-template-alist' and
 Unlike to `tempo-complete-tag', do not give a signal if a partial
 completion or no match at all is found.  Return nil if expansion
 didn't succeed."
+  (org-tempo--update-maybe)
   ;; `tempo-complete-tag' returns its SILENT argument when there is no
   ;; completion available at all.
   (not (eq 'fail (tempo-complete-tag 'fail))))
 
+\f
 ;;; Additional keywords
 
 (defun org-tempo--include-file ()
@@ -160,8 +178,6 @@ didn't succeed."
 (add-hook 'org-mode-hook 'org-tempo-setup)
 (add-hook 'org-tab-before-tab-emulation-hook 'org-tempo-complete-tag)
 
-(org-tempo-add-templates)
-
 ;; Enable Org Tempo in all open Org buffers.
 (dolist (b (org-buffer-list 'files))
   (with-current-buffer b (org-tempo-setup)))
diff --git a/testing/lisp/test-org-tempo.el b/testing/lisp/test-org-tempo.el
index 6c751d4f8..1840b35bc 100644
--- a/testing/lisp/test-org-tempo.el
+++ b/testing/lisp/test-org-tempo.el
@@ -41,7 +41,7 @@
 	    (org-tempo-setup)
 	    (call-interactively 'org-cycle)
 	    (buffer-string))
-	  "#+begin_export latex \n\n#+end_export"))
+	  "#+begin_export latex\n\n#+end_export"))
   ;; Tab should work for expansion.
   (should
    (equal (org-test-with-temp-text "<L<point>"
@@ -59,6 +59,45 @@
 	    (buffer-string))
 	 "<k"))
 
+(ert-deftest test-org-tempo/space-first-line ()
+  "Test space on first line after expansion."
+  ;; Normal blocks should have no space at the end of the first line.
+  (should (zerop
+	   (org-test-with-temp-text "<l<point>"
+	     (org-tempo-setup)
+	     (tempo-complete-tag)
+	     (goto-char (point-min))
+	     (end-of-line)
+	     (skip-chars-backward " "))))
+  ;; src blocks, export blocks and keywords should have one space at
+  ;; the end of the first line.
+  (should (cl-every (apply-partially 'eq 1)
+		    (mapcar (lambda (s)
+			      (org-test-with-temp-text (format "<%s<point>" s)
+				(org-tempo-setup)
+				(tempo-complete-tag)
+				(goto-char (point-min))
+				(end-of-line)
+				(abs (skip-chars-backward " "))))
+			    '("s" "E" "L")))))
+
+(ert-deftest test-org-tempo/cursor-placement ()
+  "Test the placement of the cursor after tempo expand"
+  ;; Normal blocks place point "inside" block.
+  (should
+   (eq (org-test-with-temp-text "<l<point>"
+	  (org-tempo-setup)
+	  (tempo-complete-tag)
+	  (point))
+       (length "#\\+begin_export latex\n")))
+  ;; Special block stop at end of #+begin line.
+  (should
+   (eq (org-test-with-temp-text "<s<point>"
+	  (org-tempo-setup)
+	  (tempo-complete-tag)
+	  (point))
+       (length "#\\+begin_src "))))
+
 (ert-deftest test-org-tempo/add-new-templates ()
   "Test that new structures and keywords are added correctly."
   ;; New blocks should be added.
-- 
2.17.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #6: 0005-org-Change-structure-insertion.patch --]
[-- Type: text/x-patch, Size: 5770 bytes --]

From d04c20deece7b1d0eb40f7b8365a87484f26db6a Mon Sep 17 00:00:00 2001
From: Rasmus <rasmus@gmx.us>
Date: Thu, 21 Dec 2017 14:37:06 +0100
Subject: [PATCH 5/6] org: Change structure insertion

* lisp/org.el (org-insert-structure-template): Change newline
  behavior.
* testing/lisp/test-org.el (test-org/insert-template): New tests.

`org-insert-structure-template' considers indentation and also insert
newlines between the beginning and the end of the block.
---
 lisp/org.el              | 81 +++++++++++++++++++++++++++-------------
 testing/lisp/test-org.el | 35 +++++++++++++++--
 2 files changed, 87 insertions(+), 29 deletions(-)

diff --git a/lisp/org.el b/lisp/org.el
index bcf8b5986..4fd5dce51 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -11762,33 +11762,62 @@ insert an empty block."
 	   (`("\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))
-	 column)
-    (when (string-match-p
-	   (concat "\\`" (regexp-opt '("example" "export" "src")))
-	   type)
-      (org-escape-code-in-region s e))
-    (goto-char s)
-    (setq column (current-indentation))
-    (beginning-of-line)
-    (indent-to column)
-    (insert (format "#+begin_%s%s\n" type (if (string-equal "src" type) " " "")))
-    (goto-char e)
-    (if (bolp)
-	(progn
-	  (skip-chars-backward " \n\t")
-	  (forward-line))
-      (end-of-line)
+	 (col (current-indentation))
+	 (indent (make-string col ?\s))
+	 (special? (string-match-p "\\(src\\|export\\)\\'" type))
+	 (region-string (and region?
+			     (buffer-substring (region-beginning)
+					       (region-end))))
+	 (region-end-blank (and region?
+				(save-excursion
+				  (goto-char (region-end))
+				  (when (looking-at "[ \t]*$")
+				    (replace-match "")
+				    t))))
+	 s)
+    (when region? (delete-region (region-beginning) (region-end)))
+    (unless (save-excursion (skip-chars-backward "[ \t]") (bolp))
       (insert "\n"))
-    (indent-to column)
-    (insert (format "#+end_%s\n"
-		    (car (split-string type))))
-    (when (or (not region?)
-	      (string-match-p "src\\|\\`export\\'" type))
-      (goto-char s)
-      (end-of-line))
-    (set-marker e nil)))
+    (beginning-of-line)
+    (save-excursion
+      (insert
+       (with-temp-buffer
+	 (when region?
+	   (insert region-string "\n")
+	   (when (string-match-p
+		  (concat "\\`" (regexp-opt '("example" "export" "src")))
+		  type)
+	     (org-escape-code-in-region (point-min) (point-max))))
+	 (goto-char (point-min))
+	 ;; Delete trailing white-lines.
+	 (when region?
+	   (while (looking-at-p "^[ \t]*$")
+	     (delete-region (line-beginning-position)
+			    (line-beginning-position 2))))
+	 (save-excursion
+	   (while (not (eobp))
+	     (unless (looking-at-p indent)
+	       (insert indent))
+	     (forward-line)))
+	 (insert
+	  indent
+	  (format "#+begin_%s%s\n" type (if special? " " "")))
+	 (unless region? (indent-to col))
+	 (setq s (point))
+	 (goto-char (point-max))
+	 (skip-chars-backward "[ \t\n]" s)
+	 (delete-region (line-end-position) (point-max))
+	 (insert "\n" indent
+		 (format "#+end_%s" (car (split-string type)))
+		 (if region-end-blank "" "\n"))
+	 (buffer-substring (point-min) (point))))
+      (when (and (eobp) (not (bolp))) (insert "\n")))
+    (cond (special?
+	   (end-of-line))
+	  (t
+	   (forward-line)
+	   (skip-chars-forward "[ \t]*")))))
+
 
 ;;;; TODO, DEADLINE, Comments
 
diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el
index 8d8b36f86..5ab35f7de 100644
--- a/testing/lisp/test-org.el
+++ b/testing/lisp/test-org.el
@@ -4047,17 +4047,35 @@ Text.
   "Test `org-insert-structure-template'."
   ;; Test in empty buffer.
   (should
-   (string= "#+begin_foo\n#+end_foo\n"
+   (string= "#+begin_foo\n\n#+end_foo\n"
 	    (org-test-with-temp-text ""
 	      (org-insert-structure-template "foo")
 	      (buffer-string))))
   ;; Test with multiple lines in buffer.
   (should
-   (string= "#+begin_foo\nI'm a paragraph\n#+end_foo\n\nI'm a second paragraph"
+   (string= "#+begin_foo\nI'm a paragraph\n#+end_foo\nI'm a second paragraph"
 	    (org-test-with-temp-text "I'm a paragraph\n\nI'm a second paragraph"
 	      (org-mark-element)
 	      (org-insert-structure-template "foo")
 	      (buffer-string))))
+  ;; Mark only the current line.
+  (should
+   (string= "#+begin_foo\nI'm a paragraph\n#+end_foo\n\nI'm a second paragraph"
+	    (org-test-with-temp-text "I'm a paragraph\n\nI'm a second paragraph"
+	      (set-mark (point-min))
+	      (end-of-line)
+	      (activate-mark)
+	      (org-insert-structure-template "foo")
+	      (buffer-string))))
+  ;; Middle of paragraph
+  (should
+   (string= "p1\n#+begin_foo\np2\n#+end_foo\np3"
+	    (org-test-with-temp-text "p1\n<point>p2\np3"
+	      (set-mark (line-beginning-position))
+	      (end-of-line)
+	      (activate-mark)
+	      (org-insert-structure-template "foo")
+	      (buffer-string))))
   ;; Test with text in buffer, no region, no final newline.
   (should
    (string= "#+begin_foo\nI'm a paragraph.\n#+end_foo\n"
@@ -4086,7 +4104,18 @@ Text.
 	    (org-test-with-temp-text "  This is a paragraph"
 	      (org-mark-element)
 	      (org-insert-structure-template "foo")
-	      (buffer-string)))))
+	      (buffer-string))))
+  ;; Test point location.
+  (should
+   (eq (length "#\\+begin_foo\n")
+       (org-test-with-temp-text ""
+	 (org-insert-structure-template "foo")
+	 (point))))
+  (should
+   (eq (length "#\\+begin_src ")
+       (org-test-with-temp-text ""
+	 (org-insert-structure-template "src")
+	 (point)))))
 
 (ert-deftest test-org/previous-block ()
   "Test `org-previous-block' specifications."
-- 
2.17.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #7: 0006-org-Change-org-insert-structure-template-to-C-c-C.patch --]
[-- Type: text/x-patch, Size: 1882 bytes --]

From 39837b4b31413831c89ab98ae7ac5d52e21dd681 Mon Sep 17 00:00:00 2001
From: Rasmus <rasmus@gmx.us>
Date: Sat, 7 Apr 2018 20:16:56 +0200
Subject: [PATCH 6/6] org: Change org-insert-structure-template to C-c C-,

* lisp/org.el (org-mode-map):
* doc/org-manual.org (With): Change keybinding of
  org-insert-structure-template.

See the thread titled "Poll: new keybinding for
org-insert-structure-template?" in December 2017 for details.
---
 doc/org-manual.org | 2 +-
 lisp/org.el        | 3 +--
 2 files changed, 2 insertions(+), 3 deletions(-)

diff --git a/doc/org-manual.org b/doc/org-manual.org
index 82639445c..fc53957bd 100644
--- a/doc/org-manual.org
+++ b/doc/org-manual.org
@@ -18170,7 +18170,7 @@ With just a few keystrokes, it is possible to insert empty structural
 blocks, such as =#+BEGIN_SRC= ... =#+END_SRC=, or to wrap existing
 text in such a block.
 
-- {{{kbd(C-c C-x w)}}} (~org-insert-structure-template~) ::
+- {{{kbd(C-c C-,)}}} (~org-insert-structure-template~) ::
 
      Prompt for a type of block structure, and insert the block at
      point.  If the region is active, it is wrapped in the block.
diff --git a/lisp/org.el b/lisp/org.el
index 4fd5dce51..010a59b8d 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -19157,8 +19157,7 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names."
 (org-defkey org-mode-map (kbd "C-c C-x E") #'org-inc-effort)
 (org-defkey org-mode-map (kbd "C-c C-x o") #'org-toggle-ordered-property)
 (org-defkey org-mode-map (kbd "C-c C-x i") #'org-columns-insert-dblock)
-(org-defkey org-mode-map (kbd "C-c C-x w") #'org-insert-structure-template)
-
+(org-defkey org-mode-map (kbd "C-c C-,") #'org-insert-structure-template)
 (org-defkey org-mode-map (kbd "C-c C-x .") #'org-timer)
 (org-defkey org-mode-map (kbd "C-c C-x -") #'org-timer-item)
 (org-defkey org-mode-map (kbd "C-c C-x 0") #'org-timer-start)
-- 
2.17.0


^ permalink raw reply	[flat|nested] 4+ messages in thread

* Re: [patch] Improved block insertion
  2018-04-08 10:59   ` Rasmus
@ 2018-04-08 13:22     ` Nicolas Goaziou
  0 siblings, 0 replies; 4+ messages in thread
From: Nicolas Goaziou @ 2018-04-08 13:22 UTC (permalink / raw)
  To: Rasmus; +Cc: emacs-orgmode

Rasmus <rasmus@gmx.us> writes:

> I have fixed up the patches.

Great!

> Ha, actually I used pcase at first but then changed it to something more
> simple.  Are there any performance issues with pcase or can it be used
> unconditionally?

It can be used unconditionally.

> Any worries about pushing the patches now?

Not at all. Please go ahead.

Thank you.

^ permalink raw reply	[flat|nested] 4+ messages in thread

end of thread, other threads:[~2018-04-08 13:22 UTC | newest]

Thread overview: 4+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2018-04-07 19:01 [patch] Improved block insertion Rasmus
2018-04-08  7:55 ` Nicolas Goaziou
2018-04-08 10:59   ` Rasmus
2018-04-08 13:22     ` Nicolas Goaziou

Code repositories for project(s) associated with this inbox:

	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).