From 5be23703f89225a24e820d7a66494126c7a337e2 Mon Sep 17 00:00:00 2001 From: Noboru Ota Date: Sat, 22 Apr 2023 12:32:11 +0200 Subject: [PATCH 1/6] refactor: add predicate org-transclusion-transclusion-keyword-p The check prior to this refactoring in `org-transclusion-check-add` is intended to check also the line at point is in a block such as an example. This is cleverly taken care of by `org-element-at-point` -- it tells the element at point is a block, not a keyword. --- org-transclusion.el | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/org-transclusion.el b/org-transclusion.el index 2989ff0..6f07e6d 100644 --- a/org-transclusion.el +++ b/org-transclusion.el @@ -17,7 +17,7 @@ ;; Author: Noboru Ota ;; Created: 10 October 2020 -;; Last modified: 28 March 2023 +;; Last modified: 22 April 2023 ;; URL: https://github.com/nobiot/org-transclusion ;; Keywords: org-mode, transclusion, writing @@ -779,8 +779,7 @@ off (removed)." (save-excursion (beginning-of-line) (let ((plist)) - (when (string= "TRANSCLUDE" - (org-element-property :key (org-element-at-point))) + (when (org-transclusion-transclusion-keyword-p) ;; #+transclude: keyword exists. ;; Further checking the value (when-let ((str (org-element-property :value (org-element-at-point)))) @@ -1335,10 +1334,8 @@ Case 1. Element at point is NOT #+transclude: Case 2. #+transclude inside another transclusion" (cond ;; Case 1. Element at point is NOT #+transclude: - ((let ((elm (org-element-at-point))) - (not (and (string= "keyword" (org-element-type elm)) - (string= "TRANSCLUDE" (org-element-property :key elm))))) - (user-error (format "Not at a transclude keyword or transclusion in a block at point %d, line %d" + ((not (org-transclusion-transclusion-keyword-p)) + (user-error (format "Not at a transclude keyword at point %d, line %d" (point) (org-current-line)))) ;; Case 2. #+transclude inside another transclusion ((org-transclusion-within-transclusion-p) @@ -1347,6 +1344,12 @@ Case 2. #+transclude inside another transclusion" (t t))) +(defun org-transclusion-transclusion-keyword-p () + "Return t if the current point is on the \"#+transclusion\" line." + (when (string= "TRANSCLUDE" + (org-element-property :key (org-element-at-point))) + t)) + (defun org-transclusion-within-transclusion-p () "Return t if the current point is within a tranclusion region." (when (get-char-property (point) 'org-transclusion-type) t)) From 6bdb77bf6791146fe5f2dc52d6e1d6ce07f622fb Mon Sep 17 00:00:00 2001 From: Noboru Ota Date: Sun, 23 Apr 2023 16:29:20 +0200 Subject: [PATCH 2/6] feat: org-transclusion-mmenu --- org-transclusion-menu.el | 106 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 106 insertions(+) create mode 100644 org-transclusion-menu.el diff --git a/org-transclusion-menu.el b/org-transclusion-menu.el new file mode 100644 index 0000000..bf39f5f --- /dev/null +++ b/org-transclusion-menu.el @@ -0,0 +1,106 @@ +;;; org-transclusion-menu.el --- Menu for Org-transclusion -*- lexical-binding: t; -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; This program is free software: you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by the +;; Free Software Foundation, either version 3 of the License, or (at your +;; option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License along +;; with this program. If not, see . + +;; Author: Noboru Ota +;; Created: 23 April 2023 +;; Last modified: 23 April 2023 + +;;; Commentary: + +;; This library is part of Org-tralclusion. It provides a menu for +;; Org-translcusion. + +;;; Code: + +;;;; Requirements + +;;;; Customization + +(defgroup org-transclusion nil + "Insert text contents by way of link references." + :group 'org + :prefix "org-transclusion-" + :link '(url-link :tag "Github" "https://github.com/nobiot/org-transclusion") + :package-version '("Org-transclusion" . "1.0.0")) + +(defcustom org-transclusion-menu t + "Provides menu for `org-transclusion' when non-nil. +Deactivate it when you do not wish to see the menu and +context-menu for `org-transcluson'." + :type 'boolean) + +;;;; Commands / interactive functions + +;; n/a org-transclusion-keyword-value-link +;; x org-transclusion-keyword-value-level +;; org-transclusion-keyword-value-disable-auto +;; x org-transclusion-keyword-value-only-contents +;; org-transclusion-keyword-value-exclude-elements +;; org-transclusion-keyword-value-expand-links +;; n/a org-transclusion-keyword-current-indentation) +;; TODO org-transclusion-src commands + +(defun org-transclusion-menu-level () + "Update/add the \":level\" property to \"#+transclude\" at point.\ +You will be promted to enter a number from 1 to 9. Any other +values will not be accepted." + (interactive) + (org-transclusion-menu-keyword-update-at-point + (lambda (plist) + (let ((level (read-number + "Set org-transclusion content headline level \(1-9\): "))) + (if (or (< level 0) (> level 9)) + (user-error (format "Level %d must be 1-9 \(inclusive\)" level)) + (plist-put plist :level level)))))) + +(defun org-transclusion-menu-only-contents () + (interactive) + (org-transclusion-menu-keyword-update-at-point + (lambda (plist) + (plist-put plist :only-contents t)))) + +;;;; Functions + +(defun org-transclusion-menu-keyword-update-at-point (function) + "Update the keyword string of Org-transclusion at point. +This function is a utilitiy function to be used to create a new +interactive function to update a property and value in the +\"#+transclude\" keyword at point. See examples in +`org-transclusion-menu-level' and +`org-transclusion-menu-only-contents' on how it can be used. + +FUNCTION must take PLIST as a single argument, which is a return +value of function +`org-transclusion-keyword-string-to-plist'. FUNCTION is then +meant to modify it via `plist-put' to add a new prop-value pair +or modify an existing one, and return the modified plist. + +If FUNCTION is nil, this function does not modify PLIST and uses +the current PLIST as called by +`org-transclusion-keyword-string-to-plist'." + (save-excursion + (if (not (org-transclusion-transclusion-keyword-p)) + (user-error "The point is not on \"#+transclude\" line") + (save-excursion + (let* ((current-plist (org-transclusion-keyword-string-to-plist)) + (new-plist (if function (funcall function current-plist) + current-plist))) + (org-transclusion-keyword-remove) + (insert (org-transclusion-keyword-plist-to-string new-plist))))))) + +(provide 'org-transclusion-menu) +;;; org-transclusion-menu.el ends here From 6fcf8363df990775edc5e8084454293007a90d5f Mon Sep 17 00:00:00 2001 From: Noboru Ota Date: Sun, 23 Apr 2023 17:23:21 +0200 Subject: [PATCH 3/6] refactor: menu-level emulates read-number to avoid error read-number does not error when the user enters non-number value; instead it loops back to the prompt. `org-transclusion-menu-level` emulates it and loops back when the number entered is not between 1 and 9 (inclusive). --- org-transclusion-menu.el | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/org-transclusion-menu.el b/org-transclusion-menu.el index bf39f5f..88d840d 100644 --- a/org-transclusion-menu.el +++ b/org-transclusion-menu.el @@ -61,11 +61,17 @@ values will not be accepted." (interactive) (org-transclusion-menu-keyword-update-at-point (lambda (plist) - (let ((level (read-number - "Set org-transclusion content headline level \(1-9\): "))) - (if (or (< level 0) (> level 9)) - (user-error (format "Level %d must be 1-9 \(inclusive\)" level)) - (plist-put plist :level level)))))) + (let ((level)) + (while + (progn + (setq level + (read-number + "Set org-transclusion content headline level \(1-9\): ")) + (unless (and (> level 0) (< level 10)) + (message (format "Level %d must be 1-9 \(inclusive\)" level)) + (sit-for 1) + t))) + (plist-put plist :level level))))) (defun org-transclusion-menu-only-contents () (interactive) From ef29490d3ffe0fc2d0edc6a58016c9949ba73bec Mon Sep 17 00:00:00 2001 From: Noboru Ota Date: Sun, 23 Apr 2023 17:50:45 +0200 Subject: [PATCH 4/6] add: Other properties --- org-transclusion-menu.el | 29 ++++++++++++++++++++++++++--- 1 file changed, 26 insertions(+), 3 deletions(-) diff --git a/org-transclusion-menu.el b/org-transclusion-menu.el index 88d840d..8eb91fd 100644 --- a/org-transclusion-menu.el +++ b/org-transclusion-menu.el @@ -47,10 +47,10 @@ context-menu for `org-transcluson'." ;; n/a org-transclusion-keyword-value-link ;; x org-transclusion-keyword-value-level -;; org-transclusion-keyword-value-disable-auto +;; x org-transclusion-keyword-value-disable-auto ;; x org-transclusion-keyword-value-only-contents -;; org-transclusion-keyword-value-exclude-elements -;; org-transclusion-keyword-value-expand-links +;; x org-transclusion-keyword-value-exclude-elements +;; x org-transclusion-keyword-value-expand-links ;; n/a org-transclusion-keyword-current-indentation) ;; TODO org-transclusion-src commands @@ -73,12 +73,35 @@ values will not be accepted." t))) (plist-put plist :level level))))) +(defun org-transclusion-menu-disable-auto () + (interactive) + (org-transclusion-menu-keyword-update-at-point + (lambda (plist) + (plist-put plist :disable-auto t)))) + (defun org-transclusion-menu-only-contents () (interactive) (org-transclusion-menu-keyword-update-at-point (lambda (plist) (plist-put plist :only-contents t)))) +(defun org-transclusion-menu-exclude-elements () + (interactive) + (org-transclusion-menu-keyword-update-at-point + (lambda (plist) + (let ((elements + (completing-read-multiple "Org-elements to exclude: " + org-element-all-elements))) + (if (not elements) (user-error "No element selected") + (plist-put plist :exclude-elements + (mapconcat 'identity elements "\s"))))))) + +(defun org-transclusion-menu-expand-links () + (interactive) + (org-transclusion-menu-keyword-update-at-point + (lambda (plist) + (plist-put plist :expand-links t)))) + ;;;; Functions (defun org-transclusion-menu-keyword-update-at-point (function) From 5ed761beee19c054072c0d3c06b4c35c9bd19342 Mon Sep 17 00:00:00 2001 From: Noboru Ota Date: Sun, 23 Apr 2023 17:51:44 +0200 Subject: [PATCH 5/6] test: test for menu --- test/test-2.0.org | 47 +++++++++++++++++++++++------------------------ 1 file changed, 23 insertions(+), 24 deletions(-) diff --git a/test/test-2.0.org b/test/test-2.0.org index 2a3ae35..0569af1 100644 --- a/test/test-2.0.org +++ b/test/test-2.0.org @@ -1,25 +1,25 @@ * Regression ** make from link This is a link to a [[id:20210501T171427.051019][Bertrand Russell]] wikipedia excerpt -#+transclude: [[id:20210501T171427.051019][Bertrand Russell]] +#+transclude: [[id:20210501T171427.051019][Bertrand Russell]] : ** test empty file #+transclude: [[file:empty.txt::2][empty text file]] ** test text -#+transclude: [[file:test.txt][text file]] +#+transclude: [[file:test.txt][text file]] ** test t/nil t/nil will be dropped after remove-at-point -#+transclude: [[file:test.txt][text file]] -#+transclude: t [[id:20210501T171427.051019][Bertrand Russell]] +#+transclude: [[file:test.txt][text file]] +#+transclude: t [[id:20210501T171427.051019][Bertrand Russell]] (setq inhibit-read-only nil) ** test -#+transclude: [[file:bertrand-russell.org::*Bertrand Russell - Wikipedia]] :level 1 +#+transclude: [[file:bertrand-russell.org::*Bertrand Russell - Wikipedia]] :level 1 ** Test =org-adapt-indentation= @@ -28,31 +28,31 @@ t/nil will be dropped after remove-at-point (setq org-adapt-indentation t) #+end_example -#+transclude: [[id:20210501T171427.051019][Bertrand Russell]] +#+transclude: [[id:20210501T171427.051019][Bertrand Russell]] ** Paragraph -#+transclude: [[file:./paragraph.org::para1]] +#+transclude: [[file:./paragraph.org::para1]] -#+transclude: [[file:./paragraph.org::para2]] +#+transclude: [[file:./paragraph.org::para2]] :expand-links ** Table -#+transclude: [[file:paragraph.org::table][Link to a table]] +#+transclude: [[file:paragraph.org::table][Link to a table]] #+begin_example (variable-pitch-mode -1) #+end_example -#+transclude: [[file:paragraph.org::table-with-link][Link to a table with a link]] +#+transclude: [[file:paragraph.org::table-with-link][Link to a table with a link]] ** Quote -#+transclude: [[file:paragraph.org::quote][Link to a quote]] +#+transclude: [[file:paragraph.org::quote][Link to a quote]] ** #Custom ID -#+transclude: [[file:testpara.org::#custom-id-1][Custom ID]] :level 2 +#+transclude: [[file:testpara.org::#custom-id-1][Custom ID]] :level 2 ** *Hadline -#+transclude: [[file:bertrand-russell.org::*Bertrand Russell - Wikipedia]] :level 2 :disable-auto +#+transclude: [[file:bertrand-russell.org::*Bertrand Russell - Wikipedia]] ** Filter @@ -67,12 +67,12 @@ t/nil will be dropped after remove-at-point #+end_example [[file:./test-no-first-section.org]] -#+transclude: [[file:./test-no-first-section.org]] +#+transclude: [[file:./test-no-first-section.org]] * Live-Sync ** center-block dynamic-block example-block export-block special-block verse-block -** drawer +** drawer #+begin_example (setq org-transclusion-exclude-elements '()) (setq org-transclusion-exclude-elements '(property-drawer)) @@ -85,7 +85,7 @@ t/nil will be dropped after remove-at-point ** latex-environment -** plain-list +** plain-list ** quote-block table #+transclude: [[file:paragraph.org::table][Link to a table]] @@ -110,7 +110,7 @@ t/nil will be dropped after remove-at-point #+transclude: [[file:bertrand-russell.org::*Bertrand Russell - Wikipedia]] :level 2 :disable-auto :only-contents * Exclude elements -#+transclude: [[id:2022-05-30T203553]] :only-contents :exclude-elements "keyword drawer headline" +#+transclude: [[id:2022-05-30T203553]] :only-contents :exclude-elements "keyword drawer headline" #+transclude: [[file:./test-no-first-section.org]] :exclude-elements "drawer keyword property-drawer" @@ -119,10 +119,10 @@ t/nil will be dropped after remove-at-point #+begin_src elisp (setq yank-excluded-properties '(:parent category field follow-link fontified font-lock-face help-echo intangible invisible keymap local-map mouse-face read-only yank-handler)) - + (setq yank-excluded-properties '(category field follow-link fontified font-lock-face help-echo intangible invisible keymap local-map mouse-face read-only yank-handler)) - + (setq org-transclusion-yank-remember-user-excluded-props '(:parent)) #+end_src @@ -158,15 +158,14 @@ t/nil will be dropped after remove-at-point 1. First item Text associated with the first item. - - #+transclude: [[file:paragraph.txt][link]] + + #+transclude: [[file:paragraph.txt][link]] 2. Second item * Level two * Test headlines only -#+transclude: [[id:2022-06-26T141859]] :exclude-elements "paragraph" - -#+transclude: [[id:2022-06-26T141859]] +#+transclude: [[id:2022-06-26T141859]] :exclude-elements "paragraph" +#+transclude: [[id:2022-06-26T141859]] From dcc59ee971506e865292acfeb313298a2a2a40ee Mon Sep 17 00:00:00 2001 From: Noboru Ota Date: Sun, 23 Apr 2023 17:52:12 +0200 Subject: [PATCH 6/6] docs: source comment to consider for extension for menu --- org-transclusion.el | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/org-transclusion.el b/org-transclusion.el index 6f07e6d..729e202 100644 --- a/org-transclusion.el +++ b/org-transclusion.el @@ -17,7 +17,7 @@ ;; Author: Noboru Ota ;; Created: 10 October 2020 -;; Last modified: 22 April 2023 +;; Last modified: 23 April 2023 ;; URL: https://github.com/nobiot/org-transclusion ;; Keywords: org-mode, transclusion, writing @@ -40,10 +40,13 @@ (require 'org-element) (require 'org-id) (require 'text-clone) +;; TODO font-lock should be part of the extension (require 'org-transclusion-font-lock) (require 'text-property-search) (require 'seq) +;; TODO Consider menut to be part of the extension +;;(require 'org-transclusion-menu) ;;;; Customization (defgroup org-transclusion nil @@ -783,7 +786,7 @@ off (removed)." ;; #+transclude: keyword exists. ;; Further checking the value (when-let ((str (org-element-property :value (org-element-at-point)))) - (dolist (fn org-transclusion-keyword-value-functions) plist + (dolist (fn org-transclusion-keyword-value-functions) (setq plist (append plist (funcall fn str))))) plist))))