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))