Changeset 15532


Ignore:
Timestamp:
Dec 11, 2012, 6:46:22 AM (7 years ago)
Author:
gb
Message:

PARSE-FILE-OPTIONS-LINE, EXTERNAL-FORMAT-FROM-FILE-OPTIONS: not used
yet, may change.

File:
1 edited

Legend:

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

    r15328 r15532  
    64756475                    (setf lastch ch
    64766476                      (schar new (incf nout)) ch))))))))))
     6477
     6478;;; Parse the string LINE (an Emacs-style file-attributes line)
     6479;;; into a plist with Emacs variable names as keywords and values
     6480;;; as strings (or list of strings).  Quietly return NIL on error.
     6481(defun parse-file-options-line (line)
     6482  (let* ((start (search "-*-" line))
     6483         (start+3 (when start (+ start 3)))
     6484         (end (and start+3 (search "-*-" line :start2 start+3))))
     6485    (when end
     6486      (setq line (subseq line start+3 end))
     6487      (let* ((plist ()))
     6488        (loop
     6489          ;; The line between -*- pairs should be of the form
     6490          ;; {varname: value;}*.  Emacs and Hemlock both seem
     6491          ;; able to deal with the case where the last pair is
     6492          ;; missing a trailing semicolon.
     6493          (let* ((colon (position #\: line))
     6494                 (semi (and colon (position #\; line :start (1+ colon)))))
     6495            (unless colon
     6496              (return plist))
     6497            (let* ((key (intern (nstring-upcase (string-trim "  " (subseq line 0 colon))) "KEYWORD"))
     6498                   (val (string-trim '(#\space #\tab) (subseq line (1+ colon) (or semi (length line))))))
     6499              (setq line (if semi (subseq line (1+ semi)) ""))
     6500              (unless (eq key :eval)
     6501                (let* ((already (getf plist key)))
     6502                  (if already
     6503                    (setf (getf plist key) (nconc (if (atom already)
     6504                                                    (list already)
     6505                                                    already)
     6506                                                  (list val)))
     6507                    (setq plist (nconc plist (list key val)))))))))))))
     6508
     6509(defun external-format-from-file-options (line)
     6510  (let* ((emacs-name (getf (parse-file-options-line line) :coding))
     6511         (line-termination :unix))
     6512    (when emacs-name
     6513      (let* ((len (length emacs-name)))
     6514        (cond ((and (> len 5) (string-equal "-unix" emacs-name :start2 (- len 5)))
     6515               (setq emacs-name (subseq emacs-name 0 (- len 5))))
     6516              ((and (> len 4) (or
     6517                               (when (string-equal "-dos" emacs-name :start2 (- len 4))
     6518                                 (setq line-termination :crlf))
     6519                               (when (string-equal "-mac" emacs-name :start2 (- len 4))
     6520                                 (setq line-termination :cr))))
     6521                               
     6522               (setq emacs-name (subseq emacs-name 0 (- len 4))))))
     6523        (let* ((key (intern (string-upcase emacs-name) "KEYWORD"))
     6524               (encoding (get-character-encoding key)))
     6525          (if encoding
     6526            (make-external-format :character-encoding (character-encoding-name encoding)
     6527                                  :line-termination line-termination)
     6528            ;; Might be some cases where the Emacs name differs
     6529            ;; from ours, but can't think of any.
     6530            ))))))
Note: See TracChangeset for help on using the changeset viewer.