From: Rasmus <rasmus@gmx.us>
To: emacs-orgmode@gnu.org
Subject: [patch] Snippet expansion
Date: Fri, 22 Dec 2017 01:29:22 +0100 [thread overview]
Message-ID: <873743ehb1.fsf@pank.eu> (raw)
[-- Attachment #1: Type: text/plain, Size: 813 bytes --]
Hi,
The first patches adds string keys to snippet expansion. For tempo, this
is straight-forward.
For the interactive prompt there’s an org-mks interface. It limited to at
most two keys (this shouldn’t be much of a limitation TBH). So for
instance if the key is "prop" the interactive prompt will be "p", "pr",
"po" or "pp".
The second patch are various improvements for org-tempo, e.g. to put the
cursor at a better place. org-tempo now also do some checks wrt. new
structure templates.
The third patch is more experimental and tries to be more "clever" when
using the interactive interface, e.g. with newlines. The code is now a
lot more complicated, and I’m not sure it’s any more pleasant or
DWIMish...
Thanks,
Rasmus
--
Vote for Dick Taid in an election near you!
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0002-org-structure-template-alist-Use-string-keys.patch --]
[-- Type: text/x-patch, Size: 7390 bytes --]
From 369a79e2190726aed2aa5dbe71fe2e99d9a59b86 Mon Sep 17 00:00:00 2001
From: Rasmus <rasmus@gmx.us>
Date: Thu, 21 Dec 2017 12:55:35 +0100
Subject: [PATCH 2/4] org-structure-template-alist: Use string keys
* lisp/org-tempo.el (org-tempo-keywords-alist):
(org-tempo-setup):
(org-tempo-add-templates): Use string keys
* 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 block selection.
fix
---
lisp/org-tempo.el | 13 ++++----
lisp/org.el | 98 +++++++++++++++++++++++++++++++++++++++++++------------
2 files changed, 85 insertions(+), 26 deletions(-)
diff --git a/lisp/org-tempo.el b/lisp/org-tempo.el
index 86e7b51eb..92a97c752 100644
--- a/lisp/org-tempo.el
+++ b/lisp/org-tempo.el
@@ -51,10 +51,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
@@ -76,6 +76,7 @@ For example \"<l\" at the beginning of a line is expanded to
(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.
@@ -102,7 +103,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
@@ -114,7 +115,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 e66e6d543..10e7682af 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -11876,16 +11876,16 @@ 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
@@ -11898,20 +11898,78 @@ corresponding structure is inserted, with \"#+BEGIN_\" and
(string :tag "Template")))
:package-version '(Org . "9.2"))
+(autoload 'org-mks "org-capture" "Select a member of an alist with multiple keys." t)
+
+(defun org-insert-structure-template--mks ()
+ "Present `org-structure-template-alist' with `org-mks'.
+
+- Menus are added if keys require more than one stroke.
+- 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
+ (keys (mapcar 'car org-structure-template-alist))
+ (start-letters (delete-dups (mapcar (lambda (key) (substring key 0 1)) keys)))
+ (mks (mapcar (lambda (letter)
+ (list letter
+ (cl-remove-if-not
+ (apply-partially 'string-match-p (concat "^" letter))
+ org-structure-template-alist :key 'car)))
+ start-letters)))
+ (org-mks
+ (apply 'append
+ (mapcar (lambda (sublist)
+ (if (eq 1 (length (cadr sublist)))
+ (mapcar (lambda (elm)
+ (list (substring (car elm) 0 1)
+ (cdr elm) ""))
+ (cadr sublist))
+ (let* ((topkey (car sublist))
+ (elms (cadr sublist))
+ (keys (mapcar 'car elms))
+ (longp (> (length elms) 3)))
+ (append
+ (list (list topkey
+ (concat
+ (mapconcat 'cdr
+ (cl-subseq elms 0 (if longp 3 (length elms)))
+ ", ")
+ (when longp ", ..."))))
+ (cl-mapcar 'list
+ (org-insert-structure-template--unique-keys keys)
+ (mapcar 'cdr elms)
+ (make-list (length elms) ""))))))
+ mks))
+ "Select a key\n============"
+ "Key: ")))
+
+(defun org-insert-structure-template--unique-keys (keys)
+ "Make each key in KEYS unique and two characters long.
+
+For keys more than two characters, find the first unique
+combination of the first letter and subsequent letters."
+ (cl-loop for key in keys
+ ;; There should at most be one key that is of length one.
+ if (eq 1 (length key))
+ collect (concat key "\t") into new-keys
+ ;; All keys of two characters should be unique.
+ else if (eq (length key) 2)
+ collect key into new-keys
+ else
+ collect
+ (cl-find-if-not (lambda (k) (member k new-keys))
+ (mapcar (apply-partially 'concat (substring key 0 1))
+ (split-string (substring key 1) "" t)))
+ into new-keys
+ finally return new-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."
+First read keys, which can be one of the keys in
+`org-structure-template-alist'. 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))))
+ (let ((struct-string (nth 1 (org-insert-structure-template--mks))))
struct-string)))
(let* ((region? (use-region-p))
(s (if region? (region-beginning) (point)))
--
2.15.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0003-org-tempo-Various-improvements.patch --]
[-- Type: text/x-patch, Size: 5418 bytes --]
From 7c08eed000387e2e52d21403970e177ae114db20 Mon Sep 17 00:00:00 2001
From: Rasmus <rasmus@gmx.us>
Date: Thu, 21 Dec 2017 12:59:36 +0100
Subject: [PATCH 3/4] org-tempo: Various improvements
* lisp/org-tempo.el (org-tempo-keywords-alist): Improve docstring.
(org-tempo--update-maybe):
(org-tempo--keys):
(org-tempo-complete-tag): New functions.
(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.
---
lisp/org-tempo.el | 34 ++++++++++++++++++++++++----------
testing/lisp/test-org-tempo.el | 39 +++++++++++++++++++++++++++++++++++++++
2 files changed, 63 insertions(+), 10 deletions(-)
diff --git a/lisp/org-tempo.el b/lisp/org-tempo.el
index 92a97c752..76e781adc 100644
--- a/lisp/org-tempo.el
+++ b/lisp/org-tempo.el
@@ -62,7 +62,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 \"#+include\" keyword is defined elsewhere."
:group 'org-tempo
:type '(repeat (cons (character :tag "Key")
(string :tag "Keyword")))
@@ -73,24 +75,34 @@ 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:]]\\)\\="))
(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-complete-tag ()
+ (org-tempo--update-maybe)
+ (call-interactively 'tempo-complete-tag))
+
(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.
(mapc (lambda (key)
(if (assoc-string key org-tempo-tags)
@@ -104,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
@@ -155,7 +169,7 @@ Goes through `org-structure-template-alist' and
(add-hook 'org-mode-hook 'org-tempo-setup)
(add-hook 'org-tab-before-tab-emulation-hook
- 'tempo-complete-tag)
+ 'org-tempo-complete-tag)
;; Enable Org Tempo in all open Org buffers.
(dolist (b (org-buffer-list))
diff --git a/testing/lisp/test-org-tempo.el b/testing/lisp/test-org-tempo.el
index 060a7da88..d48cf6ca2 100644
--- a/testing/lisp/test-org-tempo.el
+++ b/testing/lisp/test-org-tempo.el
@@ -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."
;; Check that deleted keys are not kept
--
2.15.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0004-org-Change-structure-insertion.patch --]
[-- Type: text/x-patch, Size: 5691 bytes --]
From af88d44b52878c93989bcb880f4ad3bfe57c8b28 Mon Sep 17 00:00:00 2001
From: Rasmus <rasmus@gmx.us>
Date: Thu, 21 Dec 2017 14:37:06 +0100
Subject: [PATCH 4/4] 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.
---
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 10e7682af..6f81001b4 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -11972,33 +11972,62 @@ region in the block. Otherwise, insert an empty block."
(let ((struct-string (nth 1 (org-insert-structure-template--mks))))
struct-string)))
(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 ? ))
+ (specialp (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)
+ (1+ (line-end-position)))))
+ (save-excursion
+ (while (not (eobp))
+ (unless (looking-at-p indent)
+ (insert indent))
+ (forward-line)))
+ (insert
+ indent
+ (format "#+begin_%s%s\n" type (if specialp " " "")))
+ (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 (specialp
+ (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 aa0c5fc42..fc67e2cb3 100644
--- a/testing/lisp/test-org.el
+++ b/testing/lisp/test-org.el
@@ -4024,17 +4024,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"
@@ -4063,7 +4081,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.15.1
next reply other threads:[~2017-12-22 0:29 UTC|newest]
Thread overview: 2+ messages / expand[flat|nested] mbox.gz Atom feed top
2017-12-22 0:29 Rasmus [this message]
2017-12-24 15:32 ` [patch] Snippet expansion 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=873743ehb1.fsf@pank.eu \
--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).