Changeset 15545


Ignore:
Timestamp:
Dec 20, 2012, 11:01:07 PM (7 years ago)
Author:
gb
Message:

Define, export, and provide doc strings for DEFINE-CHARACTER-ENCODING-ALIAS
and REMOVE-CHARACTER-ENCODING-ALIAS.

When parsing the "coding:" file option, warn (don't error) if the option's
value isn't recognized (todo: handle this warning in the Cocoa IDE) and
suggest use of DEFINE-CHARACTER-ENCODING-ALIAS in the warning.

Define Emacs-compatible aliases for :LATINn (:LATIN-n, :ISO-LATIN-n) and
:UTF-8 (:MULE-UTF-8).

Fixes ticket:1038 in the trunk. (Failure to recognize "latin-1" apparently
prevents some part of SLIME or SWANK from loading properly.)

Location:
trunk/source
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/l1-boot-3.lisp

    r13067 r15545  
    2121(in-package "CCL")
    2222
     23;;; Register Emacs-friendly aliases for some character encodings.
     24;;; This could go on forever; try to recognize at least some common
     25;;; cases.  (The precise set of encoding/coding-system names supported
     26;;; by Emacs likely depends on Emacs version, loaded Emacs packages, etc.)
     27
     28(dotimes (i 16)
     29  (let* ((key (find-symbol (format nil "LATIN~d" i) :keyword))
     30         (existing (and key (lookup-character-encoding key))))
     31    (when existing
     32      (define-character-encoding-alias (intern (format nil "LATIN-~d" i) :keyword) existing)
     33      (define-character-encoding-alias (intern (format nil "ISO-LATIN-~d" i) :keyword) existing))))
     34
     35(define-character-encoding-alias :mule-utf-8 :utf-8)
     36
    2337(catch :toplevel
    2438    (or (find-package "COMMON-LISP-USER")
  • trunk/source/level-1/l1-unicode.lisp

    r15536 r15545  
    189189                                           (if enc (character-encoding-name enc) encoding))))
    190190  code)
     191
     192
     193(defun remove-character-encoding-alias (alias)
     194  "(REMOVE-CHARACTER-ENCODING-ALIAS alias)
     195alias - a keyword which is an alias for a defined character encoding.
     196Makes the keyword cease to be an alias for that encoding and returns T."
     197  (let* ((encoding (get-character-encoding alias))
     198         (aliases (character-encoding-aliases encoding)))
     199    (if (not (member alias aliases))
     200      (error "~S is not an alias for ~s." alias encoding)
     201      (progn
     202        (setf (character-encoding-aliases encoding)
     203              (remove alias aliases))
     204        (remhash alias *character-encodings*)
     205        t))))
     206             
     207 
     208(defun define-character-encoding-alias (alias existing)
     209  "(DEFINE-CHARACTER-ENCODING-ALIAS alias existing)
     210alias - a keyword
     211existing - a defined character encoding or a keyword that names one.
     212Tries to make alias an alias for the existing encoding and returns
     213that encoding."
     214  (check-type alias keyword)
     215  (let* ((canonical-encoding (ensure-character-encoding existing))
     216         (current (lookup-character-encoding alias)))
     217    (unless (eq current canonical-encoding)
     218      (if (and current
     219               (eq alias (character-encoding-name current)))
     220        (error "Can't make ~s an alias for ~s, since it already names ~s."
     221               alias existing current)
     222        (progn
     223          (when current
     224            (setf (character-encoding-aliases current)
     225                  (remove alias (character-encoding-aliases current))))
     226          (pushnew alias (character-encoding-aliases canonical-encoding))
     227          (setf (get-character-encoding alias) canonical-encoding))))
     228    canonical-encoding))
     229
    191230                         
    192231;;; N.B.  (ccl:nfunction <name> (lambda (...) ...)) is just  like
     
    65206559               (setq emacs-name (subseq emacs-name 0 (- len 4))))))
    65216560        (let* ((key (intern (string-upcase emacs-name) "KEYWORD"))
    6522                (encoding (get-character-encoding key)))
     6561               (encoding (lookup-character-encoding key)))
    65236562          (if encoding
    65246563            (make-external-format :character-encoding (character-encoding-name encoding)
    65256564                                  :line-termination line-termination)
    6526             ;; Might be some cases where the Emacs name differs
    6527             ;; from ours, but can't think of any.
    6528             ))))
     6565            (warn "file CODING option ~s isn't recognized as the name of a character encoding.~&Consider using ~S to define ~S as an alias for a supported encoding." key key)))))
    65296566 
    65306567(defun external-format-from-file-options (line)
     
    65396576                 (eql octet (char-code #\return)))
    65406577             (return (external-format-from-file-options (%str-from-ptr buf i))))))))
    6541            
     6578
  • trunk/source/lib/ccl-export-syms.lisp

    r15379 r15545  
    723723     *default-file-character-encoding*
    724724     *default-socket-character-encoding*
     725     define-character-encoding-alias
     726     remove-character-encoding-alias
    725727     ;; Mapped files.
    726728     map-file-to-ivector
Note: See TracChangeset for help on using the changeset viewer.