url-retrieve-synchronously改

用 curl 实现 url-retrieve-synchronously. 可配合 url-copy-file 使用。

使用：

#+name: 2025-08-01-13-13
#+begin_src emacs-lisp :results silent :lexical t
(!def 'ursa
 <<2025-07-30-09-05>>)
#+end_src

(ursa t) ;; 使能
(url-retrieve-synchronously "https://google.com" nil nil 5)
(ursa nil) ;; 禁用

实现：

#+name: 2025-07-30-09-05
#+begin_src emacs-lisp :results silent :lexical t
;; url-retrieve-synchronously advice
(!let ((qurs 'url-retrieve-synchronously) post adv) 
 (!def adv
  (lambda (&optional urs url silent u timeout)
    (cond
     ((ignore
       (when (url-p url)
         (setq url (url-recreate-url url)))))
     ((or (not (executable-find "curl"))
          (not (string-match-p "^http[s]?:" url)))
      (funcall urs url silent u timeout))
     (t
      (!let* ((inhibit-message silent) B P wait
              (opt `("-is" "--ssl-no-revoke" ,url)))
       (with-current-buffer
           (generate-new-buffer (format " *%s*" url))
         (set-buffer-multibyte nil)
         (setq B (current-buffer)))
       (setq P (apply #'start-process
                      "curl" B "curl" opt))
       (!def wait
        (lambda ()
          (while (process-live-p P) (sit-for 1))))
       (message "Retrieving %s..." url)
       (if (null timeout) (wait)
         (with-timeout
             (timeout
              (message "Retrieving %s timeout." url)
              (delete-process P) (kill-buffer B))
           (wait)))
       (when (eq (process-status P) 'exit)
         (message "Retrieving %s done." url)
         (with-current-buffer B (post) B)))))))
 (!def post
  (lambda ()
    (save-excursion
      (goto-char (point-min))
      (save-match-data
        (when (re-search-forward "^\r$" nil t)
          (delete-region
           (match-beginning 0) (match-end 0))))
      (goto-char (point-max))
      (forward-line -1) (delete-line))))
 (lambda (arg)
   (if (null arg) (advice-remove qurs adv)
     (advice-add qurs :around adv))))
#+end_src

#+name: 2026-01-30-12-56
#+begin_src emacs-lisp :results none :lexical t
;; url-retrieve-synchronously advice
(!let ((urs 'url-retrieve-synchronously))
:collect-symbol: !def
(!def wait (![P](while(process-live-p P)(sit-for 1))))
(!def adv
 (![&optional urs url silent u timeout]
  (cond*
   ((bind* (_ (url-p url)))
    (setq url (url-recreate-url url)))
   ((or (not (executable-find "curl"))
        (not (string-match-p "^http[s]?:" url)))
    (urs url silent u timeout))
   ((bind* (cmd "curl") (inhibit-message silent)
           (opt `("-is" "--ssl-no-revoke" ,url))
           (B (format " *%s*" url)) P
           (B (generate-new-buffer B)))
    (with-current-buffer B (set-buffer-multibyte nil))
    (setq P (apply #'start-process cmd B cmd opt))
    (message "Retrieving %s..." url)
    (if (null timeout) (wait P)
      (with-timeout
          (timeout (message "Timeout: %s." url)
           (delete-process P) (kill-buffer B))
        (wait P))))
   ((eq (process-status P) 'exit)
    (message "Retrieving %s done." url)
    (with-current-buffer B
      (save-excursion
        (goto-char (point-min))
        (save-match-data
          (when (re-search-forward "^\r$" nil t)
            (delete-region
             (match-beginning 0) (match-end 0))))
        (goto-char (point-max))
        (forward-line -1) (delete-line))
      B)))))
(![on](if on (advice-add urs :around adv)
         (advice-remove urs adv))))
#+end_src