From 8bf74036d8d0d1699d05dbc335d5155ee5888805 Mon Sep 17 00:00:00 2001
From: Yuchen Pei <id@ypei.org>
Date: Tue, 26 Dec 2023 16:47:17 +1100
Subject: [emacs] Fixing a few things
- link-gopher: some formatting
- my-org: extend my-org-attach-copy-attached-orgs to fallback to a
staging area
- my-libgen: better naming just in case
---
emacs/.emacs.d/lisp/my/link-gopher.el | 32 ++++++++++----------
emacs/.emacs.d/lisp/my/my-libgen.el | 15 +++++-----
emacs/.emacs.d/lisp/my/my-org.el | 56 +++++++++++++++++++++++++++--------
3 files changed, 68 insertions(+), 35 deletions(-)
(limited to 'emacs/.emacs.d/lisp/my')
diff --git a/emacs/.emacs.d/lisp/my/link-gopher.el b/emacs/.emacs.d/lisp/my/link-gopher.el
index 11bb75d..5e3fe77 100644
--- a/emacs/.emacs.d/lisp/my/link-gopher.el
+++ b/emacs/.emacs.d/lisp/my/link-gopher.el
@@ -50,12 +50,12 @@ no duplicates."
(let ((results) (clean-url) (hash (make-hash-table :test 'equal)))
(while (re-search-forward
"\\(href\\|HREF\\|src\\|SRC\\)\\ *=\\ *['\"]\\([^\"']+\\)['\"]" nil t)
- (setq clean-url (link-gopher-clean-url (match-string 2) url))
- (when (or (not filter-regexp)
- (string-match filter-regexp clean-url))
- (when (not (gethash clean-url hash))
- (puthash clean-url t hash)
- (push clean-url results))))
+ (setq clean-url (link-gopher-clean-url (match-string 2) url))
+ (when (or (not filter-regexp)
+ (string-match filter-regexp clean-url))
+ (when (not (gethash clean-url hash))
+ (puthash clean-url t hash)
+ (push clean-url results))))
(reverse results))))
(defun link-gopher-clean-url (url current-url)
"clean url
@@ -65,17 +65,17 @@ no duplicates."
removing frags
"
(let* ((current-domain
- (progn (string-match "^\\(.*://[^/]+/\\)" current-url)
- (match-string 1 current-url)))
- (current-domain-dir-path
- (progn (string-match "^\\(.*/\\)" current-url)
- (match-string 1 current-url)))
- (url-no-frags (replace-regexp-in-string "#.*" "" url)))
- (url-encode-url
+ (progn (string-match "^\\(.*://[^/]+/\\)" current-url)
+ (match-string 1 current-url)))
+ (current-domain-dir-path
+ (progn (string-match "^\\(.*/\\)" current-url)
+ (match-string 1 current-url)))
+ (url-no-frags (replace-regexp-in-string "#.*" "" url)))
+ (url-encode-url
(cond ((string-match "://" url-no-frags) url-no-frags)
- ((string-match "^//" url-no-frags) (concat "https:" url-no-frags))
- ((string-match "^/" url-no-frags) (concat current-domain url-no-frags))
- (t (concat current-domain-dir-path url-no-frags))))))
+ ((string-match "^//" url-no-frags) (concat "https:" url-no-frags))
+ ((string-match "^/" url-no-frags) (concat current-domain url-no-frags))
+ (t (concat current-domain-dir-path url-no-frags))))))
(defun link-gopher-get-all-links-in-buffer (filter-regexp)
(let ((results) (hash (make-hash-table :test 'equal)))
(save-excursion
diff --git a/emacs/.emacs.d/lisp/my/my-libgen.el b/emacs/.emacs.d/lisp/my/my-libgen.el
index c7fad33..92a6b61 100644
--- a/emacs/.emacs.d/lisp/my/my-libgen.el
+++ b/emacs/.emacs.d/lisp/my/my-libgen.el
@@ -134,13 +134,14 @@
(alist-get 'coverurl info)))))
(defun my-libgen-format-filename (info)
- (format
- "%s - %s (%s) [%s].%s"
- (alist-get 'author info)
- (alist-get 'title info)
- (alist-get 'year info)
- (alist-get 'identifier info)
- (alist-get 'extension info)))
+ (replace-regexp-in-string "[:;]" "_"
+ (format
+ "%s - %s (%s) [%s].%s"
+ (alist-get 'author info)
+ (alist-get 'title info)
+ (alist-get 'year info)
+ (alist-get 'identifier info)
+ (alist-get 'extension info))))
(defvar my-libgen-download-dir "~/Downloads")
(defun my-libgen-download-action ()
diff --git a/emacs/.emacs.d/lisp/my/my-org.el b/emacs/.emacs.d/lisp/my/my-org.el
index b189b78..00a8a0f 100644
--- a/emacs/.emacs.d/lisp/my/my-org.el
+++ b/emacs/.emacs.d/lisp/my/my-org.el
@@ -822,22 +822,54 @@ When BLOCK-REGEXP is non-nil, use this regexp to find blocks."
my-org-attach-copy-attached-doc-exts "\\|")))
(defun my-org-attach-copy-attached-docs ()
+ "Copy docs to a mount point.
+
+Use `my-org-attach-copy-attached-targets', which is an list
+of (name to-dir staging). Try copying to to-dir.
+
+On failure, hard link to staging.
+On success, also move everything from staging to to-dir."
(interactive)
- (let* ((name
- (completing-read "Copy attached docs to: "
- my-org-attach-copy-attached-targets))
- (path (alist-get name my-org-attach-copy-attached-targets
- nil nil #'equal)))
- (let ((basedir (org-attach-dir)))
+ (pcase-let* ((name
+ (completing-read "Copy attached docs to: "
+ my-org-attach-copy-attached-targets
+ nil t))
+ (`(,to ,staging) (alist-get name my-org-attach-copy-attached-targets
+ nil nil #'equal)))
+ (let ((basedir (org-attach-dir))
+ (failed nil))
(dolist (attached (org-attach-file-list basedir))
(when (string-match my-org-attach-copy-attached-doc-re attached)
- (message "Copying %s to %s (%s)..." attached name path)
- (copy-file (file-name-concat basedir attached)
+ (message "Copying %s to %s (%s)..." attached name to)
+ (condition-case nil
+ (copy-file (file-name-concat basedir attached)
+ (file-name-concat
+ to
+ (replace-regexp-in-string ":" "_" attached))
+ t)
+ (error
+ (message "Hardlinking %s to %s staging area (%s)"
+ attached name staging)
+ (setq failed t)
+ (add-name-to-file
+ (file-name-concat basedir attached)
+ (file-name-concat
+ staging
+ (replace-regexp-in-string ":" "_" attached))
+ t)))
+ (message "Done!")))
+ (unless failed
+ (dolist (staged
+ (directory-files staging nil
+ my-org-attach-copy-attached-doc-re))
+ (message "Moving staged %s to %s (%s)..." staged name to)
+ (copy-file (file-name-concat staging staged)
(file-name-concat
- path
- (replace-regexp-in-string ":" "_" attached)))
- (message "Done!")))))
- )
+ to
+ (replace-regexp-in-string ":" "_" staged))
+ t)
+ (delete-file (file-name-concat staging staged))
+ (message "Done!"))))))
(defun my-org-attach-all-url-plaintext (arg)
(interactive "P")
--
cgit v1.2.3