| ... |
... |
@@ -618,49 +618,6 @@ |
|
618
|
618
|
(setf (schar string i) fill-char))
|
|
619
|
619
|
(make-string count)))
|
|
620
|
620
|
|
|
621
|
|
-#+nil
|
|
622
|
|
-(defun string-upcase (string &key (start 0) end)
|
|
623
|
|
- _N"Given a string, returns a new string that is a copy of it with all
|
|
624
|
|
- lower case alphabetic characters converted to uppercase."
|
|
625
|
|
- (declare (fixnum start))
|
|
626
|
|
- (let* ((string (if (stringp string) string (string string)))
|
|
627
|
|
- (slen (length string)))
|
|
628
|
|
- (declare (fixnum slen))
|
|
629
|
|
- (with-one-string string start end offset
|
|
630
|
|
- (let ((offset-slen (+ slen offset))
|
|
631
|
|
- (newstring (make-string slen)))
|
|
632
|
|
- (declare (fixnum offset-slen))
|
|
633
|
|
- (do ((index offset (1+ index))
|
|
634
|
|
- (new-index 0 (1+ new-index)))
|
|
635
|
|
- ((= index start))
|
|
636
|
|
- (declare (fixnum index new-index))
|
|
637
|
|
- (setf (schar newstring new-index) (schar string index)))
|
|
638
|
|
- (do ((index start (1+ index))
|
|
639
|
|
- (new-index (- start offset) (1+ new-index)))
|
|
640
|
|
- ((= index (the fixnum end)))
|
|
641
|
|
- (declare (fixnum index new-index))
|
|
642
|
|
- (multiple-value-bind (code wide) (codepoint string index)
|
|
643
|
|
- (when wide (incf index))
|
|
644
|
|
- ;; Use char-upcase if it's not a surrogate pair so that
|
|
645
|
|
- ;; we're always consist.
|
|
646
|
|
- (if wide
|
|
647
|
|
- (setq code (unicode-upper code))
|
|
648
|
|
- (setf code (char-code (char-upcase (code-char code)))))
|
|
649
|
|
- ;;@@ WARNING: this may, in theory, need to extend newstring
|
|
650
|
|
- ;; but that never actually occurs as of Unicode 5.1.0,
|
|
651
|
|
- ;; so I'm just going to ignore it for now...
|
|
652
|
|
- (multiple-value-bind (hi lo) (surrogates code)
|
|
653
|
|
- (setf (schar newstring new-index) hi)
|
|
654
|
|
- (when lo
|
|
655
|
|
- (setf (schar newstring (incf new-index)) lo)))))
|
|
656
|
|
- ;;@@ WARNING: see above
|
|
657
|
|
- (do ((index end (1+ index))
|
|
658
|
|
- (new-index (- (the fixnum end) offset) (1+ new-index)))
|
|
659
|
|
- ((= index offset-slen))
|
|
660
|
|
- (declare (fixnum index new-index))
|
|
661
|
|
- (setf (schar newstring new-index) (schar string index)))
|
|
662
|
|
- newstring))))
|
|
663
|
|
-
|
|
664
|
621
|
(defun string-upcase (string &key (start 0) end)
|
|
665
|
622
|
_N"Given a string, returns a new string that is a copy of it with all
|
|
666
|
623
|
lower case alphabetic characters converted to uppercase."
|
| ... |
... |
@@ -690,49 +647,6 @@ |
|
690
|
647
|
(setf (schar newstring new-index) (schar string index)))
|
|
691
|
648
|
newstring))))
|
|
692
|
649
|
|
|
693
|
|
-#+nil
|
|
694
|
|
-(defun string-downcase (string &key (start 0) end)
|
|
695
|
|
- _N"Given a string, returns a new string that is a copy of it with all
|
|
696
|
|
- upper case alphabetic characters converted to lowercase."
|
|
697
|
|
- (declare (fixnum start))
|
|
698
|
|
- (let* ((string (if (stringp string) string (string string)))
|
|
699
|
|
- (slen (length string)))
|
|
700
|
|
- (declare (fixnum slen))
|
|
701
|
|
- (with-one-string string start end offset
|
|
702
|
|
- (let ((offset-slen (+ slen offset))
|
|
703
|
|
- (newstring (make-string slen)))
|
|
704
|
|
- (declare (fixnum offset-slen))
|
|
705
|
|
- (do ((index offset (1+ index))
|
|
706
|
|
- (new-index 0 (1+ new-index)))
|
|
707
|
|
- ((= index start))
|
|
708
|
|
- (declare (fixnum index new-index))
|
|
709
|
|
- (setf (schar newstring new-index) (schar string index)))
|
|
710
|
|
- (do ((index start (1+ index))
|
|
711
|
|
- (new-index (- start offset) (1+ new-index)))
|
|
712
|
|
- ((= index (the fixnum end)))
|
|
713
|
|
- (declare (fixnum index new-index))
|
|
714
|
|
- (multiple-value-bind (code wide) (codepoint string index)
|
|
715
|
|
- (when wide (incf index))
|
|
716
|
|
- ;; Use char-downcase if it's not a surrogate pair so that
|
|
717
|
|
- ;; we're always consist.
|
|
718
|
|
- (if wide
|
|
719
|
|
- (setq code (unicode-lower code))
|
|
720
|
|
- (setq code (char-code (char-downcase (code-char code)))))
|
|
721
|
|
- ;;@@ WARNING: this may, in theory, need to extend newstring
|
|
722
|
|
- ;; but that never actually occurs as of Unicode 5.1.0,
|
|
723
|
|
- ;; so I'm just going to ignore it for now...
|
|
724
|
|
- (multiple-value-bind (hi lo) (surrogates code)
|
|
725
|
|
- (setf (schar newstring new-index) hi)
|
|
726
|
|
- (when lo
|
|
727
|
|
- (setf (schar newstring (incf new-index)) lo)))))
|
|
728
|
|
- ;;@@ WARNING: see above
|
|
729
|
|
- (do ((index end (1+ index))
|
|
730
|
|
- (new-index (- (the fixnum end) offset) (1+ new-index)))
|
|
731
|
|
- ((= index offset-slen))
|
|
732
|
|
- (declare (fixnum index new-index))
|
|
733
|
|
- (setf (schar newstring new-index) (schar string index)))
|
|
734
|
|
- newstring))))
|
|
735
|
|
-
|
|
736
|
650
|
(defun string-downcase (string &key (start 0) end)
|
|
737
|
651
|
_N"Given a string, returns a new string that is a copy of it with all
|
|
738
|
652
|
upper case alphabetic characters converted to lowercase."
|
| ... |
... |
@@ -804,31 +718,6 @@ |
|
804
|
718
|
(setf (schar newstring new-index) (schar string index)))
|
|
805
|
719
|
newstring))))
|
|
806
|
720
|
|
|
807
|
|
-#+nil
|
|
808
|
|
-(defun nstring-upcase (string &key (start 0) end)
|
|
809
|
|
- "Given a string, returns that string with all lower case alphabetic
|
|
810
|
|
- characters converted to uppercase."
|
|
811
|
|
- (declare (fixnum start))
|
|
812
|
|
- (let ((save-header string))
|
|
813
|
|
- (with-one-string string start end offset
|
|
814
|
|
- (do ((index start (1+ index)))
|
|
815
|
|
- ((= index (the fixnum end)))
|
|
816
|
|
- (declare (fixnum index))
|
|
817
|
|
- (multiple-value-bind (code wide) (codepoint string index)
|
|
818
|
|
- (if wide
|
|
819
|
|
- (setq code (unicode-upper code))
|
|
820
|
|
- (setf code (char-code (char-upcase (code-char code)))))
|
|
821
|
|
- ;;@@ WARNING: this may, in theory, need to extend string
|
|
822
|
|
- ;; (which, obviously, we can't do here. Unless
|
|
823
|
|
- ;; STRING is adjustable, maybe)
|
|
824
|
|
- ;; but that never actually occurs as of Unicode 5.1.0,
|
|
825
|
|
- ;; so I'm just going to ignore it for now...
|
|
826
|
|
- (multiple-value-bind (hi lo) (surrogates code)
|
|
827
|
|
- (setf (schar string index) hi)
|
|
828
|
|
- (when lo
|
|
829
|
|
- (setf (schar string (incf index)) lo))))))
|
|
830
|
|
- save-header))
|
|
831
|
|
-
|
|
832
|
721
|
(defun nstring-upcase (string &key (start 0) end)
|
|
833
|
722
|
"Given a string, returns that string with all lower case alphabetic
|
|
834
|
723
|
characters converted to uppercase."
|
| ... |
... |
@@ -842,31 +731,6 @@ |
|
842
|
731
|
(char-upcase (schar string index))))
|
|
843
|
732
|
save-header)))
|
|
844
|
733
|
|
|
845
|
|
-#+nil
|
|
846
|
|
-(defun nstring-downcase (string &key (start 0) end)
|
|
847
|
|
- "Given a string, returns that string with all upper case alphabetic
|
|
848
|
|
- characters converted to lowercase."
|
|
849
|
|
- (declare (fixnum start))
|
|
850
|
|
- (let ((save-header string))
|
|
851
|
|
- (with-one-string string start end offset
|
|
852
|
|
- (do ((index start (1+ index)))
|
|
853
|
|
- ((= index (the fixnum end)))
|
|
854
|
|
- (declare (fixnum index))
|
|
855
|
|
- (multiple-value-bind (code wide) (codepoint string index)
|
|
856
|
|
- (if wide
|
|
857
|
|
- (setq code (unicode-lower code))
|
|
858
|
|
- (setf code (char-code (char-downcase (code-char code)))))
|
|
859
|
|
- ;;@@ WARNING: this may, in theory, need to extend string
|
|
860
|
|
- ;; (which, obviously, we can't do here. Unless
|
|
861
|
|
- ;; STRING is adjustable, maybe)
|
|
862
|
|
- ;; but that never actually occurs as of Unicode 5.1.0,
|
|
863
|
|
- ;; so I'm just going to ignore it for now...
|
|
864
|
|
- (multiple-value-bind (hi lo) (surrogates code)
|
|
865
|
|
- (setf (schar string index) hi)
|
|
866
|
|
- (when lo
|
|
867
|
|
- (setf (schar string (incf index)) lo))))))
|
|
868
|
|
- save-header))
|
|
869
|
|
-
|
|
870
|
734
|
(defun nstring-downcase (string &key (start 0) end)
|
|
871
|
735
|
"Given a string, returns that string with all upper case alphabetic
|
|
872
|
736
|
characters converted to lowercase."
|