sharp-backslash.lisp - clic - Clic is an command line interactive client for gopher written in Common LISP
 (HTM) git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65d7roiv6bfj7d652fid.onion/clic/
 (DIR) Log
 (DIR) Files
 (DIR) Refs
 (DIR) Tags
 (DIR) README
 (DIR) LICENSE
       ---
       sharp-backslash.lisp (3620B)
       ---
            1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
            2 ;;;
            3 ;;; sharp-backslash.lisp --- Alternative #\ dispatch code.
            4 ;;;
            5 ;;; Copyright (C) 2007-2009, Luis Oliveira  <loliveira@common-lisp.net>
            6 ;;;
            7 ;;; Permission is hereby granted, free of charge, to any person
            8 ;;; obtaining a copy of this software and associated documentation
            9 ;;; files (the "Software"), to deal in the Software without
           10 ;;; restriction, including without limitation the rights to use, copy,
           11 ;;; modify, merge, publish, distribute, sublicense, and/or sell copies
           12 ;;; of the Software, and to permit persons to whom the Software is
           13 ;;; furnished to do so, subject to the following conditions:
           14 ;;;
           15 ;;; The above copyright notice and this permission notice shall be
           16 ;;; included in all copies or substantial portions of the Software.
           17 ;;;
           18 ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
           19 ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
           20 ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
           21 ;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
           22 ;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
           23 ;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
           24 ;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
           25 ;;; DEALINGS IN THE SOFTWARE.
           26 
           27 (in-package #:babel)
           28 
           29 #-allegro
           30 (defun sharp-backslash-reader (original-reader stream char numarg)
           31   (let ((1st-char (read-char stream)))
           32     (if (and (char-equal 1st-char #\u)
           33              ;; because #\z is not a digit char...
           34              (digit-char-p (peek-char nil stream nil #\z) 16))
           35         ;; something better than READ would be nice here
           36         (let ((token (let ((*read-base* 16)) (read stream))))
           37           (if (typep token 'babel-encodings::code-point)
           38               (code-char token)
           39               (if *read-suppress*
           40                   nil
           41                   (simple-reader-error
           42                    stream "Unrecognized character name: u~A" token))))
           43         (funcall original-reader
           44                  (make-concatenated-stream (make-string-input-stream
           45                                             (string 1st-char))
           46                                            stream)
           47                  char
           48                  numarg))))
           49 
           50 ;;; Allegro's PEEK-CHAR seems broken in some situations, and the code
           51 ;;; above would generate an error about too many calls to UNREAD-CHAR.
           52 ;;; Then Allegro's original SHARP-BACKSLASH wants to UNREAD-CHAR
           53 ;;; twice, very weird.  This is the best workaround I could think of.
           54 ;;; It sucks.
           55 #+allegro
           56 (defun sharp-backslash-reader (original-reader stream char numarg)
           57   (let* ((1st-char (read-char stream))
           58          (rest (ignore-errors (excl::read-extended-token stream)))
           59          (code (when (and rest (char-equal 1st-char #\u))
           60                  (ignore-errors (parse-integer rest :radix 16)))))
           61     (if code
           62         (code-char code)
           63         (with-input-from-string
           64             (s (concatenate 'string "#\\" (string 1st-char) rest))
           65           (read-char s)
           66           (read-char s)
           67           (funcall original-reader s char numarg)))))
           68 
           69 (defun make-sharp-backslash-reader ()
           70   (let ((original-sharp-backslash (get-dispatch-macro-character #\# #\\)))
           71     (lambda (stream char numarg)
           72       (sharp-backslash-reader original-sharp-backslash stream char numarg))))
           73 
           74 (defmacro enable-sharp-backslash-syntax ()
           75   `(eval-when (:compile-toplevel :execute)
           76      (setf *readtable* (copy-readtable *readtable*))
           77      (set-sharp-backslash-syntax-in-readtable)
           78      (values)))
           79 
           80 (defun set-sharp-backslash-syntax-in-readtable ()
           81   (set-dispatch-macro-character #\# #\\ (make-sharp-backslash-reader))
           82   (values))