From 8bf74036d8d0d1699d05dbc335d5155ee5888805 Mon Sep 17 00:00:00 2001 From: Yuchen Pei 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') 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