From mboxrd@z Thu Jan 1 00:00:00 1970 From: Rasmus Subject: [patch] Improved block insertion Date: Sat, 07 Apr 2018 21:01:10 +0200 Message-ID: <87muyeg7t5.fsf@gmx.us> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:52504) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1f4t5a-0004Wh-SG for emacs-orgmode@gnu.org; Sat, 07 Apr 2018 15:01:32 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1f4t5W-0006fu-Gp for emacs-orgmode@gnu.org; Sat, 07 Apr 2018 15:01:26 -0400 Received: from [195.159.176.226] (port=39120 helo=blaine.gmane.org) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1f4t5V-0006eq-Nm for emacs-orgmode@gnu.org; Sat, 07 Apr 2018 15:01:22 -0400 Received: from list by blaine.gmane.org with local (Exim 4.84_2) (envelope-from ) id 1f4t3O-0004wd-0V for emacs-orgmode@gnu.org; Sat, 07 Apr 2018 20:59:10 +0200 List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Sender: "Emacs-orgmode" To: emacs-orgmode@gnu.org --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: 8bit 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-org-macs-Move-org-mks-from-org-capture-to-org-macs.patch >From 06ab656f4250ee7a765550f353743056aed31c8d Mon Sep 17 00:00:00 2001 From: Rasmus 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)))))) ;;; Logic -- 2.17.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-org-macs-Make-tab-space-and-RET-equivalent-in-org-mk.patch >From 3c635136a80e9a5c56e37176860bbb0c97637a93 Mon Sep 17 00:00:00 2001 From: Rasmus 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0003-org-org-structure-template-alist-uses-string-keys.patch >From a53e43e90e53856b4afa0b4bc43e95ddac8de03b Mon Sep 17 00:00:00 2001 From: Rasmus 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 \" 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 \" (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 , 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 , 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 "From 0d2539e97d04c096a2f56a26f15b37066c5b4397 Mon Sep 17 00:00:00 2001 From: Rasmus 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 \" (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)))) + ;;; 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 "" @@ -59,6 +59,45 @@ (buffer-string)) "" + (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" 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 "" + (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 "" + (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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0005-org-Change-structure-insertion.patch >From f47e04d4844eb0fda2ae51a3ab6b788781af1a7f Mon Sep 17 00:00:00 2001 From: Rasmus 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\np2\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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0006-org-Change-org-insert-structure-template-to-C-c-C.patch >From 5ff19d87a454db1e1a0c0491b31ee29ace18573f Mon Sep 17 00:00:00 2001 From: Rasmus 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 --=-=-=--