[elpa] externals/compat cb339dd 31/99: Add :cond where applicable

[ELPA Syncer]

branch: externals/compat
commit cb339dda26aadbde9c34052b9479f9648333b512
Author: Philip Kaludercic <philipk@posteo.net>
Commit: Philip Kaludercic <philipk@posteo.net>

    Add :cond where applicable
---
 compat-24.4.el |  7 +++++++
 compat-25.1.el |  7 +++++++
 compat-26.1.el |  4 ++++
 compat-27.1.el |  2 ++
 compat-28.1.el |  4 ++++
 compat.el      | 51 +++++++++++++++++++++++++++++++++++++++++++++++++++
 6 files changed, 75 insertions(+)

diff --git a/compat-24.4.el b/compat-24.4.el
index a5f6093..6518733 100644
--- a/compat-24.4.el
+++ b/compat-24.4.el
@@ -28,11 +28,13 @@
 ;;; Code:
 
 (eval-when-compile (require 'compat-macs))
+(declare-function compat-maxargs-/= "compat" (func n))
 
 ;;;; Defined in data.c
 
 (compat-advise = (number-or-marker &rest numbers-or-markers)
   "Handle multiple arguments."
+  :cond (compat-maxargs-/= #'= 'many)
   (catch 'fail
     (while numbers-or-markers
       (unless (funcall oldfun number-or-marker (car numbers-or-markers))
@@ -42,6 +44,7 @@
 
 (compat-advise < (number-or-marker &rest numbers-or-markers)
   "Handle multiple arguments."
+  :cond (compat-maxargs-/= #'= 'many)
   (catch 'fail
     (while numbers-or-markers
       (unless (funcall oldfun number-or-marker (car numbers-or-markers))
@@ -51,6 +54,7 @@
 
 (compat-advise > (number-or-marker &rest numbers-or-markers)
   "Handle multiple arguments."
+  :cond (compat-maxargs-/= #'= 'many)
   (catch 'fail
     (while numbers-or-markers
       (unless (funcall oldfun number-or-marker (car numbers-or-markers))
@@ -60,6 +64,7 @@
 
 (compat-advise <= (number-or-marker &rest numbers-or-markers)
   "Handle multiple arguments."
+  :cond (compat-maxargs-/= #'= 'many)
   (catch 'fail
     (while numbers-or-markers
       (unless (funcall oldfun number-or-marker (car numbers-or-markers))
@@ -69,6 +74,7 @@
 
 (compat-advise >= (number-or-marker &rest numbers-or-markers)
   "Handle multiple arguments."
+  :cond (compat-maxargs-/= #'= 'many)
   (catch 'fail
     (while numbers-or-markers
       (unless (funcall oldfun number-or-marker (pop numbers-or-markers))
@@ -109,6 +115,7 @@ attention to case differences."
 
 (compat-advise split-string (string &optional separators omit-nulls trim)
   "Handle optional argument TRIM."
+  :cond (compat-maxargs-/= #'assoc 4)
   (let* ((token (funcall oldfun string separators omit-nulls))
          (trimmed (if trim
                       (mapcar
diff --git a/compat-25.1.el b/compat-25.1.el
index 67534b7..a0fac4a 100644
--- a/compat-25.1.el
+++ b/compat-25.1.el
@@ -28,11 +28,15 @@
 ;;; Code:
 
 (eval-when-compile (require 'compat-macs))
+(declare-function compat-maxargs-/= "compat" (func n))
 
 ;;;; Defined in fns.c
 
 (compat-advise sort (seq predicate)
   "Handle SEQ of type vector."
+  :cond (condition-case nil
+            (ignore (sort [] #'ignore))
+          (wrong-type-argument t))
   (cond
    ((listp seq)
     (funcall oldfun seq predicate))
@@ -70,6 +74,9 @@ This implementation is equivalent to `format'."
 
 (compat-advise indirect-function (object)
   "Prevent `void-function' from being signalled."
+  :cond (condition-case nil
+            (ignore (indirect-function nil))
+          (void-function t))
   (condition-case nil
       (funcall oldfun object)
     (void-function nil)))
diff --git a/compat-26.1.el b/compat-26.1.el
index 2728498..9131710 100644
--- a/compat-26.1.el
+++ b/compat-26.1.el
@@ -28,11 +28,13 @@
 ;;; Code:
 
 (eval-when-compile (require 'compat-macs))
+(declare-function compat-maxargs-/= "compat" (func n))
 
 ;;;; Defined in fns.c
 
 (compat-advise assoc (key alist &optional testfn)
   "Handle TESTFN manually."
+  :cond (compat-maxargs-/= #'assoc 3)
   (if testfn
       (catch 'found
         (dolist (ent alist)
@@ -53,6 +55,7 @@ If the buffer is narrowed, the return value by default counts 
the lines
 from the beginning of the accessible portion of the buffer.  But if the
 second optional argument ABSOLUTE is non-nil, the value counts the lines
 from the absolute start of the buffer, disregarding the narrowing."
+  :cond (compat-maxargs-/= #'assoc 2)
   (if absolute
       (save-restriction
         (widen)
@@ -66,6 +69,7 @@ from the absolute start of the buffer, disregarding the 
narrowing."
   :min-version "25.1"                  ;first defined in 25.1
   :max-version "25.3"                  ;last version without testfn
   :realname compat--alist-get-handle-testfn
+  :cond (compat-maxargs-/= #'assoc 5)
   (if testfn
       (catch 'found
         (dolist (ent alist)
diff --git a/compat-27.1.el b/compat-27.1.el
index 1aa12f3..9195a34 100644
--- a/compat-27.1.el
+++ b/compat-27.1.el
@@ -28,6 +28,7 @@
 ;;; Code:
 
 (eval-when-compile (require 'compat-macs))
+(declare-function compat-maxargs-/= "compat" (func n))
 
 ;;;; Defined in fns.c
 
@@ -108,6 +109,7 @@ Letter-case is significant, but text properties are 
ignored."
 
 (compat-advise setq-local (&rest pairs)
   "Handle multiple assignments."
+  :cond (compat-maxargs-/= #'setq-local 'many)
   (unless (zerop (mod (length pairs) 2))
     (error "PAIRS must have an even number of variable/value members"))
   (let (body)
diff --git a/compat-28.1.el b/compat-28.1.el
index f63a3c6..12735cf 100644
--- a/compat-28.1.el
+++ b/compat-28.1.el
@@ -28,6 +28,7 @@
 ;;; Code:
 
 (eval-when-compile (require 'compat-macs))
+(declare-function compat-maxargs-/= "compat" (func n))
 
 ;;;; Defined in fns.c
 
@@ -133,6 +134,7 @@ continuing as if the error did not occur."
 
 Optional arguments FROM and TO specify the substring of STRING to
 consider, and are interpreted as in `substring'."
+  :cond (compat-maxargs-/= #'string-width 3)
   (funcall oldfun (substring string (or from 0) to)))
 
 ;;;; Defined in dired.c
@@ -142,6 +144,7 @@ consider, and are interpreted as in `substring'."
 
 If COUNT is non-nil and a natural number, the function will
  return COUNT number of file names (if so many are present)."
+  :cond (compat-maxargs-/= #'assoc 5)
   (let ((files (funcall oldfun directory full match nosort)))
     (when (natnump count)
       (setf (nthcdr count files) nil))
@@ -402,6 +405,7 @@ is included in the return value."
 
 If ALL-FRAMES is non-nil, count the windows in all frames instead
 just the selected frame."
+  :cond (compat-maxargs-/= #'assoc 3)
   (if all-frames
       (let ((sum 0))
         (dolist (frame (frame-list))
diff --git a/compat.el b/compat.el
index 459ccba..428e183 100644
--- a/compat.el
+++ b/compat.el
@@ -43,6 +43,57 @@
 
 ;;;; Core functionality
 
+;; The implementation is extracted here so that compatibility advice
+;; can check if the right number of arguments are being handled.
+(defun compat-func-arity (func)
+  "A reimplementation of `func-arity' for FUNC."
+  (cond
+   ((null func)
+    (signal 'void-function func))
+   ((and (symbolp func) (not (null func)))
+    (compat-func-arity (indirect-function func)))
+   ((eq (car-safe func) 'macro)
+    (compat-func-arity (cdr func)))
+   ((subrp func)
+    (subr-arity func))
+   ((memq (car-safe func) '(closure lambda))
+    ;; See lambda_arity from eval.c
+    (when (eq (car func) 'closure)
+      (setq func (cdr func)))
+    (let ((syms-left (if (consp func)
+                         (car func)
+                       (signal 'invalid-function func)))
+          (min-args 0) (max-args 0) optional)
+      (catch 'many
+        (dolist (next syms-left)
+          (cond
+           ((not (symbolp next))
+            (signal 'invalid-function func))
+           ((eq next '&rest)
+            (throw 'many (cons min-args 'many)))
+           ((eq next '&optional)
+            (setq optional t))
+           (t (unless optional
+                (setq min-args (1+ min-args)))
+              (setq max-args (1+ max-args)))))
+        (cons min-args max-args))))
+   ((byte-code-function-p func)
+    ;; See get_byte_code_arity from bytecode.c
+    (let ((at (aref func 0)))
+      (cons (logand at 127)
+            (if (= (logand at 128) 0)
+                (ash at -8)
+              'many))))
+   ((autoloadp func)
+    (autoload-do-load func)
+    (compat-func-arity func))
+   ((signal 'invalid-function func))))
+
+(defun compat-maxargs-/= (func n)
+  "Non-nil when FUNC doesn't accept at most N arguments."
+  (not (eq (cdr (compat-func-arity func)) n)))
+
+
 ;; Suppress errors triggered by requiring non-existent libraries in
 ;; older versions of Emacs (e.g. subr-x).
 (compat-advise require (feature &optional filename noerror)