diff --git a/org-transclusion-menu.el b/org-transclusion-menu.el new file mode 100644 index 0000000..8eb91fd --- /dev/null +++ b/org-transclusion-menu.el @@ -0,0 +1,135 @@ +;;; 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 +;; x org-transclusion-keyword-value-disable-auto +;; x org-transclusion-keyword-value-only-contents +;; 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 + +(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)) + (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-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) + "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 diff --git a/org-transclusion.el b/org-transclusion.el index 2989ff0..729e202 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: 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 @@ -779,12 +782,11 @@ 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)))) - (dolist (fn org-transclusion-keyword-value-functions) plist + (dolist (fn org-transclusion-keyword-value-functions) (setq plist (append plist (funcall fn str))))) plist)))) @@ -1335,10 +1337,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 +1347,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)) 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]]