Google
 

Trailing-Edge - PDP-10 Archives - clisp - clisp/upsala/casify.clisp
There are no other files named casify.clisp in the archive.
(defun casify-sym (Obj &optional (letterp #'letterp-n)
                                 (lowercase #'lowercase-n))
  (declare (fixnum i size))
  (do ((i 0 (1+ i))
       (flag t)
       (size (length Obj))
       (result))
      ((>= i size) (coerce (nreverse result) 'string))
    (let ((c (char Obj i)))
      (cond ((funcall letterp c) (push (if flag c
                                                (funcall lowercase c))
                                       result)
                                 (setq flag nil))
            (t (setq flag t) (push c result))))))

(defun swe-casify-sym (Obj)
  (casify-sym Obj #'swe-letterp-n #'swe-lowercase-n))

(defun lowercase-sym (sym &optional (lowercase #'lowercase-n))
  (coerce (mapcar lowercase (coerce sym 'list)) 'string))

(defun swe-lowercase-sym (sym)
  (lowercase-sym sym #'swe-lowercase-n))

(defun letterp-n (c)
  (or (and (char>= c #\A) (char<= c #\Z))
      (and (char>= c #\a) (char<= c #\z))))

(defun swe-letterp-n (c)
  (or (and (char>= c #\A) (char<= c #\]))
      (and (char>= c #\a) (char<= c #\}))))

(defun lowercase-n (c)
  (cond ((and (char>= c #\A) (char<= c #\Z))
	 (code-char (+ (char-code c) #.(- (char-code #\a) (char-code #\A)))))
        (t c)))

(defun swe-lowercase-n (c)
  (cond ((and (char>= c #\A) (char<= c #\]))
	 (code-char (+ (char-code c) #.(- (char-code #\a) (char-code #\A)))))
        (t c)))

(defun uppercase-n (c)
  (cond ((and (char>= c #\a) (char<= c #\z))
	 (code-char (+ (char-code c) #.(- (char-code #\A) (char-code #\a)))))
        (t c)))

(defun swe-uppercase-n (c)
  (cond ((and (char>= c #\a) (char<= c #\}))
	 (code-char (+ (char-code c) #.(- (char-code #\A) (char-code #\a)))))
        (t c)))