From 07a6e4601ac4459fc337f25e140650f4bdf8866b Mon Sep 17 00:00:00 2001 From: Yuchen Pei Date: Sat, 9 Sep 2023 12:53:02 +1000 Subject: [emacs] Fixing my-fetch-url etc. --- emacs/.emacs.d/lisp/my/my-net.el | 45 +++++++++++++++++++++++++++++++++++----- 1 file changed, 40 insertions(+), 5 deletions(-) (limited to 'emacs/.emacs.d/lisp/my/my-net.el') diff --git a/emacs/.emacs.d/lisp/my/my-net.el b/emacs/.emacs.d/lisp/my/my-net.el index 1ffbfae..0eafb7a 100644 --- a/emacs/.emacs.d/lisp/my/my-net.el +++ b/emacs/.emacs.d/lisp/my/my-net.el @@ -36,14 +36,47 @@ (car (url-path-and-query (url-generic-parse-url (url-unhex-string url))))))) -(defun my-fetch-url (url) +;; stolen from `eww-make-unique-file-name' +(defun my-make-unique-file-name (file directory) + "Uniquefy FILE under DIRECTORY. + +Like `expand-file-name', but make sure the file name has not been taken." + (cond + ((zerop (length file)) + (setq file "!")) + ((string-match "\\`[.]" file) + (setq file (concat "!" file)))) + (let ((count 1) + (stem file) + (suffix "")) + (when (string-match "\\`\\(.*\\)\\([.][^.]+\\)" file) + (setq stem (match-string 1 file) + suffix (match-string 2 file))) + (while (file-exists-p (expand-file-name file directory)) + (setq file (format "%s(%d)%s" stem count suffix)) + (setq count (1+ count))) + (expand-file-name file directory))) + +(defun my-fetch-url (url &optional no-overwrite) + "Fetch URL to a buffer, save it to a file, and switch to the buffer. + +The file is saved under `my-download-dir'. +If NO-OVERWRITE is non-nil, do not overwrite any existing file." (interactive "sURL: ") - (let ((file-name (expand-file-name (my-make-file-name-from-url url) - my-download-dir))) + (let ((file-name + (if no-overwrite + (my-make-unique-file-name + (my-make-file-name-from-url url) + my-download-dir) + (expand-file-name + (my-make-file-name-from-url url) + my-download-dir)))) (url-retrieve url 'my-fetch-url-save-and-switch (list file-name)))) - (defun my-fetch-url-save-and-switch (status file-name) + "A `url-retrieve' callback that saves the payload and switch to it. + +It checks the STATUS, and if it is ok, saves the payload to FILE-NAME." (when (plist-get status :error) (error "My fetch failed: %s" (plist-get status :error))) (my-delete-http-header) @@ -52,7 +85,9 @@ (coding-system-for-write 'utf-8)) (kill-buffer) (with-current-buffer buffer - (insert to-insert) + (let ((inhibit-read-only t)) + (erase-buffer) + (insert to-insert)) (goto-char (point-min)) (save-buffer) (revert-buffer t t)) -- cgit v1.2.3