Try to gracefully handle not having ffi-callbacks.
authorSteve Youngs <steve@sxemacs.org>
Fri, 12 Jun 2015 14:22:32 +0000 (00:22 +1000)
committerSteve Youngs <steve@sxemacs.org>
Fri, 12 Jun 2015 14:22:32 +0000 (00:22 +1000)
The change in 3ba78988 (effi.c) meant that ffi-curl.el and ffi-sqlite.el
could not be loaded if you weren't on a i386 machine.  This changeset
takes care of that.

* lisp/ffi/ffi-curl.el (curl:cb-write-to-buffer): Wrap in
#'ignore-errors because our ffi-callbacks don't work on x86_64.

* lisp/ffi/ffi-curl.el (curl:download): Only attempt dl to a
buffer if curl:cb-write-to-buffer is bound.

* lisp/ffi/ffi-sqlite.el (sqlite-generic-collation): Wrap in
#'ignore-errors because our ffi-callbacks don't work on x86_64.

* lisp/ffi/ffi-sqlite.el (sqlite-create-collation): Error if
sqlite-generic-collation isn't bound.

Signed-off-by: Steve Youngs <steve@sxemacs.org>
lisp/ffi/ffi-curl.el
lisp/ffi/ffi-sqlite.el

index dbb0202..0b7c3ec 100644 (file)
@@ -235,15 +235,16 @@ object with key 'ctx to keep it accessible."
 (defvar curl:download-history nil
   "History for `curl:download' and `curl:download&'.")
 
-(define-ffi-callback curl:cb-write-to-buffer int
-  ((ptr pointer) (size int) (nmemb int) (stream pointer))
-  "Writer to STREAM buffer."
-  (let ((buf (ffi-pointer-to-lisp-object stream))
-       (rsz (* size nmemb)))
-    (when (and (positivep rsz) (buffer-live-p buf))
-      (with-current-buffer buf
-       (insert (ffi-get ptr :type (cons 'c-data rsz)))))
-    rsz))
+(ignore-errors
+  (define-ffi-callback curl:cb-write-to-buffer int
+    ((ptr pointer) (size int) (nmemb int) (stream pointer))
+    "Writer to STREAM buffer."
+    (let ((buf (ffi-pointer-to-lisp-object stream))
+         (rsz (* size nmemb)))
+      (when (and (positivep rsz) (buffer-live-p buf))
+       (with-current-buffer buf
+         (insert (ffi-get ptr :type (cons 'c-data rsz)))))
+      rsz)))
 
 ;;;###autoload
 (defun curl:download (url file-or-buffer &rest options)
@@ -269,7 +270,8 @@ works with HTTP URLs."
         (setq options (list :header t :nobody t))))
 
   (let* ((ctx (curl:easy-init))
-        (bufferp (bufferp file-or-buffer))
+        (bufferp (and (boundp 'curl:cb-write-to-buffer)
+                      (bufferp file-or-buffer)))
         (fs (if bufferp
                 (ffi-lisp-object-to-pointer file-or-buffer)
               (c:fopen (expand-file-name file-or-buffer) "w"))))
index bcc7b52..aaebf12 100644 (file)
@@ -476,32 +476,38 @@ BIND specifies bindings for SQL query."
 ;;}}}
 ;;{{{ Custom collations
 
-(define-ffi-callback sqlite-generic-collation 'int
-  ((user-data 'pointer) (len1 'int) (str1 'pointer)
-   (len2 'int) (str2 'pointer))
-  (let ((fun (ffi-pointer-to-lisp-object user-data))
-       (s1 (ffi-get str1 :type (cons 'c-data len1)))
-       (s2 (ffi-get str2 :type (cons 'c-data len2))))
-    (funcall fun s1 s2)))
+(ignore-errors
+  (define-ffi-callback sqlite-generic-collation 'int
+    ((user-data 'pointer) (len1 'int) (str1 'pointer)
+     (len2 'int) (str2 'pointer))
+    (let ((fun (ffi-pointer-to-lisp-object user-data))
+         (s1 (ffi-get str1 :type (cons 'c-data len1)))
+         (s2 (ffi-get str2 :type (cons 'c-data len2))))
+      (funcall fun s1 s2))))
 
 (defun sqlite-create-collation (db name compare-function)
   "For DB register new collation named NAME.
 COMPARE-FUNCTION must get exactly two string arguments and return:
   -1  if first string is less then second
    0  if strings are equal
-   1  if first string is greater then second"
-  (let* ((ccolls (get db 'custom-collations))
-        (colla (assoc name ccolls)))
-    (if colla
-       (setcdr colla compare-function)
-      (put db 'custom-collations
-          (cons (cons name compare-function) ccolls))))
-  (sqlite-check-result
-   (sqlite:create-collation
-    db name sqlite-UTF-8
-    (ffi-lisp-object-to-pointer compare-function)
-    (ffi-callback-fo 'sqlite-generic-collation))
-   (sqlite:errmsg db)))
+   1  if first string is greater then second.
+
+Currently, this is only available on i386."
+  (if (not (boundp 'sqlite-generic-collation))
+      (error 'unimplemented 'ffi-make-callback
+            "for this architecture")
+    (let* ((ccolls (get db 'custom-collations))
+          (colla (assoc name ccolls)))
+      (if colla
+         (setcdr colla compare-function)
+       (put db 'custom-collations
+            (cons (cons name compare-function) ccolls))))
+    (sqlite-check-result
+     (sqlite:create-collation
+      db name sqlite-UTF-8
+      (ffi-lisp-object-to-pointer compare-function)
+      (ffi-callback-fo 'sqlite-generic-collation))
+     (sqlite:errmsg db))))
 
 (defun sqlite-remove-collation (db name)
   "For DB remove collation by NAME."