Raymond Toy pushed to branch issue-158-darwin-pathnames at cmucl / cmucl

Commits:

4 changed files:

Changes:

  • src/code/pathname.lisp
    ... ... @@ -252,7 +252,12 @@
    252 252
     ;;; This constructor is used to make an instance of the correct type
    
    253 253
     ;;; from parsed arguments.
    
    254 254
     
    
    255
    -(defvar *enable-normalization* nil)
    
    255
    +(defvar *enable-darwin-path-normalization* nil
    
    256
    +  "When non-NIL, pathnames are on Darwin are normalized when created.
    
    257
    +  Otherwise, the pathnames are unchanged.
    
    258
    +
    
    259
    +  This must be NIL during bootstrapping because Unicode is not yet
    
    260
    +  available.")
    
    256 261
     
    
    257 262
     (defun normalize-name (piece)
    
    258 263
       ;; Normalize Darwin pathnames by converting Hangul
    
    ... ... @@ -261,7 +266,7 @@
    261 266
       ;; characters.
    
    262 267
       (typecase piece
    
    263 268
         (string
    
    264
    -     (if *enable-normalization*
    
    269
    +     (if *enable-darwin-path-normalization*
    
    265 270
     	 (decompose (unicode::decompose-hangul piece)
    
    266 271
     		    :compatibility nil
    
    267 272
     		    :darwinp t)
    
    ... ... @@ -289,16 +294,29 @@
    289 294
     				(upcasify name)
    
    290 295
     				(upcasify type)
    
    291 296
     				(upcasify version)))
    
    292
    -      #-(not nil)
    
    297
    +      #-darwin
    
    293 298
           (%make-pathname host device directory name type version)
    
    294
    -      #+(not nil)
    
    295
    -      (%make-pathname host device
    
    296
    -		      (when directory
    
    297
    -			(list* (car directory)
    
    298
    -			       (mapcar #'normalize-name (cdr directory))))
    
    299
    -		      (normalize-name name)
    
    300
    -		      (normalize-name type)
    
    301
    -		      version))))
    
    299
    +      #+darwin
    
    300
    +      (flet ((normalize-name (piece)
    
    301
    +	       ;; Normalize Darwin pathnames by converting Hangul
    
    302
    +	       ;; syllables to conjoining jamo, and converting the
    
    303
    +	       ;; string to NFD form, but skipping over a range of
    
    304
    +	       ;; characters.
    
    305
    +	       (typecase piece
    
    306
    +		 (string
    
    307
    +		  (if *enable-darwin-path-normalization*
    
    308
    +		      (decompose (unicode::decompose-hangul piece)
    
    309
    +				 :compatibility nil
    
    310
    +				 :darwinp t)
    
    311
    +		      piece))
    
    312
    +		 (t
    
    313
    +		  ;; What should we do about lisp::pattern objects?
    
    314
    +		  piece))))
    
    315
    +	(%make-pathname host device
    
    316
    +			(mapcar #'normalize-name (cdr directory))
    
    317
    +			(normalize-name name)
    
    318
    +			(normalize-name type)
    
    319
    +			version))))
    
    302 320
     
    
    303 321
     ;;; *LOGICAL-HOSTS* --internal.
    
    304 322
     ;;;
    

  • src/code/save.lisp
    ... ... @@ -284,16 +284,17 @@
    284 284
     	     (set-up-locale-external-format)
    
    285 285
     	     ;; Set terminal encodings to :locale
    
    286 286
     	     (set-system-external-format :locale)
    
    287
    -	     ;; Get some unicode stuff needed for decomposing strings.
    
    288
    -	     ;; This is needed on Darwin to normalize pathname
    
    289
    -	     ;; objects, which needs this information.  If we don't,
    
    290
    -	     ;; we'll load the information at runtime when creating
    
    291
    -	     ;; the path to "unidata.dat", which then calls decompose
    
    292
    -	     ;; again, and so on.
    
    287
    +	     #+darwin
    
    293 288
     	     (progn
    
    289
    +	       ;; Get some unicode stuff needed for decomposing strings.
    
    290
    +	       ;; This is needed on Darwin to normalize pathname
    
    291
    +	       ;; objects, which needs this information.  If we don't,
    
    292
    +	       ;; we'll load the information at runtime when creating
    
    293
    +	       ;; the path to "unidata.dat", which then calls decompose
    
    294
    +	       ;; again, and so on.
    
    294 295
     	       (lisp::load-decomp)
    
    295 296
     	       (lisp::load-combining)
    
    296
    -	       (setf *enable-normalization* t))
    
    297
    +	       (setf *enable-darwin-path-normalization* t))
    
    297 298
     	     (ext::process-command-strings process-command-line)
    
    298 299
     	     (setf *editor-lisp-p* nil)
    
    299 300
     	     (macrolet ((find-switch (name)
    

  • src/code/unicode.lisp
    ... ... @@ -527,18 +527,19 @@
    527 527
     	 (l-base #x1100)
    
    528 528
     	 (v-base #x1161)
    
    529 529
     	 (t-base #x11a7)
    
    530
    -	 (s-count 11172)
    
    531
    -	 (l-count 19)
    
    532 530
     	 (v-count 21)
    
    533 531
     	 (t-count 28)
    
    534 532
     	 (n-count (* v-count t-count)))
    
    535 533
         ;; Step 1: Compute index of the syllable S
    
    536 534
         (let ((s-index (- cp s-base)))
    
    537
    -      ;; Step 2: If s is in the range 0 <= s <= s-count, the compute the components
    
    535
    +      ;; Step 2: If s is in the range 0 <= s <= s-count, the compute
    
    536
    +      ;; the components.
    
    538 537
           (let ((l (+ l-base (truncate s-index n-count)))
    
    539 538
     	    (v (+ v-base (truncate (mod s-index n-count) t-count)))
    
    540 539
     	    (tt (+ t-base (mod s-index t-count))))
    
    541
    -	;; Step 3: If tt = t-base, then there is no trailing character so replace s by the sequence <l,v>.  Otherwise there is a trailing character, so replace s by the sequence <l,v,tt>
    
    540
    +	;; Step 3: If tt = t-base, then there is no trailing character
    
    541
    +	;; so replace s by the sequence <l,v>.  Otherwise there is a
    
    542
    +	;; trailing character, so replace s by the sequence <l,v,tt>.
    
    542 543
     	(princ (code-char l) stream)
    
    543 544
     	(princ (code-char v) stream)
    
    544 545
     	(unless (= tt t-base)
    

  • src/code/unidata.lisp
    ... ... @@ -513,12 +513,11 @@
    513 513
     		    (read-vector lvec stm :endian-swap :network-order)
    
    514 514
     		    (values split hvec mvec lvec))))
    
    515 515
     	 (declare (ignorable #'read16 #'read32 #'read-ntrie))
    
    516
    -	 (let (#+nil(lisp::*enable-normalization* nil))
    
    517
    -	   (with-open-file (,stm *unidata-path* :direction :input
    
    518
    -						:element-type '(unsigned-byte 8))
    
    519
    -	     (unless (unidata-locate ,stm ,locn)
    
    520
    -	       (error (intl:gettext "No data in file.")))
    
    521
    -	     ,@body))))))
    
    516
    +	 (with-open-file (,stm *unidata-path* :direction :input
    
    517
    +					      :element-type '(unsigned-byte 8))
    
    518
    +	   (unless (unidata-locate ,stm ,locn)
    
    519
    +	     (error (intl:gettext "No data in file.")))
    
    520
    +	   ,@body)))))
    
    522 521
     
    
    523 522
     (defloader load-range (stm 0)
    
    524 523
       (let* ((n (read32 stm))