Re: [PATCH] ob-tangle: Add flag to optionally remove files before writing

[Ihor Radchenko]

[ Moving the discussion back to public in Org mailing list ]

Olivier Lischer <olivier.lischer@liolin.ch> writes:

> I hope that this time I have changed the patch the way you wanted it.
> If anything is still wrong, I am happy to improve it.

Thanks for the update!
Unfortunately, your patch has unbalanced parenthesis and will not work.
I have modified your patch to make things work and to make it conform to
Elisp code conventions. I also removed spurious change in the existing
variable.

See the attached.

Please, let me know if you want to change anything.
Also, if you can, please test my patch with your use-case.

>From b8d2a8506c9b63ad9fefbf8caaefb5de94001eb7 Mon Sep 17 00:00:00 2001
Message-ID: 
<b8d2a8506c9b63ad9fefbf8caaefb5de94001eb7.1709118067.git.yantar92@posteo.net>
From: Olivier Lischer <olivier.lischer@liolin.ch>
Date: Tue, 23 Jan 2024 21:02:20 +0100
Subject: [PATCH] ob-tangle: Add flag to optionally remove files before writing

* lisp/ob-tangle.el: Add new custom option
`org-babel-tangle-remove-file-before-write'.
(org-babel-tangle): Remove file before writing according to the value
of `org-babel-tangle-remove-file-before-write'.

The variable `org-babel-tangle-remove-file-before-write' adds support
for the current and old behaviour of `org-babel-tangle'.

Link: https://list.orgmode.org/orgmode/877cjzhjtg.fsf@liolin.ch/
Co-authored-by: Ihor Radchenko <yantar92@posteo.net>

TINYCHANGE
---
 etc/ORG-NEWS      | 10 ++++++++++
 lisp/ob-tangle.el | 31 ++++++++++++++++++++++++++++++-
 2 files changed, 40 insertions(+), 1 deletion(-)

diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index dc0d9c0ad..26f0c90f9 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -928,6 +928,16 @@ properties, links to headlines in the file can also be 
made more
 robust by using the file id instead of the file path.
 
 ** New features
+*** =ob-tangle.el=: New flag to remove tangle targets before writing
+
+When ~org-babel-tangle-remove-file-before-write~ is set to ~t~ the
+tangle target is removed before writing.  This will allow overwriting
+read-only tangle targets.  However, when tangle target is a symlink,
+this will convert the tangle target into an ordinary file.
+
+The default value is ~auto~ -- overwrite tangle targets when they are
+read-only.
+
 *** ~org-bibtex-yank~ accepts a prefix argument
 
 When called with a prefix argument, ~org-bibtex-yank~ adds data to the
diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el
index 281ab13d4..9bb69e5da 100644
--- a/lisp/ob-tangle.el
+++ b/lisp/ob-tangle.el
@@ -166,6 +166,23 @@ (defcustom org-babel-tangle-default-file-mode #o644
   :package-version '(Org . "9.6")
   :type 'integer)
 
+(defcustom org-babel-tangle-remove-file-before-write 'auto
+  "How to overwrite the existing tangle target.
+When set to nil, `org-babel-tangle' will replace contents of an existing
+tangle target (and fail when tangle target is read-only).
+When set to t, the tangle target (including read-only) will be deleted
+first and a new file, possibly with different ownership and
+permissions, will be created.
+When set to symbol `auto', overwrite read-only tangle targets and
+replace contents otherwise."
+  :group 'org-babel-tangle
+  :package-version '(Org . "9.7")
+  :type '(choice
+         (const :tag "Replace contents, but keep the same file" nil)
+          (const :tag "Re-create file" t)
+          (const :tag "Re-create when read-only" auto))
+  :safe t)
+
 (defun org-babel-find-file-noselect-refresh (file)
   "Find file ensuring that the latest changes on disk are
 represented in the file."
@@ -323,7 +340,19 @@ (defun org-babel-tangle (&optional arg target-file lang-re)
                        (error "Not allowed to tangle into the same file as 
self"))
                      ;; We do not erase, but overwrite previous file
                      ;; to preserve any existing symlinks.
-                    (write-region nil nil file-name)
+                     ;; This behavior is modified using
+                     ;; `org-babel-tangle-remove-file-before-write' to
+                     ;; tangle to read-only files.
+                     (when (and
+                           (file-exists-p file-name)
+                            (pcase org-babel-tangle-remove-file-before-write
+                              (`auto (not (file-writable-p file-name)))
+                              (`t t)
+                              (`nil nil)
+                              (_ (error "Invalid value of 
`org-babel-tangle-remove-file-before-write': %S"
+                                       
org-babel-tangle-remove-file-before-write))))
+                       (delete-file file-name))
+                     (write-region nil nil file-name)
                     (mapc (lambda (mode) (set-file-modes file-name mode)) 
modes))
                    (push file-name path-collector))))))
         (if (equal arg '(4))
-- 
2.43.0

(For records, below is the original patch, sent off-list)

> From 1523056a0dff5de64ed361d5bb1ad7d92ec7e369 Mon Sep 17 00:00:00 2001
> From: Olivier Lischer <olivier.lischer@liolin.ch>
> Date: Tue, 23 Jan 2024 21:02:20 +0100
> Subject: [PATCH] ob-tangle: Add flag to optionally remove files before writing
>
> * lisp/ob-tangle.el: Add variable
> `org-babel-tangle-remove-file-before-write'.
> (org-babel-tangle): Remove file before writing when
> `org-babel-tangle-remove-file-before-write' is set.
>
> The variable `org-babel-tangle-remove-file-before-write' adds support
> for the current and old behaviour of `org-babel-tangle'.
>
> TINYCHANGE
> ---
>  etc/ORG-NEWS      |  4 ++++
>  lisp/ob-tangle.el | 15 +++++++++++++--
>  2 files changed, 17 insertions(+), 2 deletions(-)
>
> diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
> index f537486d4..c7c3ee264 100644
> --- a/etc/ORG-NEWS
> +++ b/etc/ORG-NEWS
> @@ -800,6 +800,10 @@ Completion is enabled for links to man pages added using 
> ~org-insert-link~:
>  =C-c C-l man RET emacscl TAB= to get =emacsclient=.  Of course, the ~ol-man~
>  library should be loaded first.
>  
> +*** =ob-tangle.el=: Add flag to optionally remove files before writing
> +
> +When ~org-babel-tangle-remove-file-before-write~ is set to ~t~ the file is 
> removed before writing.
> +
>  ** New functions and changes in function arguments
>  *** New API functions to store data within ~org-element-cache~
>  
> diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el
> index 72089a9a5..b77a19d3b 100644
> --- a/lisp/ob-tangle.el
> +++ b/lisp/ob-tangle.el
> @@ -141,7 +141,7 @@ controlled by the :comments header argument."
>    :version "24.1"
>    :type 'string)
>  
> -(defcustom org-babel-tangle-uncomment-comments nil
> +(defcustom org-babel-tangle-uncomment-comments 'auto
>    "Inhibits automatic commenting and addition of trailing newline
>  of tangle comments.  Use `org-babel-tangle-comment-format-beg'
>  and `org-babel-tangle-comment-format-end' to customize the format
> @@ -166,6 +166,12 @@ read-write permissions for the user, read-only for 
> everyone else."
>    :package-version '(Org . "9.6")
>    :type 'integer)
>  
> +(defcustom org-babel-tangle-remove-file-before-write 'auto
> +  "Prevents the deletion of an existing file before tangle"
> +  :group 'org-babel-tangle
> +  :package-version '(Org . "9.7")
> +  :type 'boolean)
> +
>  (defun org-babel-find-file-noselect-refresh (file)
>    "Find file ensuring that the latest changes on disk are
>  represented in the file."
> @@ -315,7 +321,12 @@ matching a regular expression."
>                                         tangle-buf nil nil)))))))
>                       ;; We do not erase, but overwrite previous file
>                       ;; to preserve any existing symlinks.
> -                  (write-region nil nil file-name)
> +                     ;; This behavior can be changed using
> +                     ;; org-babel-tangle-remove-file-before-write
> +                     ;; to tangle to read-only files.
> +                     (when (and (file-exists-p file-name) (not 
> (file-writeable-p file-name) org-babel-tangle-remove-file-before-write)
> +                       (delete-file file-name))
> +                     (write-region nil nil file-name)
>                    (mapc (lambda (mode) (set-file-modes file-name mode)) 
> modes))
>                     (push file-name path-collector))))))
>        (if (equal arg '(4))
> -- 
> 2.44.0
>

-- 
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>