New patches: [more flexible name translations Greg Pfeil **20091115151833 FOREIGN-/LISP-NAME are now exported and take a package argument. This allows users to override the name translations on a package-by-package basis. EG, (defmethod cffi:lisp-name ((spec string) (package (eql (find-package :llvm))) &optional varp) "LLVMUpperCamelCase -> 'llvm:upper-camel-case" (intern (format nil (if varp "*~a*" "~a") (translate-camelcase-name (subseq spec 4) :upper-initial-p t :special-words special-words)))) The functions TRANSLATE-UNDERSCORE-SEPARATED-NAME and TRANSLATE-CAMELCASE-NAME have also been added and are exported. They cover common foreign name translations (TRANSLATE-UNDERSCORE-SEPARATED-NAME is the default, and you can see TRANSLATE-CAMELCASE-NAME in the example above). I usually end up hacking something like this into CFFI anyway, so I figured CFFI is the best place for it to live. ] { hunk ./grovel/grovel.lisp 757 - (t (cffi::foreign-name (car spec))))))) + (t (cffi:foreign-name (car spec) *package*)))))) hunk ./grovel/grovel.lisp 770 - (cffi::foreign-name (first arg)))) + (cffi:foreign-name (first arg) *package*))) hunk ./grovel/grovel.lisp 781 - (list (cffi::lisp-name (first arg)) + (list (cffi:lisp-name (first arg) *package*) hunk ./grovel/grovel.lisp 793 - (cffi::foreign-name (first arg)))) + (cffi:foreign-name (first arg) *package*))) hunk ./grovel/grovel.lisp 803 - (list (cffi::lisp-name (first arg)) + (list (cffi:lisp-name (first arg) *package*) hunk ./src/functions.lisp 221 -(defun lisp-name (spec &optional varp) - (etypecase spec - (list (if (keywordp (second spec)) - (lisp-name (first spec) varp) - (if (symbolp (first spec)) - (first spec) - (lisp-name (second spec) varp)))) - (string (intern - (format nil (if varp "*~A*" "~A") - (canonicalize-symbol-name-case - (substitute #\- #\_ spec))))) - (symbol spec))) +(defgeneric translate-underscore-separated-name (name) + (:method ((name string)) + (canonicalize-symbol-name-case (substitute #\- #\_ name))) + (:method ((name symbol)) + (substitute #\_ #\- (string-downcase (symbol-name name))))) hunk ./src/functions.lisp 227 -(defun foreign-name (spec &optional varp) - (etypecase spec - (list (if (stringp (second spec)) - (second spec) - (foreign-name (first spec) varp))) - (string spec) - (symbol (let ((name (substitute #\_ #\- - (string-downcase (symbol-name spec))))) - (if varp - (string-trim '(#\*) name) - name))))) +(defun collapse-prefix (l special-words) + (unless (null l) + (multiple-value-bind (newpre skip) (check-prefix l special-words) + (cons newpre (collapse-prefix (nthcdr skip l) special-words))))) + +(defun check-prefix (l special-words) + (let ((pl (ccl::prefix-list l))) + (loop for w in special-words + for p = (position-if #'(lambda (s) (string= s w)) pl) + when p do (return-from check-prefix (values (nth p pl) (1+ p)))) + (values (first l) 1))) + +(defun split-if (test seq &optional (dir :before)) + (remove-if #'(lambda (x) (equal x (subseq seq 0 0))) + (loop for start fixnum = 0 + then (if (eq dir :before) + stop + (the fixnum (1+ (the fixnum stop)))) + while (< start (length seq)) + for stop = (position-if + test seq + :start (if (eq dir :elide) + start + (the fixnum (1+ start)))) + collect (subseq + seq start + (if (and stop (eq dir :after)) + (the fixnum (1+ (the fixnum stop))) + stop)) + while stop))) + +(defgeneric translate-camelcase-name + (name &key upper-initial-p special-words) + (:method ((name string) &key upper-initial-p special-words) + (declare (ignore upper-initial-p)) + (intern + (reduce #'(lambda (s1 s2) (concatenate 'simple-string s1 "-" s2)) + (mapcar #'string-upcase + (collapse-prefix + (ccl::split-if #'(lambda (ch) + (or (upper-case-p ch) + (digit-char-p ch))) + name) + special-words))) + *package*)) + (:method ((name symbol) &key upper-initial-p special-words) + (apply #'concatenate + 'string + (loop for str in (split-if #'(lambda (ch) (eq ch #\-)) + (string name) + :elide) + for first-word-p = t then nil + for e = (member str special-words + :test #'equal :key #'string-upcase) + collect (cond + ((and first-word-p (not upper-initial-p)) str) + (e (first e)) + (t (string-capitalize str))))))) + +(defgeneric lisp-name (spec package &optional varp) + (:method ((spec list) package &optional varp) + (if (keywordp (second spec)) + (lisp-name (first spec) package varp) + (if (symbolp (first spec)) + (first spec) + (lisp-name (second spec) package varp)))) + (:method ((spec string) package &optional varp) + (declare (ignore package)) + (intern (format nil (if varp "*~A*" "~A") + (translate-underscore-separated-name spec)))) + (:method ((name symbol) package &optional varp) + (declare (ignore package varp)) + name)) + +(defgeneric foreign-name (spec package &optional varp) + (:method ((spec list) package &optional varp) + (if (stringp (second spec)) + (second spec) + (foreign-name (first spec) package varp))) + (:method ((spec string) package &optional varp) + (declare (ignore package varp)) + spec) + (:method ((spec symbol) package &optional varp) + (declare (ignore package)) + (let ((name (translate-underscore-separated-name spec))) + (if varp + (string-trim '(#\*) name) + name)))) hunk ./src/functions.lisp 327 - (values (lisp-name spec varp) - (foreign-name spec varp) + (values (lisp-name spec *package* varp) + (foreign-name spec *package* varp) hunk ./src/package.lisp 134 - )) + + ;; Name translators + #:lisp-name #:foreign-name + #:translate-underscore-separated-name + #:translate-camelcase-name)) } Context: [Deprecate groveler clause FLAG in favour of CC-FLAGS. Stelian Ionescu **20090823121108 Ignore-this: e1537717a9e7356b208d5cd14b34ba50 ] [cffi-allegro: define long long types on 64-bit platforms Luis Oliveira **20090821210052 Patch courtesy of John Fremlin. ] [cffi-tests: fix pointer-to-integer casts in libtest.c Luis Oliveira **20090821205447] [cffi-tests: don't use stdcall #ifndef WIN32 Luis Oliveira **20090821205144] [Also canonicalize search paths in library specs. Stelian Ionescu **20090809005356 Ignore-this: 86a039c7ebbc757c9934fe99368ae0bb ] [Update manual. Stelian Ionescu **20090808222834 Ignore-this: 15e832e5220a6ca70722730d81edf283 DEFCFUN & co. now take only :CONVENTION. ] [Whitespace. Stelian Ionescu **20090808221547 Ignore-this: 18d99969b97b190176e88d9eb24a94ce ] [Declare DEFCALLBACK, DEFCFUN and DEFINE-FOREIGN-LIBRARY's keyword args :CCONV and :CALLING-CONVENTION obsolete, use :CONVENTION instead. Stelian Ionescu **20090808221055 Ignore-this: 9e90dfde20f4a4dfd764c5250d8b2ea6 ] [Fix docstring of LIST-FOREIGN-LIBRARIES. Stelian Ionescu **20090807164116 Ignore-this: 5c65a2d7608718e9bc0560e780855bf1 ] [Fix reloading a library in LOAD-FOREIGN-LIBRARY. Stelian Ionescu **20090807162733 Ignore-this: 267edf226a87d24d0441bf85515cc437 ] [Use type :wrapper for wrapper libraries generated by the groveler. Stelian Ionescu **20090804204132 Ignore-this: d61f9a69cfb323905d8abbb40bf84be9 ] [Use type :test for the test libraries. Stelian Ionescu **20090720154312 Ignore-this: 6dad3c93d47cd22e27c73c6ba7f2e8d1 ] [Add the ability to specify a foreign library's type and search path. Stelian Ionescu **20090720154028 Ignore-this: 7de87b54da57c74f9a7c994d6255df84 Also export: - FOREIGN-LIBRARY - FOREIGN-LIBRARY-PATHNAME - FOREIGN-LIBRARY-TYPE - FOREIGN-LIBRARY-LOADED-P - LIST-FOREIGN-LIBRARIES ] [Cosmetic changes (cconv -> calling-convention). Stelian Ionescu **20090720153925 Ignore-this: 38bc21d362c69fbf2dc10d268615b4fb ] [Groveler fixes for ECL. Stelian Ionescu **20090804193738 Ignore-this: b834b25942f10bf4a42fdc3e9d0a2a0e ] [ECL: support more vector types in CFFI-SYS:WITH-POINTER-TO-VECTOR-DATA Luis Oliveira **20090725231330 Patch courtesy of Andy Hefner. ] [cffi-openmcl: prepend _ to external names on #+darwin, not just #+darwinppc Luis Oliveira **20090710180832] [grovel: don't use cffi-features. Luis Oliveira **20090702201557] [clisp: small fix to %FOREIGN-ALLOC Luis Oliveira **20090701185918 - Deal with (%foreign-alloc 0) gracefully by turning it into a one byte allocation. This is similar to what glibc's malloc() does, IIUC. - Regression test: FOREIGN-ALLOC.6. Reported by Tobias Rautenkranz. ] [Don't trim #\VT. Stelian Ionescu **20090625164315 Ignore-this: d8d498764120b505ef429533a31e7ad4 ] [Groveler: trim-whitespace not strip-whitespace. Stelian Ionescu **20090622215252 Ignore-this: 4cf64b68c733985620a54547172f0acc ] [Groveler: fix typo. Stelian Ionescu **20090622213353 Ignore-this: 6611cf5e23cf79f39487005c3cd54cea ] [Groveler: small refactoring, create *EXE-EXTENSION* Stelian Ionescu **20090622212626 Ignore-this: e05a49eac29b50b75d739d7a8a4d5376 ] [Groveler: move boilerplate C code to common.h Stelian Ionescu **20090622211857 Ignore-this: eb1d4dfe79eda50736030b8a58245fa ] [Groveller: fix usage of *CC-FLAGS*. Stelian Ionescu **20090622205142 Ignore-this: 8ec1dee6e977bb621978a140d00d4df6 ] [Include with the groveler boilerplate code. Stelian Ionescu **20090622201324 Ignore-this: a61b2c378174118bda30f34881fd0d16 ] [Move the DEFPACKAGE and INVOKE out of grovel.lisp Stelian Ionescu **20090622200317 Ignore-this: 684f7b807e38f1562c83987999f5f2f6 ] [Style change. Stelian Ionescu **20090622194557 Ignore-this: d5fec823114054a26e5d3f868a51e61d ] [Groveler: use WITH-STANDARD-IO-SYNTAX when processing grovel files. Stelian Ionescu **20090622190429 Ignore-this: b2de6817830cfa76780382f6f58b04ee ] [Groveler: implement %INVOKE for ABCL. Stelian Ionescu **20090622190326 Ignore-this: 1131c355c7fbef55c972c5444bed2bf7 ] [TAG 0.10.5 Luis Oliveira **20090616162007 Ignore-this: f21c050e8ca02edcf2e2bac58555deb9 ] Patch bundle hash: 144306462a15b8791326377703dcbffd156b21ac