From b6d2b60730ceed68f46ef839c486e03764defdc7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=C4=B0=2E=20G=C3=B6ktu=C4=9F=20Kayaalp?= Date: Tue, 15 May 2018 20:34:28 +0300 Subject: [PATCH] Implement edit bindings feature Enable defining local variable bindings to be applied when editing source code. * lisp/org-src.el (org-src--apply-edit-bindings) (org-src--simplify-edit-bindings) (org-src--parse-edit-bindings) (org-src--edit-bindings-string) (org-src--get-edit-bindings-for-subtree) (org-src--get-edit-bindings-from-header) (org-src--collect-global-edit-bindings) (org-src--collect-edit-bindings-for-element): New functions. (org-src-apply-risky-edit-bindings): New defcustom. (org-src--edit-element): * doc/org.texi (Editing source code): Add edit bindings. * testing/lisp/test-org-src.el (test-org-src/edit-bindings-parser) (test-org-src/collect-edit-bindings-for-element) (test-org-src/edit-bindings-precedence-and-application) (test-org-src/edit-bindings-use-cases): Add relevant tests. --- doc/org.texi | 43 +++++++++ etc/ORG-NEWS | 15 +++ lisp/org-src.el | 223 +++++++++++++++++++++++++++++++++++++++---- testing/lisp/test-org-src.el | 172 ++++++++++++++++++++++++++++++++- 4 files changed, 436 insertions(+), 17 deletions(-) diff --git a/doc/org.texi b/doc/org.texi index 6aab1ba4e..c588152fd 100644 --- a/doc/org.texi +++ b/doc/org.texi @@ -15364,6 +15364,7 @@ Source code in the dialect of the specified language identifier. @vindex org-edit-src-auto-save-idle-delay @vindex org-edit-src-turn-on-auto-save +@vindex org-src-apply-risky-edit-bindings @kindex C-c ' @kbd{C-c '} for editing the current code block. It opens a new major-mode edit buffer containing the body of the @samp{src} code block, ready for any @@ -15421,6 +15422,48 @@ Emacs-Lisp languages. ("python" (:background "#E5FFB8")))) @end lisp +It is possible to define local variable bindings for these buffers using the +@samp{edit-bindings} element header, the @samp{edit-bindings} buffer +property, or the @samp{EDIT_BINDINGS} entry property. All three can be used +together, the bindings from the header override those of the subtree, and +they both override the bindings from buffer properties. The syntax is +similar to that of @code{let} varlists, but a sole symbol means the +variable's value is copied from the Org mode buffer. Multiple uses of +@samp{edit-bindings} headers and buffer properties are supported, and works +like @code{let*}. Entry property @samp{EDIT_BINDINGS} can not be repeated. +Below is an example: + +@example +# -*- fill-column: 65 -*- +#+PROPERTY: edit-bindings '(fill-column (lexical-binding t)) + +* Example section +:PROPERTIES: +:EDIT_BINDINGS: '((emacs-lisp-docstring-fill-column 60)) +:END: + +#+HEADER: edit-bindings '((lexical-binding nil)) +#+BEGIN_SRC elisp +(defun hello () + (message "Hello world!")) +#+END_SRC + +* Another section +#+BEGIN_SRC elisp +(defun hello () + (message "Byes world!")) +#+END_SRC +@end example + +In this example, when editing the first block, @code{lexical-binding} will be +@code{nil}, and @code{emacs-lisp-docstring-fill-column} 60. With the second +one, they will be @code{t} and the variable's default value, respectively. +@code{fill-column} will be 65 for both. + +Set @code{org-src-apply-risky-edit-bindings} for how risky local variables in +these bindings are handled. The default behaviour is to ask to the user +whether or not to apply them. + @node Exporting code blocks @section Exporting code blocks @cindex code block, exporting diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS index 21eaaece6..879240f31 100644 --- a/etc/ORG-NEWS +++ b/etc/ORG-NEWS @@ -95,6 +95,21 @@ document, use =shrink= value instead, or in addition to align: #+END_EXAMPLE ** New features +*** Set local variables for editing blocks +Bindings from =edit-bindings= header and buffer property, and +=EDIT_BINDINGS= entry property are applied in Org Src buffers. For +example, when editing the following code block with +~org-edit-special~: + +#+BEGIN_EXAMPLE +#+header: edit-bindings '((lexical-binding t)) +#+BEGIN_SRC elisp +;; some code +#+END_SRC +#+END_EXAMPLE + +in the source code editing buffer, ~lexical-binding~ is set to ~t~. + *** Org Tempo may used for snippet expansion of structure template. See manual and the commentary section in ~org-tempo.el~ for details. *** Exclude unnumbered headlines from table of contents diff --git a/lisp/org-src.el b/lisp/org-src.el index b27e96cbc..a1b766813 100644 --- a/lisp/org-src.el +++ b/lisp/org-src.el @@ -1,10 +1,11 @@ ;;; org-src.el --- Source code examples in Org -*- lexical-binding: t; -*- ;; -;; Copyright (C) 2004-2017 Free Software Foundation, Inc. +;; Copyright (C) 2004-2018 Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik ;; Bastien Guerry ;; Dan Davison +;; Göktuğ Kayaalp ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org ;; @@ -36,6 +37,7 @@ (require 'org-compat) (require 'ob-keys) (require 'ob-comint) +(require 'subr-x) (declare-function org-base-buffer "org" (buffer)) (declare-function org-do-remove-indentation "org" (&optional n)) @@ -226,6 +228,26 @@ issued in the language major mode buffer." :version "24.1" :group 'org-babel) +(defcustom org-src-apply-risky-edit-bindings 'ask + "What to do if an edit binding is a risky local variable. +If this is nil, bindings that satisfy ‘risky-local-variable-p’ +are skipped, with a warning message. Otherwise, its value should +be a symbol telling how to thread them. Possible values of this +setting are: + +nil Skip, warning the user via a message. +skip-silent Skip risky local varibles silently. +ask Prompt user for each variable. +t Apply the variable but show a warning. +apply-silent Apply risky local variables silently." + :group 'org-edit-structure + :risky t + :type '(radio + (const :tag "Skip, warning the user via a message" nil) + (const :tag "Skip risky local varibles silently" 'skip-silent) + (const :tag "Prompt user for each variable" 'ask) + (const :tag "Apply the variable but show a warning" t) + (const :tag "Apply risky local variables silently" 'apply-silent))) ;;; Internal functions and variables @@ -424,6 +446,168 @@ Assume point is in the corresponding edit buffer." (forward-line))) (buffer-string)))) +(defun org-src--apply-edit-bindings (simplified-bindings) + (pcase-dolist (`(,name . ,value) simplified-bindings) + (let ((prompt-apply + (concat "Setting risky local variable ‘%S’" + " in edit-special buffer, its value is: %S; Continue?")) + (risky-message "%s risky local variable ‘%S’ in edit-special buffer.") + (apply-binding (lambda () (set (make-local-variable name) + (eval value))))) + (unless + (and + (risky-local-variable-p name) + (cond ((or (and (eq org-src-apply-risky-edit-bindings 'ask) + (y-or-n-p (format prompt-apply name value))) + (eq org-src-apply-risky-edit-bindings 'apply-silent)) + (funcall apply-binding)) + (org-src-apply-risky-edit-bindings + (prog1 + (funcall apply-binding) + (message risky-message "Applied" name))) + ((not org-src-apply-risky-edit-bindings) + (message risky-message "Skipped" name)) + ((eq org-src-apply-risky-edit-bindings 'skip-silent)) + ('else + (user-error + "Unexpected value for ‘%S’, will not apply this or any more bindings." + 'org-src-apply-risky-edit-bindings)))) + (funcall apply-binding))))) + +(defun org-src--simplify-edit-bindings (raw-bindings) + ;; The many uses of ‘nreverse’ is aimed at keeping the order the + ;; bindings are written, so that the effect of the previous binding + ;; can reliably be used by the following one. + ;; + ;; The deep copy of raw bindings should not be necessary for general + ;; use cases, but it's useful for the tests, and might come in handy + ;; if values are cached in the future. + (let* ((b (copy-tree raw-bindings)) + (elem (plist-get (plist-get b :element-bindings) :varlist)) + (subtree (plist-get (plist-get b :subtree-bindings) :varlist)) + (global (plist-get b :global-bindings)) + (resulting-bindings + (nreverse + (append + (nreverse (apply #'append elem)) + (apply #'append + (nreverse subtree) + (mapcar (lambda (s) + (nreverse (plist-get s :varlist))) + (nreverse global)))))) + simplified-bindings) + (pcase-dolist (`(,name . ,value) resulting-bindings) + (setq simplified-bindings + (append (cl-remove-if + (lambda (x) (equal (car x) name)) + simplified-bindings) + (list (cons name value))))) + simplified-bindings)) + +(defun org-src--collect-edit-bindings-for-element () + (let* ((element-bindings (org-src--get-edit-bindings-from-header)) + (subtree-bindings (org-src--get-edit-bindings-for-subtree)) + (global-bindings + (save-excursion + (save-restriction + (narrow-to-region (point-min) (plist-get element-bindings :end)) + (org-src--collect-global-edit-bindings))))) + (list :element-bindings element-bindings + :subtree-bindings subtree-bindings + :global-bindings global-bindings))) + +(defun org-src--collect-global-edit-bindings () + ;; XXX: is setting GRANULARITY to 'element a performance + ;; improvement, and does it cause any problems over just using the + ;; default 'object? + ;; + ;; Also, is it possible to not have to parse the entire buffer every + ;; time? + (org-element-map + (org-element-parse-buffer 'element) + 'keyword + (lambda (keyword) + (cl-destructuring-bind + (_1 (_2 type _3 value _4 pos-beg _5 pos-end &rest _6)) + keyword + (ignore _1 _2 _3 _4 _5 _6) + (when-let* + ((sexp-str + (and (string= type "PROPERTY") + (org-src--edit-bindings-string value)))) + (list + :varlist + (org-src--parse-edit-bindings sexp-str pos-beg pos-end) + :begin pos-beg :end pos-end)))))) + +(defun org-src--get-edit-bindings-from-header () + (let* ((element (org-element-at-point)) + (props (cadr element)) + (beg (plist-get props :begin)) + (end (plist-get props :end)) + (headers (org-element-property :header element)) + (bindings + (nreverse + (cl-mapcar + (lambda (header) + (when-let* ((sexp-str (org-src--edit-bindings-string header))) + (org-src--parse-edit-bindings sexp-str beg end))) + headers)))) + (list :varlist bindings :begin beg :end end))) + +(defun org-src--get-edit-bindings-for-subtree () + (save-excursion + (when-let* + ((entry-bindings + (and (ignore-errors (org-back-to-heading t)) + (org-entry-get (point) "EDIT_BINDINGS" 'selective)))) + (let ((beg (org-entry-beginning-position)) + (end (org-entry-end-position))) + (list + :varlist + ;; Use the string removing the initial quote character which + ;; is required for consistency with #+headers, as without + ;; them Babel causes errors. + (org-src--parse-edit-bindings (substring entry-bindings 1) beg end) + :begin beg :end end))))) + +(defun org-src--edit-bindings-string (property-value) + (let ((str + (save-match-data + ;; We include a quote in order to fool Babel, which parses + ;; headers too. + (and (string-match "^edit-bindings '(" property-value) + (string-trim (substring property-value (1- (match-end 0)))))))) + (unless (and str (string-empty-p str)) + str))) + +(defun org-src--parse-edit-bindings (sexp-str pos-beg pos-end) + ;; XXX: require cadr of the varlist items to be atoms, for security? + ;; Or prompt users? Because otherwise there can be complete + ;; programs embedded in there. + (cl-destructuring-bind + (sexp . final-string-index) + (read-from-string sexp-str) + (when sexp + ;; Do not allow trailing stuff. + '(unless (= (1+ (length sexp-str)) final-string-index) + (user-error "Junk after edit-bindings varlist at line %d" + (line-number-at-pos pos-beg t)))) + ;; XXX: Only allow static data, no function calls? + (cl-loop for varexp in sexp + collect + (pcase varexp + ((pred null) + (ignore varexp)) + (`(,name ,value) + `(,name . ,value)) + ((pred symbolp) + `(,varexp + . ',(buffer-local-value + varexp (current-buffer)))) + (_ (user-error "Erroneous expression in varlist: %S" + varexp)))))) + (defun org-src--edit-element (datum name &optional initialize write-back contents remote) "Edit DATUM contents in a dedicated buffer NAME. @@ -513,21 +697,28 @@ Leave point in edit buffer." (org-src-mode) ;; Move mark and point in edit buffer to the corresponding ;; location. - (if remote - (progn - ;; Put point at first non read-only character after - ;; leading blank. - (goto-char - (or (text-property-any (point-min) (point-max) 'read-only nil) - (point-max))) - (skip-chars-forward " \r\t\n")) - ;; Set mark and point. - (when mark-coordinates - (org-src--goto-coordinates mark-coordinates (point-min) (point-max)) - (push-mark (point) 'no-message t) - (setq deactivate-mark nil)) - (org-src--goto-coordinates - point-coordinates (point-min) (point-max))))))) + (prog1 + (if remote + (progn + ;; Put point at first non read-only character after + ;; leading blank. + (goto-char + (or (text-property-any (point-min) (point-max) 'read-only nil) + (point-max))) + (skip-chars-forward " \r\t\n")) + ;; Set mark and point. + (when mark-coordinates + (org-src--goto-coordinates mark-coordinates (point-min) (point-max)) + (push-mark (point) 'no-message t) + (setq deactivate-mark nil)) + (org-src--goto-coordinates + point-coordinates (point-min) (point-max))) + ;; Apply edit-bindings. + (when-let* ((edit-bindings + (with-current-buffer (org-src--source-buffer) + (org-src--collect-edit-bindings-for-element)))) + (org-src--apply-edit-bindings + (org-src--simplify-edit-bindings edit-bindings)))))))) diff --git a/testing/lisp/test-org-src.el b/testing/lisp/test-org-src.el index 86f08eccb..4406e5f02 100644 --- a/testing/lisp/test-org-src.el +++ b/testing/lisp/test-org-src.el @@ -1,8 +1,10 @@ ;;; test-org-src.el --- tests for org-src.el +;; Copyright (C) 2018 Göktuğ Kayaalp ;; Copyright (C) 2012-2015 Le Wang -;; Author: Le Wang +;; Authors: Le Wang +;; Göktuğ Kayaalp ;; This file is not part of GNU Emacs. @@ -480,6 +482,174 @@ This is a tab:\t. (should (equal "#" (org-unescape-code-in-string "#"))) (should (equal "," (org-unescape-code-in-string ",")))) +(ert-deftest test-org-src/edit-bindings-parser () + "Test edit-bindings parser." + ;; ‘org-src--edit-bindings-string’ + (should (null (org-src--edit-bindings-string "not-edit-bindings '(whatever)"))) + (should (string= (org-src--edit-bindings-string "edit-bindings '()") + "()")) + (should (string= (org-src--edit-bindings-string "edit-bindings '(fill-column)") + "(fill-column)")) + (should (string= + (org-src--edit-bindings-string "edit-bindings '((fill-column 80))") + "((fill-column 80))")) + ;; ‘org-src--parse-edit-bindings’ + (should (equal (org-src--parse-edit-bindings "((lexical-binding t))" 0 0) + '((lexical-binding . t)))) + (should (equal (org-src--parse-edit-bindings "(lexical-binding)" 0 0) + '((lexical-binding . 'nil)))) + ;; ‘org-src--collect-global-edit-bindings’ + (org-test-with-temp-text + "#+property: edit-bindings '()" + (should (null (plist-get (org-src--collect-global-edit-bindings) :varlist)))) + (org-test-with-temp-text + "#+property: edit-bindings '(())" + (should (null (plist-get (org-src--collect-global-edit-bindings) :varlist)))) + (org-test-with-temp-text + "#+property: edit-bindings '(major-mode)" + (let ((ret (car (org-src--collect-global-edit-bindings)))) + (should (equal '((major-mode . 'org-mode)) (plist-get ret :varlist))))) + ;; ‘org-src--get-edit-bindings-from-header’ + (org-test-with-temp-text + "#+header: edit-bindings '(major-mode) +#+BEGIN_EXPORT latex +#+END_EXPORT" + (let ((ret (org-src--get-edit-bindings-from-header))) + (should (equal (plist-get ret :varlist) + '(((major-mode . 'org-mode))))))) + (org-test-with-temp-text + "#+header: edit-bindings '(major-mode) +#+header: edit-bindings '((xxx 12)) +#+BEGIN_EXPORT latex +#+END_EXPORT" + (let ((ret (org-src--get-edit-bindings-from-header))) + (should (equal (plist-get ret :varlist) + '(((major-mode . 'org-mode)) + ((xxx . 12)))))))) + +(ert-deftest test-org-src/collect-edit-bindings-for-element () + "Collecting edit-bindings settings scoped to an element." + (org-test-with-temp-text + "#+header: edit-bindings '(major-mode) +#+BEGIN_SRC elisp +#+END_SRC" + (cl-destructuring-bind + (_1 elem _2 subtree _3 global) + (org-src--collect-edit-bindings-for-element) + (should (equal (car (plist-get elem :varlist)) '((major-mode . 'org-mode)))) + (should (null (plist-get subtree :varlist))) + (should (null (plist-get global :varlist))))) + (org-test-with-temp-text + "#+property: edit-bindings '((fill-column 38)) +#+header: edit-bindings '(major-mode) +#+BEGIN_SRC elisp +#+END_SRC" + (cl-destructuring-bind + (_1 elem _2 subtree _3 global) + (org-src--collect-edit-bindings-for-element) + (should (equal (plist-get elem :varlist) '(((major-mode . 'org-mode))))) + (should (equal (plist-get (car global) :varlist) '((fill-column . 38)))) + (should (null (plist-get subtree :varlist))))) + (org-test-with-temp-text + "#+property: edit-bindings '((fill-column 38)) +#+header: edit-bindings '(major-mode) +#+BEGIN_SRC elisp +#+END_SRC +#+property: edit-bindings '((lexical-let 'orly))" + (cl-destructuring-bind + (_1 elem _2 subtree _3 global) + (org-src--collect-edit-bindings-for-element) + (should (equal (plist-get elem :varlist) '(((major-mode . 'org-mode))))) + (should (equal (plist-get (car global) :varlist) '((fill-column . 38)))) + (should (null subtree)))) + (org-test-with-temp-text + "#+property: edit-bindings '((fill-column 38)) +* A subtree! +:PROPERTIES: +:EDIT_BINDINGS: '((fill-column 47)) +:END: +#+header: edit-bindings '(major-mode) +#+BEGIN_SRC elisp +#+END_SRC +#+property: edit-bindings '((lexical-binding 'orly))" + (cl-destructuring-bind + (_1 elem _2 subtree _3 global) + (org-src--collect-edit-bindings-for-element) + (should (equal (plist-get elem :varlist) '(((major-mode . 'org-mode))))) + (should (equal (plist-get subtree :varlist) '((fill-column . 47)))) + (should (equal (plist-get (car global) :varlist) '((fill-column . 38)))) + (should + (not (equal (plist-get (car global) :varlist) + '((lexical-binding . 'orly)))))))) + +(ert-deftest test-org-src/edit-bindings-precedence-and-application () + "Test handling of scope precedence, and application of bindings." + (let ((case1 (list :element-bindings '(:varlist (((a . 'b) (c . 'd)))) + :subtree-bindings '(:varlist ((c . 'e) (p . 'q))) + :global-bindings '((:varlist ((z . 'o) (k . 'f))) + (:varlist ((q . 'u) (x . 'y)))))) + (case1-expected + '((z . 'o) (k . 'f) (q . 'u) (x . 'y) ;global + (p . 'q) ;subtree + (a . 'b) (c . 'd) ;element + )) + (case2 (list :element-bindings '(:varlist (((a . 'b)))) + :global-bindings '((:varlist ((a . 'z))))))) + ;; Precedence: + (should (equal (org-src--simplify-edit-bindings nil) nil)) + (should + (equal (org-src--simplify-edit-bindings case1) + case1-expected)) + (should + (equal (org-src--simplify-edit-bindings case2) + '((a . 'b)))) + ;; Application: + (with-temp-buffer + (org-src--apply-edit-bindings + (org-src--simplify-edit-bindings case2)) + (should (equal (buffer-local-value 'a (current-buffer)) 'b))) + (with-temp-buffer + (org-src--apply-edit-bindings + (org-src--simplify-edit-bindings case1)) + (pcase-dolist (`(,var . ,val) case1-expected) + (should (equal (buffer-local-value var (current-buffer)) + (eval val))))))) + +(ert-deftest test-org-src/edit-bindings-use-cases () + "Test possible uses of edit bindings feature." + (org-test-with-temp-text + "#+header: edit-bindings '((xxx t)) +#+BEGIN_SRC elisp +#+END_SRC" + (org-edit-special) + (should + (equal (buffer-local-value 'xxx (current-buffer)) t)) + (org-edit-src-exit)) + (org-test-with-temp-text + "#+property: edit-bindings '((xxx 12) major-mode) +#+header: edit-bindings '((xxx t)) +#+BEGIN_SRC elisp +#+END_SRC +#+property: edit-bindings '((xxx 13))" + (org-edit-special) + (should (equal (buffer-local-value 'xxx (current-buffer)) t)) + (should (equal (buffer-local-value 'major-mode (current-buffer)) 'org-mode)) + (org-edit-src-exit)) + (org-test-with-temp-text + "#+property: edit-bindings '((xxx 12)) +* header +:properties: +:edit_bindings: '((zzz 34)) +:end: +#+property: edit-bindings '((zzz 413)) +#+header: edit-bindings '((xxx t)) +#+BEGIN_SRC elisp +#+END_SRC +#+property: edit-bindings '((xxx 13))" + (org-edit-special) + (should (equal (buffer-local-value 'xxx (current-buffer)) t)) + (should (equal (buffer-local-value 'zzz (current-buffer)) 34)) + (org-edit-src-exit))) (provide 'test-org-src) ;;; test-org-src.el ends here -- 2.11.0