Changeset 12879


Ignore:
Timestamp:
Sep 22, 2009, 9:28:22 PM (9 years ago)
Author:
rme
Message:

Merge r12764 (refs bug 524)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/1.3/source/lib/chars.lisp

    r11226 r12879  
    1818(in-package "CCL")
    1919
    20 ; If object is a character, it is returned.  If it is an integer, its INT-CHAR
    21 ; is returned. If it is a string of length 1, then the sole element of the
    22 ; string is returned.  If it is a symbol whose pname is of length 1, then
    23 ; the sole element of the pname is returned. Else error.
     20(defun character-designator-p (thing)
     21  (or (typep thing 'character)
     22      (typep thing '(string 1))
     23      (and (typep thing 'symbol) (typep (symbol-name thing) '(string 1)))))
     24
     25;;; If object is a character, it is returned.  If it is a string of
     26;;; length 1, then the sole element of the string is returned.  If it
     27;;; is a symbol whose pname is of length 1, then the sole element of
     28;;; the pname is returned. Else error.
    2429
    2530(defun character (arg)
     
    2833  (if (typep arg 'character)
    2934    arg
    30     (if (typep arg 'fixnum)
    31       (code-char arg)
    32       (if (and (typep arg 'string)
    33                (= (the fixnum (length arg)) 1))
    34         (char arg 0)
    35         (let* ((pname (if (typep arg 'symbol) (symbol-name arg))))
    36           (if (and pname (= (the fixnum (length pname)) 1))
    37             (char pname 0)
    38             (%err-disp $xcoerce arg 'character)))))))
     35    (if (and (typep arg 'string)
     36             (= (the fixnum (length arg)) 1))
     37      (char arg 0)
     38      (let* ((pname (if (typep arg 'symbol) (symbol-name arg))))
     39        (if (and pname (= (the fixnum (length pname)) 1))
     40          (char pname 0)
     41          (report-bad-arg arg '(satisfies character-designator-p)))))))
    3942
    4043
Note: See TracChangeset for help on using the changeset viewer.