Browse Source

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.
Rasmus 7 years ago
parent
commit
b56df737b7
5 changed files with 130 additions and 46 deletions
  1. 4 3
      doc/org-manual.org
  2. 2 2
      etc/ORG-NEWS
  3. 8 8
      lisp/org-tempo.el
  4. 111 29
      lisp/org.el
  5. 5 4
      testing/lisp/test-org-tempo.el

+ 4 - 3
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
      Prompt for a type of block structure, and insert the block at
      point.  If the region is active, it is wrapped in the block.
      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
 #+vindex: org-structure-template-alist
 Available structure types are defined in
 Available structure types are defined in

+ 2 - 2
etc/ORG-NEWS

@@ -65,8 +65,8 @@ details.
 *** Change ~org-structure-template-alist~ value
 *** Change ~org-structure-template-alist~ value
 
 
 With the new template expansion mechanism (see
 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
 *** Change ~org-set-effort~ signature
 See docstring for details.
 See docstring for details.

+ 8 - 8
lisp/org-tempo.el

@@ -54,10 +54,10 @@
   "Tempo tags for Org mode")
   "Tempo tags for Org mode")
 
 
 (defcustom org-tempo-keywords-alist
 (defcustom org-tempo-keywords-alist
-  '((?L . "latex")
-    (?H . "html")
-    (?A . "ascii")
-    (?i . "index"))
+  '(("L" . "latex")
+    ("H" . "html")
+    ("A" . "ascii")
+    ("i" . "index"))
   "Keyword completion elements.
   "Keyword completion elements.
 
 
 Like `org-structure-template-alist' this alist of KEY characters
 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
 For example \"<l\" at the beginning of a line is expanded to
 #+latex:"
 #+latex:"
   :group 'org-tempo
   :group 'org-tempo
-  :type '(repeat (cons (character :tag "Key")
+  :type '(repeat (cons (string :tag "Key")
 		       (string :tag "Keyword")))
 		       (string :tag "Keyword")))
   :package-version '(Org . "9.2"))
   :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 ()
 (defun org-tempo-setup ()
   (org-tempo-add-templates)
   (org-tempo-add-templates)
   (tempo-use-tag-list 'org-tempo-tags)
   (tempo-use-tag-list 'org-tempo-tags)
-  (setq-local tempo-match-finder "^ *\\(<[[:word:]]\\)\\="))
+  (setq-local tempo-match-finder "^ *\\(<[[:word:]]+\\)\\="))
 
 
 (defun org-tempo-add-templates ()
 (defun org-tempo-add-templates ()
   "Update all Org Tempo templates.
   "Update all Org Tempo templates.
@@ -101,7 +101,7 @@ Goes through `org-structure-template-alist' and
 
 
 (defun org-tempo-add-block (entry)
 (defun org-tempo-add-block (entry)
   "Add block entry from `org-structure-template-alist'."
   "Add block entry from `org-structure-template-alist'."
-  (let* ((key (format "<%c" (car entry)))
+  (let* ((key (format "<%s" (car entry)))
 	 (name (cdr entry)))
 	 (name (cdr entry)))
     (tempo-define-template (format "org-%s" (replace-regexp-in-string " " "-" name))
     (tempo-define-template (format "org-%s" (replace-regexp-in-string " " "-" name))
 			   `(,(format "#+begin_%s " name) p '> n n
 			   `(,(format "#+begin_%s " name) p '> n n
@@ -113,7 +113,7 @@ Goes through `org-structure-template-alist' and
 
 
 (defun org-tempo-add-keyword (entry)
 (defun org-tempo-add-keyword (entry)
   "Add keyword entry from `org-tempo-keywords-alist'."
   "Add keyword entry from `org-tempo-keywords-alist'."
-  (let* ((key (format "<%c" (car entry)))
+  (let* ((key (format "<%s" (car entry)))
 	 (name (cdr entry)))
 	 (name (cdr entry)))
     (tempo-define-template (format "org-%s" (replace-regexp-in-string " " "-" name))
     (tempo-define-template (format "org-%s" (replace-regexp-in-string " " "-" name))
 			   `(,(format "#+%s: " name) p '>)
 			   `(,(format "#+%s: " name) p '>)

+ 111 - 29
lisp/org.el

@@ -11642,43 +11642,125 @@ keywords relative to each registered export back-end."
     "TITLE:" "TODO:" "TYP_TODO:" "SELECT_TAGS:" "EXCLUDE_TAGS:"))
     "TITLE:" "TODO:" "TYP_TODO:" "SELECT_TAGS:" "EXCLUDE_TAGS:"))
 
 
 (defcustom org-structure-template-alist
 (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.
   "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
   :group 'org-edit-structure
   :type '(repeat
   :type '(repeat
-	  (cons (character :tag "Key")
+	  (cons (string :tag "Key")
 		(string :tag "Template")))
 		(string :tag "Template")))
   :package-version '(Org . "9.2"))
   :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)
 (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
   (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))
   (let* ((region? (use-region-p))
 	 (s (if region? (region-beginning) (point)))
 	 (s (if region? (region-beginning) (point)))
 	 (e (copy-marker (if region? (region-end) (point)) t))
 	 (e (copy-marker (if region? (region-end) (point)) t))

+ 5 - 4
testing/lisp/test-org-tempo.el

@@ -61,13 +61,14 @@
 
 
 (ert-deftest test-org-tempo/add-new-templates ()
 (ert-deftest test-org-tempo/add-new-templates ()
   "Test that new structures and keywords are added correctly."
   "Test that new structures and keywords are added correctly."
-  ;; Check that deleted keys are not kept
+  ;; New blocks should be added.
   (should
   (should
-   (let ((org-structure-template-alist '((?n . "new_block"))))
+   (let ((org-structure-template-alist '(("n" . "new_block"))))
      (org-tempo-add-templates)
      (org-tempo-add-templates)
-     (assoc "<n" org-tempo-tags)))
+     (assoc "<l" org-tempo-tags)))
+  ;; New keys should be added.
   (should
   (should
-   (let ((org-tempo-keywords-alist '((?N . "new_keyword"))))
+   (let ((org-tempo-keywords-alist '(("N" . "new_keyword"))))
      (org-tempo-add-templates)
      (org-tempo-add-templates)
      (assoc "<N" org-tempo-tags))))
      (assoc "<N" org-tempo-tags))))