Changeset 6057


Ignore:
Timestamp:
Mar 18, 2007, 2:13:26 AM (13 years ago)
Author:
gb
Message:

COMPUTE-OBJC-TO-LISP-FUNCTION-NAME. The currently active version just
interns a mixed-case string (with possible embedded colons); another
version - that replaced : with & and destudly-fied - is conditionalized
out.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/objc-gf/ccl/examples/name-translation.lisp

    r572 r6057  
    186186
    187187
     188(defparameter *objc-colon-replacement-character* #\.)
     189
     190
     191(defun compute-objc-to-lisp-function-name (str &optional (package "NS"))
     192  #-nil
     193  (intern str package)
     194  #+nil
     195  (let* ((n (length str))
     196         (i 0)
     197         (trailing t))
     198      (let* ((subs (if (not (position #\: str))
     199                     (progn (setq trailing nil)
     200                            (list str))
     201                     (collect ((substrings))
     202                       (do* ()
     203                            ((= i n) (substrings))
     204                         (let* ((pos (position #\: str :start i)))
     205                           (unless pos
     206                             (break "Huh?"))
     207                           (substrings (subseq str i pos))
     208                           (setq i (1+ pos)))))))
     209             (split
     210              (mapcar #'(lambda (s)
     211                    (collapse-prefix
     212                     (split-if #'(lambda (ch)
     213                                   (or (upper-case-p ch) (digit-char-p ch)))
     214                               s)))
     215               
     216                subs))
     217             (namelen (+ (if trailing (length split) 0)
     218                           (let* ((c 0))
     219                             (dolist (s split c)
     220                               (if s (incf c (1- (length s))))))
     221                           (let* ((c 0))
     222                             (dolist (s split c)
     223                               (dolist (sub s)
     224                                 (incf c (length sub)))))))
     225             (name (make-string namelen)))
     226        (declare (dynamic-extent name))
     227        (let* ((p 0))
     228          (flet ((out-ch (ch)
     229                   (setf (schar name p) ch)
     230                   (incf p)))
     231            (dolist (sub split)
     232              (when sub
     233                (do* ((string (pop sub) (pop sub)))
     234                     ((null string))
     235                  (dotimes (i (length string))
     236                    (out-ch (char-upcase (schar string i))))
     237                  (when sub
     238                    (out-ch #\-))))
     239              (when trailing (out-ch *objc-colon-replacement-character*)))))
     240        (values
     241         (or (find-symbol name package)
     242             (intern (copy-seq name) package))))))
     243
     244       
    188245;;; Convert a Lisp list of keywords into an ObjC method selector string
    189246;;; Example: (:next-event-matching-mask :until-date :in-mode :dequeue) ==>
Note: See TracChangeset for help on using the changeset viewer.