branch: externals/org-transclusion
commit 11462931077568b8f4fe30bd2d47a1dcb508eaf0
Merge: ed141838d0 8317ec94fa
Author: nobiot <m...@nobiot.com>
Commit: GitHub <nore...@github.com>
Merge pull request #157 from devcarbon-com/feature--things-at-point
Feature: select end via n things at point.
---
org-transclusion-src-lines.el | 72 +++++++++++++++++++++++++++++++------------
org-transclusion.el | 37 +++++++++++++++-------
2 files changed, 79 insertions(+), 30 deletions(-)
diff --git a/org-transclusion-src-lines.el b/org-transclusion-src-lines.el
index b0aaafdc8d..97fdbf3583 100644
--- a/org-transclusion-src-lines.el
+++ b/org-transclusion-src-lines.el
@@ -32,6 +32,8 @@
(declare-function org-transclusion-org-file-p
"org-transclusion")
+(declare-function org-transclusion-keyword-value-thing-at-point
+ "org-transclusion")
;;;; Setting up the extension
;; Add a new transclusion type
@@ -46,6 +48,8 @@
#'org-transclusion-keyword-value-rest)
(add-hook 'org-transclusion-keyword-value-functions
#'org-transclusion-keyword-value-end)
+(add-hook 'org-transclusion-keyword-value-functions
+ #'org-transclusion-keyword-value-thing-at-point)
;; plist back to string
(add-hook 'org-transclusion-keyword-plist-to-string-functions
#'org-transclusion-keyword-plist-to-string-src-lines)
@@ -62,6 +66,22 @@
;;; Functions
+(defun org-transclusion--bounds-of-n-things-at-point (thing count)
+ "Return the bounds of COUNT THING (s) -at-point."
+ (save-excursion
+ (let ((bounds (bounds-of-thing-at-point thing)))
+ (when bounds
+ (push-mark (car bounds) t t)
+ (goto-char (cdr bounds))
+ (while (and (> count 1) bounds)
+ (setq bounds (bounds-of-thing-at-point thing))
+ (when bounds
+ (if (> count 1)
+ (forward-thing thing)
+ (goto-char (cdr bounds)))
+ (setq count (1- count))))
+ (car (region-bounds))))))
+
(defun org-transclusion-add-src-lines (link plist)
"Return a list for non-Org text and source file.
Determine add function based on LINK and PLIST.
@@ -107,7 +127,9 @@ it means from line 10 to the end of file."
(type (org-element-property :type link))
(entry-pos) (buf)
(lines (plist-get plist :lines))
- (end-search-op (plist-get plist :end)))
+ (end-search-op (plist-get plist :end))
+ (thing-at-point (plist-get plist :thing-at-point))
+ (thing-at-point (when thing-at-point (make-symbol thing-at-point))))
(if (not (string= type "id")) (setq buf (find-file-noselect path))
(let ((filename-pos (org-id-find path)))
(setq buf (find-file-noselect (car filename-pos)))
@@ -125,15 +147,23 @@ it means from line 10 to the end of file."
;; ::/regex/ or ::number is used
(if (org-link-search search-option)
(line-beginning-position))))))
- ((point-min))))
- (end-pos (when end-search-op
- (save-excursion
- (ignore-errors
- ;; FIXME `org-link-search' does not
- ;; return postion when either ::/regex/
- ;; or ::number is used
- (when (org-link-search end-search-op)
- (line-beginning-position))))))
+ ((point-min))))
+ (bounds (when thing-at-point
+ (let ((count (if end-search-op
+ (string-to-number end-search-op)
1)))
+ (save-excursion
+ (goto-char start-pos)
+ (back-to-indentation)
+ (org-transclusion--bounds-of-n-things-at-point
thing-at-point count)))))
+ (end-pos (cond ((when thing-at-point (cdr bounds)))
+ ((when end-search-op
+ (save-excursion
+ (ignore-errors
+ ;; FIXME `org-link-search' does not
+ ;; return postion when either ::/regex/
+ ;; or ::number is used
+ (when (org-link-search end-search-op)
+ (line-beginning-position))))))))
(range (when lines (split-string lines "-")))
(lbeg (if range (string-to-number (car range))
0))
@@ -148,7 +178,8 @@ it means from line 10 to the end of file."
;;; This `cond' means :end prop has priority over the end
;;; position of the range. They don't mix.
(end (cond
- ((when (and end-pos (> end-pos beg))
+ ((when thing-at-point end-pos)
+ (when (and end-pos (> end-pos beg))
end-pos))
((if (zerop lend) (point-max)
(goto-char start-pos)
@@ -175,12 +206,13 @@ for the range works."
(when src-lang
(setq payload
(plist-put payload :src-content
- (concat
- (format "#+begin_src %s" src-lang)
- (when rest (format " %s" rest))
- "\n"
- (plist-get payload :src-content)
- "#+end_src\n"))))
+ (let ((src-content (plist-get payload :src-content)))
+ (concat
+ (format "#+begin_src %s" src-lang)
+ (when rest (format " %s" rest))
+ "\n"
+ (org-transclusion--ensure-newline src-content)
+ "#+end_src\n")))))
;; Return the payload either modified or unmodified
payload))
@@ -230,12 +262,14 @@ abnormal hook
(let ((lines (plist-get plist :lines))
(src (plist-get plist :src))
(rest (plist-get plist :rest))
- (end (plist-get plist :end)))
+ (end (plist-get plist :end))
+ (thing-at-point (plist-get plist :thing-at-point)))
(concat
(when lines (format ":lines %s" lines))
(when src (format " :src %s" src))
(when rest (format " :rest \"%s\"" rest))
- (when end (format " :end \"%s\"" end)))))
+ (when end (format " :end \"%s\"" end))
+ (when thing-at-point (format " :thing-at-point %s" thing-at-point)))))
(defun org-transclusion-src-lines-p (type)
"Return non-nil when TYPE is \"src\" or \"lines\".
diff --git a/org-transclusion.el b/org-transclusion.el
index 2989ff098f..9ceaaa004f 100644
--- a/org-transclusion.el
+++ b/org-transclusion.el
@@ -201,6 +201,7 @@ that consists of the following properties:
(defvar org-transclusion-keyword-value-functions
'(org-transclusion-keyword-value-link
+ org-transclusion-keyword-value-thing-at-point
org-transclusion-keyword-value-level
org-transclusion-keyword-value-disable-auto
org-transclusion-keyword-value-only-contents
@@ -799,6 +800,15 @@ It is meant to be used by
(user-error "Error. Link in #+transclude is mandatory at %d" (point))
nil))
+(defun org-transclusion-keyword-value-thing-at-point (string)
+ "It is a utility function used converting a keyword STRING to plist.
+It is meant to be used by `org-transclusion-get-string-to-plist'.
+It needs to be set in `org-transclusion-get-keyword-values-hook'.
+Double qutations are optional :thing-at-point \"sexp\". The regex should
+match any valid elisp symbol (but please don't quote it)."
+ (when (string-match ":thing-at-point \\([[:alnum:][:punct:]]+\\)" string)
+ (list :thing-at-point (org-strip-quotes (match-string 1 string)))))
+
(defun org-transclusion-keyword-value-disable-auto (string)
"It is a utility function used converting a keyword STRING to plist.
It is meant to be used by `org-transclusion-get-string-to-plist'.
@@ -942,6 +952,11 @@ Return nil if not found."
;;-----------------------------------------------------------------------------
;;;; Functions for inserting content
+(defun org-transclusion--ensure-newline (str)
+ (if (not (string-suffix-p "\n" str))
+ (concat str "\n")
+ str))
+
(defun org-transclusion-content-insert (keyword-values type content sbuf sbeg
send copy)
"Insert CONTENT at point and put source overlay in SBUF.
Return t when successful.
@@ -971,17 +986,17 @@ based on the following arguments:
(end-mkr)
(ov-src (text-clone-make-overlay sbeg send sbuf)) ;; source-buffer
overlay
(tc-pair ov-src)
- (content content))
+ (content (org-transclusion--ensure-newline content)))
(when (org-transclusion-type-is-org type)
- (with-temp-buffer
- ;; This temp buffer needs to be in Org Mode
- ;; Otherwise, subtree won't be recognized as a Org subtree
- (delay-mode-hooks (org-mode))
- (insert content)
- (org-with-point-at 1
- (let* ((to-level (plist-get keyword-values :level))
- (level (org-transclusion-content-highest-org-headline))
- (diff (when (and level to-level) (- level to-level))))
+ (with-temp-buffer
+ ;; This temp buffer needs to be in Org Mode
+ ;; Otherwise, subtree won't be recognized as a Org subtree
+ (delay-mode-hooks (org-mode))
+ (insert content)
+ (org-with-point-at 1
+ (let* ((to-level (plist-get keyword-values :level))
+ (level (org-transclusion-content-highest-org-headline))
+ (diff (when (and level to-level) (- level to-level))))
(when diff
(cond ((< diff 0) ; demote
(org-map-entries (lambda ()
@@ -991,7 +1006,7 @@ based on the following arguments:
(org-map-entries (lambda ()
(dotimes (_ diff)
(org-do-promote))))))))
- (setq content (buffer-string)))))
+ (setq content (buffer-string)))))
(insert
(run-hook-with-args-until-success
'org-transclusion-content-format-functions
