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)))