From mboxrd@z Thu Jan 1 00:00:00 1970 From: Rasmus Subject: [patch] Snippet expansion Date: Fri, 22 Dec 2017 01:29:22 +0100 Message-ID: <873743ehb1.fsf@pank.eu> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:44283) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1eSBDO-0002Xh-OQ for emacs-orgmode@gnu.org; Thu, 21 Dec 2017 19:29:34 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1eSBDL-0003Qo-Ho for emacs-orgmode@gnu.org; Thu, 21 Dec 2017 19:29:30 -0500 Received: from mout.gmx.net ([212.227.15.19]:61997) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1eSBDL-0003PV-0N for emacs-orgmode@gnu.org; Thu, 21 Dec 2017 19:29:27 -0500 Received: from W530 ([87.57.37.57]) by mail.gmx.com (mrgmx002 [212.227.17.184]) with ESMTPSA (Nemesis) id 0M4Gup-1fJs1o1O9z-00rpnV for ; Fri, 22 Dec 2017 01:29:23 +0100 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: quoted-printable Hi, The first patches adds string keys to snippet expansion. For tempo, this is straight-forward. For the interactive prompt there=E2=80=99s an org-mks interface. It limite= d to at most two keys (this shouldn=E2=80=99t 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=E2=80=99m not sure it=E2=80=99s any more pleasa= nt or DWIMish... Thanks, Rasmus --=20 Vote for Dick Taid in an election near you! --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-org-structure-template-alist-Use-string-keys.patch >From 369a79e2190726aed2aa5dbe71fe2e99d9a59b86 Mon Sep 17 00:00:00 2001 From: Rasmus 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 \" 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 , 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0003-org-tempo-Various-improvements.patch >From 7c08eed000387e2e52d21403970e177ae114db20 Mon Sep 17 00:00:00 2001 From: Rasmus 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 \" (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)) "" + (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." ;; Check that deleted keys are not kept -- 2.15.1 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0004-org-Change-structure-insertion.patch >From af88d44b52878c93989bcb880f4ad3bfe57c8b28 Mon Sep 17 00:00:00 2001 From: Rasmus 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\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" @@ -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 --=-=-=--