emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[nongnu] elpa/request ec35961 04/11: In for a penny, in for a pound


From: ELPA Syncer
Subject: [nongnu] elpa/request ec35961 04/11: In for a penny, in for a pound
Date: Sat, 13 Feb 2021 19:57:09 -0500 (EST)

branch: elpa/request
commit ec35961cf7c768931330d8b5f311f6bfba44bb0c
Author: dickmao <none>
Commit: dickmao <none>

    In for a penny, in for a pound
    
    Procrastination cam be a full-time job.
---
 .github/workflows/test.yml  |  41 ++++---
 .gitignore                  |   2 +
 Cask                        |   4 +-
 Makefile                    |  13 ++-
 README.rst => README.in.rst |   4 +-
 README.rst                  |   6 +-
 request-deferred.el         |  14 +--
 request.el                  | 261 ++++++++++++++++++--------------------------
 tests/request-testing.el    |   2 +-
 tests/test-request.el       |   6 +-
 tools/melpazoid.sh          |  35 ++++++
 tools/readme-sed.sh         |  17 +++
 12 files changed, 208 insertions(+), 197 deletions(-)

diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml
index a51caa6..e6c3e7d 100644
--- a/.github/workflows/test.yml
+++ b/.github/workflows/test.yml
@@ -18,9 +18,9 @@ jobs:
     runs-on: ${{ matrix.os }}
     strategy:
       matrix:
-        os: [ubuntu-latest, macos-latest]
+        os: [ubuntu-latest]
         emacs_version: [24.5, 25.3, 26.3, 27.1]
-        python_version: [2.7]
+        python_version: [2.7, 3.6]
 
     steps:
     - uses: actions/checkout@v1
@@ -37,13 +37,7 @@ jobs:
       if: startsWith(runner.os, 'Linux')
       with:
         path: ~/.cache/pip
-        key: ${{ runner.os }}-pip-000
-
-    - uses: actions/cache@v1
-      if: startsWith(runner.os, 'macOS')
-      with:
-        path: ~/Library/Caches/pip
-        key: ${{ runner.os }}-pip-000
+        key: ${{ runner.os }}-${{ matrix.python_version }}-pip-000
 
     - uses: actions/cache@v1
       with:
@@ -68,39 +62,42 @@ jobs:
         echo "LD_LIBRARY_PATH=$HOME/.local/lib" >> $GITHUB_ENV
 
     - name: apt-get
-      if: startsWith(runner.os, 'Linux')
+      if: |
+        startsWith(matrix.python_version, '2') ||
+        startsWith(matrix.emacs_version, '27')
       run: |
         sudo apt-get -yq update
         DEBIAN_FRONTEND=noninteractive sudo apt-get -yq install gnutls-bin 
sharutils gnupg2 dirmngr libreadline-dev libcurl4-openssl-dev virtualenv
 
-    - name: gnupg
-      if: startsWith(runner.os, 'macOS')
-      run: brew list gnupg &>/dev/null || HOMEBREW_NO_AUTO_UPDATE=1 brew 
install gnupg
-
     - name: dependencies
+      if: startsWith(matrix.python_version, '2')
       run: |
         pip install yq setuptools wheel
         pip install Flask==1.0.2 tornado==5.1.1
         pip uninstall -y Werkzeug
         pip install Werkzeug==0.14.1
 
-    - name: versions
-      run: |
-        curl --version
-        emacs --version
-        gpg --version
-        python --version
-
     - name: cask
+      if: |
+        startsWith(matrix.python_version, '2') ||
+        startsWith(matrix.emacs_version, '27')
       run: |
         sh tools/install-cask.sh
         cask link list
 
+    - name: lint
+      if: |
+        startsWith(matrix.python_version, '3') &&
+        startsWith(matrix.emacs_version, '27')
+      run: make lint
+      continue-on-error: ${{ matrix.emacs_version == 'snapshot' }}
+
     - name: test-install
-      if: startsWith(runner.os, 'Linux')
+      if: startsWith(matrix.python_version, '2')
       run: make test-install
       continue-on-error: ${{ matrix.emacs_version == 'snapshot' }}
 
     - name: test
+      if: startsWith(matrix.python_version, '2')
       run: make test
       continue-on-error: ${{ matrix.emacs_version == 'snapshot' }}
diff --git a/.gitignore b/.gitignore
index ce13c9a..b661e58 100644
--- a/.gitignore
+++ b/.gitignore
@@ -3,3 +3,5 @@
 dist
 doc/build
 doc/source/index.rst
+tests/test-install
+melpazoid-master
diff --git a/Cask b/Cask
index 6a8fa8e..726e94d 100644
--- a/Cask
+++ b/Cask
@@ -5,4 +5,6 @@
 
 (development
  (depends-on "ert")
- (depends-on "deferred"))
+ (depends-on "deferred")
+ (depends-on "pkg-info")
+ (depends-on "package-lint"))
diff --git a/Makefile b/Makefile
index d49da06..dce02ea 100644
--- a/Makefile
+++ b/Makefile
@@ -36,6 +36,12 @@ test-1:
 #  global-auto-revert-mode [github #132]
        EL_REQUEST_NO_CAPTURE_MESSAGE=$(EL_REQUEST_NO_CAPTURE_MESSAGE) 
EL_REQUEST_MESSAGE_LEVEL=$(EL_REQUEST_MESSAGE_LEVEL) $(CASK) emacs -Q --batch 
-L . -L tests -l test-request.el --eval "(global-auto-revert-mode)" -f 
ert-run-tests-batch-and-exit
 
+README.rst: README.in.rst request.el
+       grep ';;' request.el \
+           | awk '/;;;\s*Commentary/{within=1;next}/;;;\s*/{within=0}within' \
+           | sed -e 's/^\s*;;*\s*//g' \
+           | tools/readme-sed.sh "COMMENTARY" README.in.rst > README.rst
+
 .PHONY: cask
 cask: $(CASK_DIR)
 $(CASK_DIR): Cask
@@ -48,11 +54,16 @@ compile: cask
                  (let ((byte-compile-error-on-warn t)) (cask-cli/build)))" 
2>&1 | egrep -a "(Warning|Error):") ; (ret=$$? ; rm -f $(ELCTESTS) && exit 
$$ret)
        ! ($(CASK) eval "(let ((byte-compile-error-on-warn t)) 
(cask-cli/build))" 2>&1 | egrep -a "(Warning|Error):") ; (ret=$$? ; $(CASK) 
clean-elc && exit $$ret)
 
+.PHONY: lint
+lint: compile
+       bash -ex tools/melpazoid.sh
+
 .PHONY: clean
 clean:
        $(CASK) clean-elc
        make -C doc clean
-
+       rm -rf tests/test-install
+       rm -rf melpazoid-master/emacs-request
 
 .PHONY: dist-clean
 dist-clean:
diff --git a/README.rst b/README.in.rst
similarity index 97%
copy from README.rst
copy to README.in.rst
index b3666d8..47a22b7 100644
--- a/README.rst
+++ b/README.in.rst
@@ -4,9 +4,7 @@
  request.el -- an elisp HTTP library
 ====================================
 
-Uses ``curl`` as its backend or emacs's native ``url.el`` library if ``curl`` 
is not found.
-
-The default encoding for requests is ``utf-8``.  Please explicitly specify 
``:encoding 'binary`` for binary data.
+.. COMMENTARY (see Makefile)
 
 Install
 =======
diff --git a/README.rst b/README.rst
index b3666d8..100d625 100644
--- a/README.rst
+++ b/README.rst
@@ -4,9 +4,11 @@
  request.el -- an elisp HTTP library
 ====================================
 
-Uses ``curl`` as its backend or emacs's native ``url.el`` library if ``curl`` 
is not found.
+Uses ``curl`` as its backend or Emacs's native ``url.el`` library if
+``curl`` is not found.
 
-The default encoding for requests is ``utf-8``.  Please explicitly specify 
``:encoding 'binary`` for binary data.
+The default encoding for requests is ``utf-8``.  Please explicitly specify
+``:encoding 'binary`` for binary data.
 
 Install
 =======
diff --git a/request-deferred.el b/request-deferred.el
index fd67907..c4f248e 100644
--- a/request-deferred.el
+++ b/request-deferred.el
@@ -4,7 +4,7 @@
 
 ;; Author: Takafumi Arakaki <aka.tkf at gmail.com>
 ;; URL: https://github.com/tkf/emacs-request
-;; Package-Requires: ((deferred "0.3.1") (request "0.2.0"))
+;; Package-Requires: ((emacs "24.1") (deferred "0.3.1") (request "0.3"))
 ;; Version: 0.2.0
 
 ;; This file is NOT part of GNU Emacs.
@@ -21,11 +21,11 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with request-deferred.el.
-;; If not, see <http://www.gnu.org/licenses/>.
+;; If not, see <https://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
-;;
+;; Trivial wrapper to request library returing kiwanami deferred object.
 
 ;;; Code:
 
@@ -33,7 +33,7 @@
 (require 'deferred)
 
 (defun request-deferred (url &rest args)
-  "Send a request and return deferred object associated with it.
+  "Return deferred object associated requesting URL with ARGS.
 
 Following deferred callback takes a response object regardless of
 the response result.  To make sure no error occurs during the
@@ -47,12 +47,10 @@ Example::
   (require 'request-deferred)
 
   (deferred:$
-    (request-deferred \"http://httpbin.org/get\"; :parser 'json-read)
+    (request-deferred \"https://httpbin.org/get\"; :parser 'json-read)
     (deferred:nextc it
       (lambda (response)
-        (message \"Got: %S\" (request-response-data response)))))
-"
-
+        (message \"Got: %S\" (request-response-data response)))))"
   (let* ((d (deferred:new #'identity))
          (callback-post (apply-partially
                          (lambda (d &rest args)
diff --git a/request.el b/request.el
index f29a4c1..37e4aac 100644
--- a/request.el
+++ b/request.el
@@ -23,21 +23,15 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with request.el.
-;; If not, see <http://www.gnu.org/licenses/>.
+;; If not, see <https://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
-;; Request.el is a HTTP request library with multiple backends.  It
-;; supports url.el which is shipped with Emacs and curl command line
-;; program.  User can use curl when s/he has it, as curl is more reliable
-;; than url.el.  Library author can use request.el to avoid imposing
-;; external dependencies such as curl to users while giving richer
-;; experience for users who have curl.
-
-;; Following functions are adapted from GNU Emacs source code.
-;; Free Software Foundation holds the copyright of them.
-;; * `request--process-live-p'
-;; * `request--url-default-expander'
+;; Uses ``curl`` as its backend or Emacs's native ``url.el`` library if
+;; ``curl`` is not found.
+;;
+;; The default encoding for requests is ``utf-8``.  Please explicitly specify
+;; ``:encoding 'binary`` for binary data.
 
 ;;; Code:
 
@@ -115,41 +109,12 @@ See `request-log-level'."
                  (const :tag "Level TRACE" trace)
                  (const :tag "Level BLATHER" blather)))
 
-
-;;; Utilities
-
-(defun request--safe-apply (function &rest arguments)
-  "Apply FUNCTION with ARGUMENTS, suppressing any errors."
-  (condition-case nil
-      (apply #'apply function arguments)
-    ((debug error))))
-
-(defun request--safe-call (function &rest arguments)
-  (request--safe-apply function arguments))
-
-;; (defun request--url-no-cache (url)
-;;   "Imitate `cache=false' of `jQuery.ajax'.
-;; See: http://api.jquery.com/jQuery.ajax/";
-;;   ;; FIXME: parse URL before adding ?_=TIME.
-;;   (concat url (format-time-string "?_=%s")))
-
 (defmacro request--document-function (function docstring)
   "Document FUNCTION with DOCSTRING.  Use this for defstruct accessor etc."
   (declare (indent defun)
            (doc-string 2))
   `(put ',function 'function-documentation ,docstring))
 
-(defun request--process-live-p (process)
-  "Copied from `process-live-p' for backward compatibility (Emacs < 24).
-Adapted from lisp/subr.el.
-FSF holds the copyright of this function:
-  Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2012
-    Free Software Foundation, Inc."
-  (memq (process-status process) '(run open listen connect stop)))
-
-
-;;; Logging
-
 (defconst request--log-level-def
   '(;; debugging
     (blather . 60) (trace . 50) (debug . 40)
@@ -159,43 +124,29 @@ FSF holds the copyright of this function:
     (warn . 10) (error . 0))
   "Named logging levels.")
 
-(defun request--log-level-as-int (level)
-  (if (integerp level)
-      level
-    (or (cdr (assq level request--log-level-def))
-        0)))
-
 (defvar request-log-buffer-name " *request-log*")
 
-(defun request--log-buffer ()
-  (get-buffer-create request-log-buffer-name))
-
 (defmacro request-log (level fmt &rest args)
+  "Main logging function at warning LEVEL in FMT with ARGS."
   (declare (indent 1))
-  `(let ((level (request--log-level-as-int ,level))
-         (log-level (request--log-level-as-int request-log-level))
-         (msg-level (request--log-level-as-int request-message-level)))
-     (when (<= level (max log-level msg-level))
-       (let ((msg (format "[%s] %s" ,level
-                          (condition-case err
-                              (format ,fmt ,@args)
-                            (error (format "
-!!! Logging error while executing:
-%S
-!!! Error:
-%S"
-                                           ',args err))))))
-         (when (<= level log-level)
-           (with-current-buffer (request--log-buffer)
-             (setq buffer-read-only t)
-             (let ((inhibit-read-only t))
-               (goto-char (point-max))
-               (insert msg "\n"))))
-         (when (<= level msg-level)
-           (message "%s" msg))))))
-
-
-;;; HTTP specific utilities
+  `(cl-flet ((log-level-as-int
+              (level)
+              (if (integerp level)
+                  level
+                (or (cdr (assq level request--log-level-def)) 0))))
+     (let ((level (log-level-as-int ,level))
+           (log-level (log-level-as-int request-log-level))
+           (msg-level (log-level-as-int request-message-level)))
+       (when (<= level (max log-level msg-level))
+         (let ((msg (format "[%s] %s" ,level (format ,fmt ,@args))))
+           (when (<= level log-level)
+             (with-current-buffer (get-buffer-create request-log-buffer-name)
+               (setq buffer-read-only t)
+               (let ((inhibit-read-only t))
+                 (goto-char (point-max))
+                 (insert msg "\n"))))
+           (when (<= level msg-level)
+             (message "%s" msg)))))))
 
 (defconst request--url-unreserved-chars
   '(?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y 
?z
@@ -207,7 +158,7 @@ This is used for making `request--urlencode-alist' RFC 3986 
compliant
 for older Emacs versions.")
 
 (defun request--urlencode-alist (alist)
-  ;; FIXME: make monkey patching `url-unreserved-chars' optional
+  "Hexify ALIST fields according to RFC3986."
   (let ((url-unreserved-chars request--url-unreserved-chars))
     (cl-loop for sep = "" then "&"
              for (k . v) in alist
@@ -216,8 +167,6 @@ for older Emacs versions.")
              concat "="
              concat (url-hexify-string (format "%s" v)))))
 
-
-;;; Header parser
 
 (defun request--parse-response-at-point ()
   "Parse the first header line such as \"HTTP/1.1 200 OK\"."
@@ -226,11 +175,9 @@ for older Emacs versions.")
           :code (string-to-number (match-string 2)))))
 
 (defun request--goto-next-body (&optional noerror)
+  "Scan forward to next blank line allowing NOERROR if missing."
   (re-search-forward "^\r\n" nil noerror))
 
-
-;;; Response object
-
 (cl-defstruct request-response
   "A structure holding all relevant information of a request."
   status-code history data error-thrown symbol-status url
@@ -239,6 +186,7 @@ for older Emacs versions.")
   -buffer -raw-header -timer -backend)
 
 (defmacro request--document-response (function docstring)
+  "Append to FUNCTION's DOCSTRING some more canned verbiage."
   (declare (indent defun) (doc-string 2))
   `(request--document-function ,function ,(concat docstring "
 
@@ -314,12 +262,9 @@ Examples::
         ;; separated value [#rfc2616-sec4]_.
         (mail-fetch-field field-name nil t)))))
 ;; .. [#rfc2616-sec4] RFC2616 says this is the right thing to do
-;;    (see http://tools.ietf.org/html/rfc2616.html#section-4.2).
+;;    (see https://tools.ietf.org/html/rfc2616.html#section-4.2).
 ;;    Python's requests module does this too.
 
-
-;;; Backend dispatcher
-
 (defconst request--backend-alist
   '((url-retrieve
      . ((request             . request--url-retrieve)
@@ -350,34 +295,24 @@ let's stick to manual dispatch for now.")
    (or (assoc-default request-backend request--backend-alist)
        (error "%S is not valid `request-backend'" request-backend))))
 
-
-;;; Cookie
 
 (defun request-cookie-string (host &optional localpart secure)
-  "Return cookie string (like `document.cookie').
-
+  "Lookup HOST LOCALPART SECURE in cookie jar as`document.cookie` string.
 Example::
 
- (request-cookie-string \"127.0.0.1\" \"/\")  ; => \"key=value; key2=value2\""
+  (request-cookie-string \"127.0.0.1\" \"/\")  ; => \"key=value; key2=value2\""
   (mapconcat (lambda (nv) (concat (car nv) "=" (cdr nv)))
              (request-cookie-alist host localpart secure)
              "; "))
 
 (defun request-cookie-alist (host &optional localpart secure)
-  "Return cookies as an alist.
+  "Lookup HOST LOCALPART SECURE in cookie jar as alist.
 
 Example::
 
- (request-cookie-alist \"127.0.0.1\" \"/\")  ; => ((\"key\" . \"value\") ...)"
+  (request-cookie-alist \"127.0.0.1\" \"/\")  ; => ((\"key\" . \"value\") ...)"
   (funcall (request--choose-backend 'get-cookies) host localpart secure))
 
-
-;;; Main
-
-(cl-defun request-default-error-callback (url &key symbol-status
-                                              &allow-other-keys)
-  (request-log 'error
-    "request-default-error-callback: %s %s" url symbol-status))
 
 (cl-defun request (url &rest settings
                        &key
@@ -389,9 +324,7 @@ Example::
                        (sync nil)
                        (response (make-request-response))
                        &allow-other-keys)
-  "Send request to URL.
-
-Request.el has a single entry point.  It is `request'.
+  "Main entry requesting URL with property list SETTINGS as follow.
 
 ==================== ========================================================
 Keyword argument      Explanation
@@ -408,7 +341,7 @@ ERROR       (function)   called on error
 COMPLETE    (function)   called on both success and error
 TIMEOUT       (number)   timeout in second
 STATUS-CODE    (alist)   map status code (int) to callback
-SYNC            (bool)   If non-nil, wait until request is done.  Default is 
nil.
+SYNC            (bool)   If non-nil, wait until request is done. Default is 
nil.
 ==================== ========================================================
 
 
@@ -485,7 +418,7 @@ Example FILES argument::
    support FILES in pure elisp by making furl.el_ another backend.
    Contributions are welcome.
 
-   .. _furl.el: http://code.google.com/p/furl-el/
+   .. _furl.el: https://code.google.com/p/furl-el/
 
 
 * PARSER function
@@ -506,7 +439,7 @@ objects to plist instead of alist, wrap `json-read' by 
`lambda'
 like this.::
 
     (request
-     \"http://...\";
+     \"https://...\";
      :parser (lambda ()
                (let ((json-object-type 'plist))
                  (json-read)))
@@ -537,14 +470,18 @@ synchronous request with `url-retrieve' backend.
 API of `request' is somewhat mixture of jQuery.ajax_ (Javascript)
 and requests.request_ (Python).
 
-.. _jQuery.ajax: http://api.jquery.com/jQuery.ajax/
-.. _requests.request: http://docs.python-requests.org";
+.. _jQuery.ajax: https://api.jquery.com/jQuery.ajax/
+.. _requests.request: https://docs.python-requests.org";
   (declare (indent defun))
   ;; FIXME: support CACHE argument (if possible)
   ;; (unless cache
   ;;   (setq url (request--url-no-cache url)))
   (unless error
-    (setq error (apply-partially #'request-default-error-callback url))
+    (setq error (cl-function
+                 (lambda (&rest args &key symbol-status &allow-other-keys)
+                   (request-log 'error
+                     "request-default-error-callback: %s %s"
+                     url symbol-status))))
     (setq settings (plist-put settings :error error)))
   (unless (or (stringp data)
               (null data)
@@ -569,7 +506,7 @@ and requests.request_ (Python).
   response)
 
 (defun request--clean-header (response)
-  "Strip off carriage return in the header of REQUEST."
+  "Strip off carriage return in the header of RESPONSE."
   (let* ((buffer (request-response--buffer response))
          (backend (request-response--backend response))
          ;; FIXME: a workaround when `url-http-clean-headers' fails...
@@ -590,8 +527,7 @@ and requests.request_ (Python).
             (replace-match "")))))))
 
 (defun request--cut-header (response)
-  "Cut the first header part in the buffer of RESPONSE and move it to
-raw-header slot."
+  "Move the first header to the raw-header slot of RESPONSE object."
   (let ((buffer (request-response--buffer response)))
     (when (buffer-live-p buffer)
       (with-current-buffer buffer
@@ -616,8 +552,7 @@ raw-header slot."
   (or (file-remote-p file 'localname) file))
 
 (defun request--parse-data (response encoding parser)
-  "For buffer held by RESPONSE, first decode via user's ENCODING elective,
-then send to PARSER."
+  "In RESPONSE buffer, decode via ENCODING, then send to PARSER."
   (let ((buffer (request-response--buffer response)))
     (when (buffer-live-p buffer)
       (with-current-buffer buffer
@@ -640,15 +575,18 @@ then send to PARSER."
                              status-code response
                              encoding
                              &allow-other-keys)
+  "Parse BUFFER according to PARSER.
+Delegate to callbacks SUCCESS, ERROR, and COMPLETE the STATUS-CODE of
+RESPONSE via ENCODING."
   (request-log 'debug "request--callback: UNPARSED\n%s"
                (when (buffer-live-p buffer)
                  (with-current-buffer buffer (buffer-string))))
-
-  ;; Sometimes BUFFER given as the argument is different from the
-  ;; buffer already set in RESPONSE.  That's why it is reset here.
-  ;; FIXME: Refactor how BUFFER is passed around.
+  ;; Reset RESPONSE buffer to argument BUFFER.
   (setf (request-response--buffer response) buffer)
-  (request-response--cancel-timer response)
+  (cl-symbol-macrolet ((timer (request-response--timer response)))
+    (when timer
+      (cancel-timer timer)
+      (setq timer nil)))
   (cl-symbol-macrolet
       ((error-thrown (request-response-error-thrown response))
        (symbol-status (request-response-symbol-status response))
@@ -688,27 +626,26 @@ then send to PARSER."
              (name (if success-p "success" "error")))
         (when cb
           (request-log 'debug "request--callback: executing %s" name)
-          (request--safe-apply cb args)))
-
+          (apply cb args)))
       (let ((cb (cdr (assq (request-response-status-code response)
                            status-code))))
         (when cb
           (request-log 'debug "request--callback: executing status-code")
-          (request--safe-apply cb args)))
-
+          (apply cb args)))
       (when complete
         (request-log 'debug "request--callback: executing complete")
-        (request--safe-apply complete args)))
+        (apply complete args)))
 
     (setq done-p t)))
 
 (cl-defun request-response--timeout-callback (response)
+  "If RESPONSE times out, ensure `request--callback' gets called."
   (setf (request-response-symbol-status response) 'timeout)
   (setf (request-response-error-thrown response)  '(error . ("Timeout")))
   (let* ((buffer (request-response--buffer response))
          (proc (and (buffer-live-p buffer) (get-buffer-process buffer))))
     (if proc
-        ;; This will call `request--callback':
+        ;; This implicitly calls `request--callback'!
         (funcall (request--choose-backend 'terminate-process) proc)
       (cl-symbol-macrolet ((done-p (request-response-done-p response)))
         (unless done-p
@@ -723,13 +660,6 @@ then send to PARSER."
                  (request-response-settings response))
           (setq done-p t))))))
 
-(defun request-response--cancel-timer (response)
-  (cl-symbol-macrolet ((timer (request-response--timer response)))
-    (when timer
-      (cancel-timer timer)
-      (setq timer nil))))
-
-
 (defun request-abort (response)
   "Abort request for RESPONSE (the object returned by `request').
 Note that this function invoke ERROR and COMPLETE callbacks.
@@ -742,16 +672,13 @@ associated process is exited."
       (unless symbol-status             ; should I use done-p here?
         (setq symbol-status 'abort)
         (setq done-p t)
-        (when (and
-               (processp process) ; process can be nil when buffer is killed
-               (request--process-live-p process))
+        (when (process-live-p process)
           (funcall (request--choose-backend 'terminate-process) process))))))
 
-
-;;; Backend: `url-retrieve'
 
 (cl-defun request--url-retrieve-preprocess-settings
     (&rest settings &key type data files headers &allow-other-keys)
+  "Augment SETTINGS with properties TYPE DATA FILES HEADERS."
   (when files
     (error "`url-retrieve' backend does not support FILES"))
   (when (and (equal type "POST")
@@ -765,6 +692,10 @@ associated process is exited."
                                      &key type data timeout response
                                      &allow-other-keys
                                      &aux headers)
+  "Internal workhorse querying URL via curl.
+SETTINGS is a property list with keys (some optional) such as GET or POST TYPE,
+DATA for posting fields, TIMEOUT in seconds, RESPONSE a mandatory struct.
+HEADERS needs to be assigned after SETTINGS is preprocessed."
   (setq settings (apply #'request--url-retrieve-preprocess-settings settings))
   (setq headers (plist-get settings :headers))
   (let* ((url-request-extra-headers headers)
@@ -781,6 +712,9 @@ associated process is exited."
 (cl-defun request--url-retrieve-callback (status &rest settings
                                                  &key response url
                                                  &allow-other-keys)
+  "Ensure `request--callback' gets called for STATUS.
+SETTINGS should include RESPONSE and URL properties which
+inform any necessary redirect or history recording logic."
   (when (featurep 'url-http)
     (setf (request-response-status-code response) url-http-response-status))
   (let ((redirect (plist-get status :redirect)))
@@ -800,20 +734,21 @@ associated process is exited."
            do (let ((r (make-request-response :-backend 'url-retrieve)))
                 (setf (request-response-url r) v)
                 (push r (request-response-history response))))
-
   (cl-symbol-macrolet ((error-thrown (request-response-error-thrown response))
                        (status-error (plist-get status :error)))
     (when status-error
       (request-log 'warn "request--url-retrieve-callback: %s" status-error)
       (unless error-thrown
         (setq error-thrown status-error))))
-
   (apply #'request--callback (current-buffer) settings))
 
 (cl-defun request--url-retrieve-sync (url &rest settings
                                           &key type data timeout response
                                           &allow-other-keys
                                           &aux headers)
+  "Internal synchronous retrieve of URL.
+SETTINGS include typical TYPE DATA TIMEOUT RESPONSE properties.
+HEADERS needs to be assigned after SETTINGS is preprocessed."
   (setq settings (apply #'request--url-retrieve-preprocess-settings settings))
   (setq headers (plist-get settings :headers))
   (let* ((url-request-extra-headers headers)
@@ -842,13 +777,11 @@ associated process is exited."
   response)
 
 (defun request--url-retrieve-get-cookies (host localpart secure)
+  "Retrieve cookies corresponding to HOST LOCALPART SECURE."
   (mapcar
    (lambda (c) (cons (url-cookie-name c) (url-cookie-value c)))
    (url-cookie-retrieve host localpart secure)))
 
-
-;;; Backend: curl
-
 (defvar request--curl-cookie-jar nil
   "Override what the function `request--curl-cookie-jar' returns.
 Currently it is used only for testing.")
@@ -888,16 +821,17 @@ Currently it is used only for testing.")
       "\\n(:num-redirects %{num_redirects} :url-effective %{url_effective})"
     "\\n(:num-redirects %{num_redirects} :url-effective 
\"%{url_effective}\")"))
 
-(defun request--curl-mkdir-for-cookie-jar ()
-  (ignore-errors
-    (make-directory (file-name-directory (request--curl-cookie-jar)) t)))
-
 (cl-defun request--curl-command
     (url &key type data headers files unix-socket auth
          &allow-other-keys
          &aux (cookie-jar (convert-standard-filename
                            (expand-file-name (request--curl-cookie-jar)))))
-  "BUG: Simultaneous requests are a known cause of cookie-jar corruption."
+  "Internal command cobbler for curl to URL.
+TYPE, DATA, HEADERS, FILES, UNIX-SOCKET, AUTH are as described in `request'.
+COOKIE-JAR is the file location for the netscape cookie jar, usually
+in the request subdirectory of `user-emacs-directory'.
+
+BUG: Simultaneous requests are a known cause of cookie-jar corruption."
   (append
    (list request-curl
          "--silent" "--location"
@@ -957,14 +891,14 @@ Currently it is used only for testing.")
    (list url)))
 
 (defun request--install-timeout (timeout response)
-  "Out-of-band trigger after TIMEOUT seconds to prevent hangs."
+  "Out-of-band trigger after TIMEOUT seconds to forestall a hung RESPONSE."
   (when (numberp timeout)
     (setf (request-response--timer response)
           (run-at-time timeout nil
                        #'request-response--timeout-callback response))))
 
 (defun request--curl-occlude-secret (command)
-  "Simple regex filter on anything looking like a secret."
+  "Simple regex filter on anything looking like a secret in COMMAND."
   (let ((matched
          (string-match (concat (regexp-quote "--user") "\\s-*\\(\\S-+\\)") 
command)))
     (if matched
@@ -974,7 +908,17 @@ Currently it is used only for testing.")
 (cl-defun request--curl (url &rest settings
                              &key data files timeout response encoding 
semaphore
                              &allow-other-keys)
-  "cURL-based request backend.
+  "Internal workhorse querying URL via curl.
+
+SETTINGS is a property list with keys (some optional) such as DATA for
+posting fields, FILES containing one or more lists of the form
+  (NAME . FILENAME)
+  (NAME . BUFFER)
+  (NAME . (FILENAME :buffer BUFFER))
+  (NAME . (FILENAME :data DATA))
+with NAME and FILENAME defined by curl(1)'s overwrought `--form` switch format,
+TIMEOUT in seconds, RESPONSE a mandatory struct, ENCODING, and SEMAPHORE,
+an internal semaphore.
 
 Redirection handling strategy
 -----------------------------
@@ -988,7 +932,8 @@ location header from the last redirection header.
 
 Sexp at the end of buffer and extra headers for redirects are
 removed from the buffer before it is shown to the parser function."
-  (request--curl-mkdir-for-cookie-jar)
+  (ignore-errors
+    (make-directory (file-name-directory (request--curl-cookie-jar)) t))
   (let* (process-connection-type ;; pipe, not pty, else curl hangs
          (home-directory (or (file-remote-p default-directory) "~/"))
          (default-directory (expand-file-name home-directory))
@@ -1009,7 +954,7 @@ removed from the buffer before it is shown to the parser 
function."
                              file-items)))
     (request--install-timeout timeout response)
     (request-log 'debug "request--curl: %s"
-                 (request--curl-occlude-secret (mapconcat 'identity command " 
")))
+                 (request--curl-occlude-secret (mapconcat #'identity command " 
")))
     (setf (request-response--buffer response) buffer)
     (process-put proc :request-response response)
     (set-process-coding-system proc 'no-conversion 'no-conversion)
@@ -1063,7 +1008,7 @@ See also `request--curl-write-out-template'."
      "secure" "version" "expires")
    "\\|")
   "Uninterested keys in cookie.
-See \"set-cookie-av\" in http://www.ietf.org/rfc/rfc2965.txt";)
+See \"set-cookie-av\" in https://www.ietf.org/rfc/rfc2965.txt";)
 
 (defun request--consume-100-continue ()
   "Remove \"HTTP/* 100 Continue\" header at the point."
@@ -1085,7 +1030,8 @@ See \"set-cookie-av\" in 
http://www.ietf.org/rfc/rfc2965.txt";)
     (delete-region (point) (progn (request--goto-next-body) (point)))))
 
 (defun request--curl-preprocess (&optional url)
-  "Pre-process current buffer before showing it to user."
+  "Pre-process current buffer before showing it to user.
+Curl switches need to be adjusted if URL is a file://."
   (let (history)
     (cl-destructuring-bind (&key num-redirects url-effective)
         (if (request-url-file-p url)
@@ -1135,6 +1081,8 @@ START-URL is the URL requested."
            do (setf (request-response-url response) url)))
 
 (defun request--curl-callback (url proc event)
+  "Ensure `request--callback' gets called after curl to URL finishes.
+See info entries on sentinels regarding PROC and EVENT."
   (let* ((buffer (process-buffer proc))
          (response (process-get proc :request-response))
          (settings (request-response-settings response)))
@@ -1183,6 +1131,7 @@ START-URL is the URL requested."
        auto-revert-notify-modified-p nil))
 
 (cl-defun request--curl-sync (url &rest settings &key response 
&allow-other-keys)
+  "Internal synchronous curl call to URL with SETTINGS bespeaking RESPONSE."
   (let (finished)
     (prog1 (apply #'request--curl url
                   :semaphore (lambda (&rest _) (setq finished t))
@@ -1200,7 +1149,7 @@ START-URL is the URL requested."
           (cl-loop with iter = 0
                    until (or (>= iter maxiter) finished)
                    do (accept-process-output nil interval)
-                   unless (request--process-live-p proc)
+                   unless (process-live-p proc)
                      do (cl-incf iter)
                    end
                    finally (when (>= iter maxiter)
@@ -1209,12 +1158,10 @@ START-URL is the URL requested."
                                (request-log 'error m)))))))))
 
 (defun request--curl-get-cookies (host localpart secure)
+  "Return entry for HOST LOCALPART SECURE in cookie jar."
   (request--netscape-get-cookies (request--curl-cookie-jar)
                                  host localpart secure))
 
-
-;;; Netscape cookie.txt parser
-
 (defun request--netscape-cookie-parse ()
   "Parse Netscape/Mozilla cookie format."
   (goto-char (point-min))
@@ -1242,6 +1189,7 @@ START-URL is the URL requested."
                            value))))
 
 (defun request--netscape-filter-cookies (cookies host localpart secure)
+  "Filter COOKIES for entries containing HOST LOCALPART SECURE."
   (cl-loop for (domain _flag path secure-1 _http-only _expiration name value) 
in cookies
            when (and (equal domain host)
                      (equal path localpart)
@@ -1249,6 +1197,7 @@ START-URL is the URL requested."
            collect (cons name value)))
 
 (defun request--netscape-get-cookies (filename host localpart secure)
+  "Get cookies from FILENAME corresponding to HOST LOCALPART SECURE."
   (when (file-readable-p filename)
     (with-temp-buffer
       (erase-buffer)
diff --git a/tests/request-testing.el b/tests/request-testing.el
index a3a8772..168b341 100644
--- a/tests/request-testing.el
+++ b/tests/request-testing.el
@@ -107,7 +107,7 @@ The symbols other than `response' is bound using 
`cl-symbol-macrolet'."
 (defun request-testing-stop-server ()
   (interactive)
   (let ((process request-testing-server--process))
-    (if (and (processp process) (request--process-live-p process))
+    (if (process-live-p process)
         (quit-process process)
       (unless noninteractive
         (message "No server is running!"))))
diff --git a/tests/test-request.el b/tests/test-request.el
index 9d9ab9c..d9b532c 100644
--- a/tests/test-request.el
+++ b/tests/test-request.el
@@ -464,13 +464,13 @@ To check that, run test with:
                                :parser 'json-read)
       (let ((process (get-buffer-process -buffer)))
         (cl-loop repeat 30
-                 when (request--process-live-p process) return nil
+                 when (process-live-p process) return nil
                  do (sleep-for 0.1)
                  finally (error "Timeout: failed to check process is 
started."))
 
         (should-not symbol-status)
         (should-not done-p)
-        (should (request--process-live-p process))
+        (should (process-live-p process))
 
         (request-abort response)
         (cl-loop repeat 30
@@ -480,7 +480,7 @@ To check that, run test with:
 
         (should (equal symbol-status 'abort))
         (should done-p)
-        (should-not (request--process-live-p process))))
+        (should-not (process-live-p process))))
 
     (should (= (length called) 1))
     (cl-destructuring-bind (&key data symbol-status error-thrown response)
diff --git a/tools/melpazoid.sh b/tools/melpazoid.sh
new file mode 100644
index 0000000..3d9e967
--- /dev/null
+++ b/tools/melpazoid.sh
@@ -0,0 +1,35 @@
+#!/bin/bash -ex
+
+EMACS="${EMACS:=emacs}"
+BASENAME=$(basename "$1")
+PYTHON=$(which python3.6)
+PYTHON="${PYTHON:-python}"
+
+if [[ -z $(du -s melpazoid-master 2>/dev/null | cut -f1) ]] || \
+       [[ $(du -s melpazoid-master 2>/dev/null | cut -f1) -le "100" ]] ; then
+    curl -sLk -O https://github.com/riscy/melpazoid/archive/master.zip
+    unzip master.zip
+    rm -f master.zip
+fi
+
+ROOT=$(git rev-parse --show-toplevel)
+cd ${ROOT}
+PKG_PATH="${ROOT}/melpazoid-master/$(basename $(pwd))"
+PKG_NAME=$(basename "$PKG_PATH")
+PKG_MAIN=$(cask files | egrep -- "pkg.el$" || true)
+PKG_MAIN=$(basename ${PKG_MAIN:-''})
+mkdir -p ${PKG_PATH}
+rsync -av --exclude '*autoloads.el' $(cask files) ${PKG_PATH} --delete
+if [ -s "${ROOT}/LICENSE" ]; then
+  cp -p "${ROOT}/LICENSE" ${PKG_PATH}
+fi
+cd melpazoid-master
+${PYTHON} -m pip install --user -U .
+sed -i -e 's/ -it / -i /' Makefile
+sed -i -e 's/ -ti / -i /' Makefile
+if [ ! -s ./python ]; then rm -f ./python ; ln -s $PYTHON ./python ; fi
+# PKG_PATH=${PKG_PATH} PKG_NAME=${PKG_NAME} PATH=.:${PATH} make run
+
+# Later: melpazoid is now an elisp file?
+cd ${ROOT}
+PACKAGE_MAIN=$PKG_MAIN EMACS=$EMACS cask emacs -Q --batch -l package --eval 
"(setq package-user-dir \"$(cask package-directory)\")" -f package-initialize 
-L ${ROOT}/melpazoid-master/melpazoid --eval "(setq default-directory 
\"${PKG_PATH}\")" --eval "(let (eval-expression-print-length 
eval-expression-print-level) (prin1 package-user-dir (function 
external-debugging-output)) (prin1 package-directory-list (function 
external-debugging-output)) (prin1 package-alist (function external-debuggin 
[...]
diff --git a/tools/readme-sed.sh b/tools/readme-sed.sh
new file mode 100755
index 0000000..991872d
--- /dev/null
+++ b/tools/readme-sed.sh
@@ -0,0 +1,17 @@
+#!/bin/bash
+
+# by mklement0 https://stackoverflow.com/a/29613573/5132008
+
+# Define sample multi-line literal.
+input=`cat`
+replace="$input"
+if [ ! -z "$3" ]; then
+    replace=$(awk "/$3/,EOF { print \"   \" \$0 }" <<<"$input")
+fi
+
+# Escape it for use as a Sed replacement string.
+IFS= read -d '' -r < <(sed -e ':a' -e '$!{N;ba' -e '}' -e 's/[&/\]/\\&/g; 
s/\n/\\&/g' <<<"$replace")
+replaceEscaped=${REPLY%$'\n'}
+
+# If ok, outputs $replace as is.
+sed "/$1/c\\$replaceEscaped" $2



reply via email to

[Prev in Thread] Current Thread [Next in Thread]