source: branches/streams/abcl/src/org/armedbear/lisp/LispCharacter.java

Last change on this file was 14787, checked in by Mark Evenson, 10 years ago

Add character name for non-breaking space

Use a human readable name for character 160, #\No-break_space, which
is used in sbcl, ccl and clisp, and permits spinneret to load.

Thanks to Javier Olaechea.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 18.4 KB
Line 
1/*
2 * LispCharacter.java
3 *
4 * Copyright (C) 2002-2007 Peter Graves
5 * $Id: LispCharacter.java 14787 2015-06-12 09:18:37Z mevenson $
6 *
7 * This program is free software; you can redistribute it and/or
8 * modify it under the terms of the GNU General Public License
9 * as published by the Free Software Foundation; either version 2
10 * of the License, or (at your option) any later version.
11 *
12 * This program is distributed in the hope that it will be useful,
13 * but WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15 * GNU General Public License for more details.
16 *
17 * You should have received a copy of the GNU General Public License
18 * along with this program; if not, write to the Free Software
19 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
20 *
21 * As a special exception, the copyright holders of this library give you
22 * permission to link this library with independent modules to produce an
23 * executable, regardless of the license terms of these independent
24 * modules, and to copy and distribute the resulting executable under
25 * terms of your choice, provided that you also meet, for each linked
26 * independent module, the terms and conditions of the license of that
27 * module.  An independent module is a module which is not derived from
28 * or based on this library.  If you modify this library, you may extend
29 * this exception to your version of the library, but you are not
30 * obligated to do so.  If you do not wish to do so, delete this
31 * exception statement from your version.
32 */
33
34package org.armedbear.lisp;
35
36import static org.armedbear.lisp.Lisp.*;
37import java.util.HashMap;
38import java.util.Map;
39
40public final class LispCharacter extends LispObject
41{
42  public static final LispCharacter[] constants;
43  public static final CharHashMap<LispCharacter> lispChars;
44
45  static
46  {
47    lispChars = new CharHashMap<LispCharacter>(LispCharacter.class,null){
48      public LispCharacter get(char c) {
49        LispCharacter lc = super.get(c);
50        if (lc==null) {
51          lc = new LispCharacter(c);
52          put(c, lc);
53        }
54        return lc;
55      }
56    };
57    constants = lispChars.constants;
58    for (int i = constants.length; i-- > 0;)
59      constants[i] = new LispCharacter((char)i);
60  }
61
62  public final char value;
63  private String name;
64  public static LispCharacter getInstance(char c)
65  {
66    return lispChars.get(c);
67  }
68
69  // This needs to be public for the compiler.
70  private LispCharacter(char c)
71  {
72    this.value = c;
73  }
74
75  @Override
76  public LispObject typeOf()
77  {
78    if (isStandardChar())
79      return Symbol.STANDARD_CHAR;
80    return Symbol.CHARACTER;
81  }
82
83  @Override
84  public LispObject classOf()
85  {
86    return BuiltInClass.CHARACTER;
87  }
88
89  @Override
90  public LispObject getDescription()
91  {
92    StringBuilder sb = new StringBuilder("character #\\");
93    sb.append(value);
94    sb.append(" char-code #x");
95    sb.append(Integer.toHexString(value));
96    return new SimpleString(sb);
97  }
98
99  @Override
100  public LispObject typep(LispObject type)
101  {
102    if (type == Symbol.CHARACTER)
103      return T;
104    if (type == BuiltInClass.CHARACTER)
105      return T;
106    if (type == Symbol.BASE_CHAR)
107      return T;
108    if (type == Symbol.STANDARD_CHAR)
109      return isStandardChar() ? T : NIL;
110    return super.typep(type);
111  }
112
113  @Override
114  public boolean characterp()
115  {
116    return true;
117  }
118
119  @Override
120  public LispObject STRING()
121  {
122    return new SimpleString(value);
123  }
124
125  boolean isStandardChar()
126  {
127    if (value >= ' ' && value < 127)
128      return true;
129    if (value == '\n')
130      return true;
131    return false;
132  }
133
134  @Override
135  public boolean eql(char c)
136  {
137    return value == c;
138  }
139
140  @Override
141  public boolean eql(LispObject obj)
142  {
143    if (this == obj)
144      return true;
145    if (obj instanceof LispCharacter)
146      {
147        if (value == ((LispCharacter)obj).value)
148          return true;
149      }
150    return false;
151  }
152
153  @Override
154  public boolean equal(LispObject obj)
155  {
156    if (this == obj)
157      return true;
158    if (obj instanceof LispCharacter)
159      {
160        if (value == ((LispCharacter)obj).value)
161          return true;
162      }
163    return false;
164  }
165
166  @Override
167  public boolean equalp(LispObject obj)
168  {
169    if (this == obj)
170      return true;
171    if (obj instanceof LispCharacter)
172      {
173        if (value == ((LispCharacter)obj).value)
174          return true;
175        return LispCharacter.toLowerCase(value) == LispCharacter.toLowerCase(((LispCharacter)obj).value);
176      }
177    return false;
178  }
179
180  public static char getValue(LispObject obj)
181  {
182      if (obj instanceof LispCharacter)
183        return ((LispCharacter)obj).value;
184      type_error(obj, Symbol.CHARACTER);
185        // Not reached.
186      return 0;
187  }
188
189  public final char getValue()
190  {
191    return value;
192  }
193
194  @Override
195  public Object javaInstance()
196  {
197    return Character.valueOf(value);
198  }
199
200  @Override
201  public Object javaInstance(Class c)
202  {
203    return javaInstance();
204  }
205
206  @Override
207  public int sxhash()
208  {
209    return value;
210  }
211
212  @Override
213  public int psxhash()
214  {
215    return Character.toUpperCase(value);
216  }
217
218  /** See LispObject.getStringValue() */
219  @Override
220  public String getStringValue()
221  {
222    return String.valueOf(value);
223  }
224
225  @Override
226  public final String printObject()
227  {
228    final LispThread thread = LispThread.currentThread();
229    boolean printReadably = (Symbol.PRINT_READABLY.symbolValue(thread) != NIL);
230    // "Specifically, if *PRINT-READABLY* is true, printing proceeds as if
231    // *PRINT-ESCAPE*, *PRINT-ARRAY*, and *PRINT-GENSYM* were also true,
232    // and as if *PRINT-LENGTH*, *PRINT-LEVEL*, and *PRINT-LINES* were
233    // false."
234    boolean printEscape =
235      printReadably || (Symbol.PRINT_ESCAPE.symbolValue(thread) != NIL);
236    StringBuilder sb = new StringBuilder();
237    if (printEscape)
238      {
239        sb.append("#\\");
240        switch (value)
241          {
242          case 0:
243            sb.append("Null");
244            break;
245          case 7:
246            sb.append("Bell");
247            break;
248          case '\b':
249            sb.append("Backspace");
250            break;
251          case '\t':
252            sb.append("Tab");
253            break;
254          case '\n':
255            sb.append("Newline");
256            break;
257          case '\f':
258            sb.append("Page");
259            break;
260          case '\r':
261            sb.append("Return");
262            break;
263          case 27:
264            sb.append("Escape");
265            break;
266          case 127:
267            sb.append("Rubout");
268            break;
269          case 160:
270            sb.append("No-break_space");
271            break;
272    default:
273      if (name!=null)
274              sb.append(name);
275      else
276              sb.append(value);
277            break;
278          }
279      }
280    else
281      {
282        sb.append(value);
283      }
284    return sb.toString();
285  }
286
287  // ### character
288  private static final Primitive CHARACTER =
289    new Primitive(Symbol.CHARACTER, "character")
290    {
291      @Override
292      public LispObject execute(LispObject arg)
293      {
294        if (arg instanceof LispCharacter)
295          return arg;
296        if (arg instanceof AbstractString)
297          {
298            if (arg.length() == 1)
299              return ((AbstractString)arg).AREF(0);
300          }
301        else if (arg instanceof Symbol)
302          {
303            String name = ((Symbol)arg).getName();
304            if (name.length() == 1)
305              return LispCharacter.getInstance(name.charAt(0));
306          }
307        return type_error(arg, Symbol.CHARACTER_DESIGNATOR);
308      }
309    };
310
311  // ### whitespacep
312  private static final Primitive WHITESPACEP =
313    new Primitive("whitespacep", PACKAGE_SYS, true)
314    {
315      @Override
316      public LispObject execute(LispObject arg)
317      {
318          return Character.isWhitespace(LispCharacter.getValue(arg)) ? T : NIL;
319      }
320    };
321
322  // ### char-code
323  private static final Primitive CHAR_CODE =
324    new Primitive(Symbol.CHAR_CODE, "character")
325    {
326      @Override
327      public LispObject execute(LispObject arg)
328      {
329          int n = LispCharacter.getValue(arg);
330          return Fixnum.getInstance(n);
331      }
332    };
333
334  // ### char-int
335  private static final Primitive CHAR_INT =
336    new Primitive(Symbol.CHAR_INT, "character")
337    {
338      @Override
339      public LispObject execute(LispObject arg)
340      {
341          int n = LispCharacter.getValue(arg);
342          return Fixnum.getInstance(n);
343      }
344    };
345
346  // ### code-char
347  private static final Primitive CODE_CHAR =
348    new Primitive(Symbol.CODE_CHAR, "code")
349    {
350      @Override
351      public LispObject execute(LispObject arg)
352      {
353        int n = Fixnum.getValue(arg);
354        if (Character.isValidCodePoint(n))
355          return LispCharacter.getInstance((char)n);
356        return NIL;
357      }
358    };
359
360  // ### characterp
361  private static final Primitive CHARACTERP =
362    new Primitive(Symbol.CHARACTERP, "object")
363    {
364      @Override
365      public LispObject execute(LispObject arg)
366      {
367        return arg instanceof LispCharacter ? T : NIL;
368      }
369    };
370
371  // ### both-case-p
372  private static final Primitive BOTH_CASE_P =
373    new Primitive(Symbol.BOTH_CASE_P, "character")
374    {
375      @Override
376      public LispObject execute(LispObject arg)
377      {
378        char c = getValue(arg);
379        if (Character.isLowerCase(c) || Character.isUpperCase(c))
380          return T;
381        return NIL;
382      }
383    };
384
385  // ### lower-case-p
386  private static final Primitive LOWER_CASE_P =
387    new Primitive(Symbol.LOWER_CASE_P, "character")
388    {
389      @Override
390      public LispObject execute(LispObject arg)
391      {
392        return Character.isLowerCase(getValue(arg)) ? T : NIL;
393      }
394    };
395
396  // ### upper-case-p
397  private static final Primitive UPPER_CASE_P =
398    new Primitive(Symbol.UPPER_CASE_P, "character")
399    {
400      @Override
401      public LispObject execute(LispObject arg)
402      {
403        return Character.isUpperCase(getValue(arg)) ? T : NIL;
404      }
405    };
406
407  // ### char-downcase
408  private static final Primitive CHAR_DOWNCASE =
409    new Primitive(Symbol.CHAR_DOWNCASE, "character")
410    {
411      @Override
412      public LispObject execute(LispObject arg)
413      {
414          final char c = LispCharacter.getValue(arg);
415          if (c < 128)
416           return constants[LOWER_CASE_CHARS[c]];
417        return LispCharacter.getInstance(toLowerCase(c));
418      }
419    };
420
421  // ### char-upcase
422  private static final Primitive CHAR_UPCASE =
423    new Primitive(Symbol.CHAR_UPCASE, "character")
424    {
425      @Override
426      public LispObject execute(LispObject arg)
427      {
428        final char c;
429        c = LispCharacter.getValue(arg);
430        if (c < 128)
431          return constants[UPPER_CASE_CHARS[c]];
432        return LispCharacter.getInstance(toUpperCase(c));
433      }
434    };
435
436  // ### digit-char
437  private static final Primitive DIGIT_CHAR =
438    new Primitive(Symbol.DIGIT_CHAR, "weight &optional radix")
439    {
440      @Override
441      public LispObject execute(LispObject arg)
442      {
443          if (arg instanceof Bignum)
444              return NIL;
445
446          int weight = Fixnum.getValue(arg);
447        if (weight < 10)
448          return constants['0'+weight];
449        return NIL;
450      }
451      @Override
452      public LispObject execute(LispObject first, LispObject second)
453
454      {
455        int radix;
456        if (second instanceof Fixnum)
457            radix = ((Fixnum)second).value;
458        else
459            radix = -1;
460       
461        if (radix < 2 || radix > 36)
462          return type_error(second,
463                                 list(Symbol.INTEGER, Fixnum.TWO,
464                                       Fixnum.constants[36]));
465        if (first instanceof Bignum)
466            return NIL;
467        int weight = Fixnum.getValue(first);
468        if (weight >= radix)
469          return NIL;
470        if (weight < 10)
471          return constants['0' + weight];
472        return constants['A' + weight - 10];
473      }
474    };
475
476  // ### digit-char-p char &optional radix => weight
477  private static final Primitive DIGIT_CHAR_P =
478    new Primitive(Symbol.DIGIT_CHAR_P, "char &optional radix")
479    {
480      @Override
481      public LispObject execute(LispObject arg)
482      {
483          final int n = Character.digit(LispCharacter.getValue(arg), 10);
484          return n < 0 ? NIL : Fixnum.getInstance(n);
485      }
486      @Override
487      public LispObject execute(LispObject first, LispObject second)
488
489      {
490        char c;
491            c = LispCharacter.getValue(first);
492        if (second instanceof Fixnum)
493          {
494            int radix = ((Fixnum)second).value;
495            if (radix >= 2 && radix <= 36)
496              {
497                int n = Character.digit(c, radix);
498                return n < 0 ? NIL : Fixnum.constants[n];
499              }
500          }
501        return type_error(second,
502                               list(Symbol.INTEGER, Fixnum.TWO,
503                                     Fixnum.constants[36]));
504      }
505    };
506
507  // ### standard-char-p
508  private static final Primitive STANDARD_CHAR_P =
509    new Primitive(Symbol.STANDARD_CHAR_P, "character")
510    {
511      @Override
512      public LispObject execute(LispObject arg)
513      {
514          return checkCharacter(arg).isStandardChar() ? T : NIL;
515      }
516    };
517
518  // ### graphic-char-p
519  private static final Primitive GRAPHIC_CHAR_P =
520    new Primitive(Symbol.GRAPHIC_CHAR_P, "char")
521    {
522      @Override
523      public LispObject execute(LispObject arg)
524      {
525          char c = LispCharacter.getValue(arg);
526          if (c >= ' ' && c < 127)
527            return T;
528          return Character.isISOControl(c) ? NIL : T;
529      }
530    };
531
532  // ### alpha-char-p
533  private static final Primitive ALPHA_CHAR_P =
534    new Primitive(Symbol.ALPHA_CHAR_P, "character")
535    {
536      @Override
537      public LispObject execute(LispObject arg)
538      {
539          return Character.isLetter(LispCharacter.getValue(arg)) ? T : NIL;
540      }
541    };
542
543  // ### alphanumericp
544  private static final Primitive ALPHANUMERICP =
545    new Primitive(Symbol.ALPHANUMERICP, "character")
546    {
547      @Override
548      public LispObject execute(LispObject arg)
549      {
550          return Character.isLetterOrDigit(LispCharacter.getValue(arg)) ? T : NIL;
551      }
552    };
553
554  public static final int nameToChar(String s)
555  {
556    String lower = s.toLowerCase();
557    LispCharacter lc = namedToChar.get(lower);
558    if (lc!=null) return lc.value;
559    if (lower.length() == 5
560        && lower.startsWith("u")) {
561        try {
562            final int i = Integer.parseInt(lower.substring(1, 5), 16);
563            return i;
564        } catch (NumberFormatException e) {};
565    }
566    if (lower.equals("nul"))
567      return 0;
568    if (lower.equals("bel"))
569      return 7;
570    if (lower.equals("bs"))
571      return '\b';
572    if (lower.equals("ht"))
573      return '\t';
574    if (lower.equals("linefeed") || lower.equals("lf")) 
575      return '\n';
576    if (lower.equals("ff"))
577      return '\f';
578    if (lower.equals("cr"))
579      return '\r';
580    if (lower.equals("esc"))
581      return 27;
582    if (lower.equals("space") || lower.equals("sp"))
583      return ' ';
584    if (lower.equals("rubout") || lower.equals("del") || lower.equals("delete"))
585      return 127;
586    if (lower.equals("no-break_space"))
587      return 160;
588    if (lower.startsWith("u")) {
589      int length = lower.length();
590      if (length > 1 && length < 5) {
591        try {
592          final int i = Integer.parseInt(lower.substring(1), 16);
593          return i;
594        } catch (NumberFormatException e) {};
595        // fall through
596      }
597    }
598
599    // Unknown.
600    return -1;
601  }
602
603  // ### name-char
604  private static final Primitive NAME_CHAR =
605    new Primitive(Symbol.NAME_CHAR, "name")
606    {
607      @Override
608      public LispObject execute(LispObject arg)
609      {
610        String s = arg.STRING().getStringValue();
611        int n = nameToChar(s);
612        return n >= 0 ? LispCharacter.getInstance((char)n) : NIL;
613      }
614    };
615
616  public static final String charToName(char c)
617  {
618    switch (c)
619      {
620      case 0:
621        return "Null";
622      case 7:
623        return "Bell";
624      case '\b':
625        return "Backspace";
626      case '\t':
627        return "Tab";
628      case '\n':
629        return "Newline";
630      case '\f':
631        return "Page";
632      case '\r':
633        return "Return";
634      case 27:
635        return "Escape";
636      case ' ':
637        return "Space";
638      case 127:
639        return "Rubout";
640      case 160:
641        return "No-break_space";
642      }
643
644    if (c<0 || c>255) return null;
645    return lispChars.get(c).name;
646  }
647
648  // ### char-name
649  private static final Primitive CHAR_NAME =
650    new Primitive(Symbol.CHAR_NAME, "character")
651    {
652      @Override
653      public LispObject execute(LispObject arg)
654      {
655        String name = charToName(LispCharacter.getValue(arg));
656        return name != null ? new SimpleString(name) : NIL;
657      }
658    };
659
660  public static final char toUpperCase(char c)
661  {
662    if (c < 128)
663      return UPPER_CASE_CHARS[c];
664    return Character.toUpperCase(c);
665  }
666
667  static int maxNamedChar = 0; 
668  static Map<String, LispCharacter> namedToChar = new HashMap<String, LispCharacter>(); 
669 
670  static void setCharNames(int i, String[] string) { 
671    int settingChar = i; 
672    int index = 0; 
673    int stringLen = string.length; 
674    while(stringLen-->0) { 
675      setCharName(settingChar,string[index]); 
676      index++; 
677      settingChar++; 
678    } 
679    if (maxNamedChar<settingChar) maxNamedChar = settingChar; 
680  } 
681 
682  static void setCharName(int settingChar, String string) { 
683    LispCharacter c = lispChars.get((char)settingChar); 
684    c.name = string; 
685    namedToChar.put(string.toLowerCase(), c); 
686  } 
687   
688  static { 
689   new CharNameMaker0(); 
690  } 
691   
692  static class CharNameMaker0{ 
693    { 
694      setCharNames(0,new String[]{"Null", "Soh", "Stx", "Etx", "Eot", "Enq", "Ack", "Bell", "Backspace", "Tab", "Newline", "Vt", "Page", "Return", "So", "Si", "Dle", "Dc1", "Dc2", "Dc3", "Dc4", "Nak", "Syn", "Etb", "Can", "Em", "Sub", "Escape", "Fs", "Gs", "Rs", "Us"}); 
695      setCharNames(128,new String[]{"U0080", "U0081", "U0082", "U0083", "U0084", "U0085", "U0086", "U0087", "U0088", "U0089", "U008a", "U008b", "U008c", "U008d", "U008e", "U008f", "U0090", "U0091", "U0092", "U0093", "U0094", "U0095", "U0096", "U0097", "U0098", "U0099", "U009a", "U009b", "U009c", "U009d", "U009e", "U009f"}); 
696    } 
697  } 
698
699  static final char[] UPPER_CASE_CHARS = new char[128];
700
701  static
702  {
703    for (int i = UPPER_CASE_CHARS.length; i-- > 0;)
704      UPPER_CASE_CHARS[i] = Character.toUpperCase((char)i);
705  }
706
707  public static final char toLowerCase(char c)
708  {
709    if (c < 128)
710      return LOWER_CASE_CHARS[c];
711    return Character.toLowerCase(c);
712  }
713
714  static final char[] LOWER_CASE_CHARS = new char[128];
715
716  static
717  {
718    for (int i = LOWER_CASE_CHARS.length; i-- > 0;)
719      LOWER_CASE_CHARS[i] = Character.toLowerCase((char)i);
720  }
721}
Note: See TracBrowser for help on using the repository browser.