Dev/menu - Discussion #169

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 <http://www.gnu.org/licenses/>.
+
+;; Author: Noboru Ota <me@nobiot.com>
+;; 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

org-transclusion.el

@@ -17,7 +17,7 @@
 
 ;; Author:        Noboru Ota <me@nobiot.com>
 ;; 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))

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]]