From: Rasmus <rasmus@gmx.us>
To: emacs-orgmode@gnu.org
Subject: Re: [patch] Improved block insertion
Date: Sun, 08 Apr 2018 12:59:18 +0200 [thread overview]
Message-ID: <87a7ueezg9.fsf@gmx.us> (raw)
In-Reply-To: 87woxi2ktw.fsf@nicolasgoaziou.fr
[-- 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
next prev parent reply other threads:[~2018-04-08 10:59 UTC|newest]
Thread overview: 4+ messages / expand[flat|nested] mbox.gz Atom feed top
2018-04-07 19:01 [patch] Improved block insertion Rasmus
2018-04-08 7:55 ` Nicolas Goaziou
2018-04-08 10:59 ` Rasmus [this message]
2018-04-08 13:22 ` Nicolas Goaziou
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.orgmode.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87a7ueezg9.fsf@gmx.us \
--to=rasmus@gmx.us \
--cc=emacs-orgmode@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public 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).