source: branches/1.1.x/src/org/armedbear/lisp/LispCharacter.java

Last change on this file was 14371, checked in by Mark Evenson, 12 years ago

Backport r14360 | rschlatte | 2013-01-19 18:35:45 +0100 (Sat, 19 Jan 2013) | 1 line

add #\Delete character name (found in McCLIM sources)
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 18.2 KB
Line 
1/*
2 * LispCharacter.java
3 *
4 * Copyright (C) 2002-2007 Peter Graves
5 * $Id: LispCharacter.java 14371 2013-02-13 19:26:40Z 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    default:
270      if (name!=null)
271              sb.append(name);
272      else
273              sb.append(value);
274            break;
275          }
276      }
277    else
278      {
279        sb.append(value);
280      }
281    return sb.toString();
282  }
283
284  // ### character
285  private static final Primitive CHARACTER =
286    new Primitive(Symbol.CHARACTER, "character")
287    {
288      @Override
289      public LispObject execute(LispObject arg)
290      {
291        if (arg instanceof LispCharacter)
292          return arg;
293        if (arg instanceof AbstractString)
294          {
295            if (arg.length() == 1)
296              return ((AbstractString)arg).AREF(0);
297          }
298        else if (arg instanceof Symbol)
299          {
300            String name = ((Symbol)arg).getName();
301            if (name.length() == 1)
302              return LispCharacter.getInstance(name.charAt(0));
303          }
304        return type_error(arg, Symbol.CHARACTER_DESIGNATOR);
305      }
306    };
307
308  // ### whitespacep
309  private static final Primitive WHITESPACEP =
310    new Primitive("whitespacep", PACKAGE_SYS, true)
311    {
312      @Override
313      public LispObject execute(LispObject arg)
314      {
315          return Character.isWhitespace(LispCharacter.getValue(arg)) ? T : NIL;
316      }
317    };
318
319  // ### char-code
320  private static final Primitive CHAR_CODE =
321    new Primitive(Symbol.CHAR_CODE, "character")
322    {
323      @Override
324      public LispObject execute(LispObject arg)
325      {
326          int n = LispCharacter.getValue(arg);
327          return Fixnum.getInstance(n);
328      }
329    };
330
331  // ### char-int
332  private static final Primitive CHAR_INT =
333    new Primitive(Symbol.CHAR_INT, "character")
334    {
335      @Override
336      public LispObject execute(LispObject arg)
337      {
338          int n = LispCharacter.getValue(arg);
339          return Fixnum.getInstance(n);
340      }
341    };
342
343  // ### code-char
344  private static final Primitive CODE_CHAR =
345    new Primitive(Symbol.CODE_CHAR, "code")
346    {
347      @Override
348      public LispObject execute(LispObject arg)
349      {
350        int n = Fixnum.getValue(arg);
351        if (Character.isValidCodePoint(n))
352          return LispCharacter.getInstance((char)n);
353        return NIL;
354      }
355    };
356
357  // ### characterp
358  private static final Primitive CHARACTERP =
359    new Primitive(Symbol.CHARACTERP, "object")
360    {
361      @Override
362      public LispObject execute(LispObject arg)
363      {
364        return arg instanceof LispCharacter ? T : NIL;
365      }
366    };
367
368  // ### both-case-p
369  private static final Primitive BOTH_CASE_P =
370    new Primitive(Symbol.BOTH_CASE_P, "character")
371    {
372      @Override
373      public LispObject execute(LispObject arg)
374      {
375        char c = getValue(arg);
376        if (Character.isLowerCase(c) || Character.isUpperCase(c))
377          return T;
378        return NIL;
379      }
380    };
381
382  // ### lower-case-p
383  private static final Primitive LOWER_CASE_P =
384    new Primitive(Symbol.LOWER_CASE_P, "character")
385    {
386      @Override
387      public LispObject execute(LispObject arg)
388      {
389        return Character.isLowerCase(getValue(arg)) ? T : NIL;
390      }
391    };
392
393  // ### upper-case-p
394  private static final Primitive UPPER_CASE_P =
395    new Primitive(Symbol.UPPER_CASE_P, "character")
396    {
397      @Override
398      public LispObject execute(LispObject arg)
399      {
400        return Character.isUpperCase(getValue(arg)) ? T : NIL;
401      }
402    };
403
404  // ### char-downcase
405  private static final Primitive CHAR_DOWNCASE =
406    new Primitive(Symbol.CHAR_DOWNCASE, "character")
407    {
408      @Override
409      public LispObject execute(LispObject arg)
410      {
411          final char c = LispCharacter.getValue(arg);
412          if (c < 128)
413           return constants[LOWER_CASE_CHARS[c]];
414        return LispCharacter.getInstance(toLowerCase(c));
415      }
416    };
417
418  // ### char-upcase
419  private static final Primitive CHAR_UPCASE =
420    new Primitive(Symbol.CHAR_UPCASE, "character")
421    {
422      @Override
423      public LispObject execute(LispObject arg)
424      {
425        final char c;
426        c = LispCharacter.getValue(arg);
427        if (c < 128)
428          return constants[UPPER_CASE_CHARS[c]];
429        return LispCharacter.getInstance(toUpperCase(c));
430      }
431    };
432
433  // ### digit-char
434  private static final Primitive DIGIT_CHAR =
435    new Primitive(Symbol.DIGIT_CHAR, "weight &optional radix")
436    {
437      @Override
438      public LispObject execute(LispObject arg)
439      {
440          if (arg instanceof Bignum)
441              return NIL;
442
443          int weight = Fixnum.getValue(arg);
444        if (weight < 10)
445          return constants['0'+weight];
446        return NIL;
447      }
448      @Override
449      public LispObject execute(LispObject first, LispObject second)
450
451      {
452        int radix;
453        if (second instanceof Fixnum)
454            radix = ((Fixnum)second).value;
455        else
456            radix = -1;
457       
458        if (radix < 2 || radix > 36)
459          return type_error(second,
460                                 list(Symbol.INTEGER, Fixnum.TWO,
461                                       Fixnum.constants[36]));
462        if (first instanceof Bignum)
463            return NIL;
464        int weight = Fixnum.getValue(first);
465        if (weight >= radix)
466          return NIL;
467        if (weight < 10)
468          return constants['0' + weight];
469        return constants['A' + weight - 10];
470      }
471    };
472
473  // ### digit-char-p char &optional radix => weight
474  private static final Primitive DIGIT_CHAR_P =
475    new Primitive(Symbol.DIGIT_CHAR_P, "char &optional radix")
476    {
477      @Override
478      public LispObject execute(LispObject arg)
479      {
480          final int n = Character.digit(LispCharacter.getValue(arg), 10);
481          return n < 0 ? NIL : Fixnum.getInstance(n);
482      }
483      @Override
484      public LispObject execute(LispObject first, LispObject second)
485
486      {
487        char c;
488            c = LispCharacter.getValue(first);
489        if (second instanceof Fixnum)
490          {
491            int radix = ((Fixnum)second).value;
492            if (radix >= 2 && radix <= 36)
493              {
494                int n = Character.digit(c, radix);
495                return n < 0 ? NIL : Fixnum.constants[n];
496              }
497          }
498        return type_error(second,
499                               list(Symbol.INTEGER, Fixnum.TWO,
500                                     Fixnum.constants[36]));
501      }
502    };
503
504  // ### standard-char-p
505  private static final Primitive STANDARD_CHAR_P =
506    new Primitive(Symbol.STANDARD_CHAR_P, "character")
507    {
508      @Override
509      public LispObject execute(LispObject arg)
510      {
511          return checkCharacter(arg).isStandardChar() ? T : NIL;
512      }
513    };
514
515  // ### graphic-char-p
516  private static final Primitive GRAPHIC_CHAR_P =
517    new Primitive(Symbol.GRAPHIC_CHAR_P, "char")
518    {
519      @Override
520      public LispObject execute(LispObject arg)
521      {
522          char c = LispCharacter.getValue(arg);
523          if (c >= ' ' && c < 127)
524            return T;
525          return Character.isISOControl(c) ? NIL : T;
526      }
527    };
528
529  // ### alpha-char-p
530  private static final Primitive ALPHA_CHAR_P =
531    new Primitive(Symbol.ALPHA_CHAR_P, "character")
532    {
533      @Override
534      public LispObject execute(LispObject arg)
535      {
536          return Character.isLetter(LispCharacter.getValue(arg)) ? T : NIL;
537      }
538    };
539
540  // ### alphanumericp
541  private static final Primitive ALPHANUMERICP =
542    new Primitive(Symbol.ALPHANUMERICP, "character")
543    {
544      @Override
545      public LispObject execute(LispObject arg)
546      {
547          return Character.isLetterOrDigit(LispCharacter.getValue(arg)) ? T : NIL;
548      }
549    };
550
551  public static final int nameToChar(String s)
552  {
553    String lower = s.toLowerCase();
554    LispCharacter lc = namedToChar.get(lower);
555    if (lc!=null) return lc.value;
556    if (lower.length() == 5
557        && lower.startsWith("u")) {
558        try {
559            final int i = Integer.parseInt(lower.substring(1, 5), 16);
560            return i;
561        } catch (NumberFormatException e) {};
562    }
563    if (lower.equals("nul"))
564      return 0;
565    if (lower.equals("bel"))
566      return 7;
567    if (lower.equals("bs"))
568      return '\b';
569    if (lower.equals("ht"))
570      return '\t';
571    if (lower.equals("linefeed") || lower.equals("lf")) 
572      return '\n';
573    if (lower.equals("ff"))
574      return '\f';
575    if (lower.equals("cr"))
576      return '\r';
577    if (lower.equals("esc"))
578      return 27;
579    if (lower.equals("space") || lower.equals("sp"))
580      return ' ';
581    if (lower.equals("rubout") || lower.equals("del") || lower.equals("delete"))
582      return 127;
583    if (lower.startsWith("u")) {
584      int length = lower.length();
585      if (length > 1 && length < 5) {
586        try {
587          final int i = Integer.parseInt(lower.substring(1), 16);
588          return i;
589        } catch (NumberFormatException e) {};
590        // fall through
591      }
592    }
593
594    // Unknown.
595    return -1;
596  }
597
598  // ### name-char
599  private static final Primitive NAME_CHAR =
600    new Primitive(Symbol.NAME_CHAR, "name")
601    {
602      @Override
603      public LispObject execute(LispObject arg)
604      {
605        String s = arg.STRING().getStringValue();
606        int n = nameToChar(s);
607        return n >= 0 ? LispCharacter.getInstance((char)n) : NIL;
608      }
609    };
610
611  public static final String charToName(char c)
612  {
613    switch (c)
614      {
615      case 0:
616        return "Null";
617      case 7:
618        return "Bell";
619      case '\b':
620        return "Backspace";
621      case '\t':
622        return "Tab";
623      case '\n':
624        return "Newline";
625      case '\f':
626        return "Page";
627      case '\r':
628        return "Return";
629      case 27:
630        return "Escape";
631      case ' ':
632        return "Space";
633      case 127:
634        return "Rubout";
635      }
636
637    if (c<0 || c>255) return null;
638    return lispChars.get(c).name;
639  }
640
641  // ### char-name
642  private static final Primitive CHAR_NAME =
643    new Primitive(Symbol.CHAR_NAME, "character")
644    {
645      @Override
646      public LispObject execute(LispObject arg)
647      {
648        String name = charToName(LispCharacter.getValue(arg));
649        return name != null ? new SimpleString(name) : NIL;
650      }
651    };
652
653  public static final char toUpperCase(char c)
654  {
655    if (c < 128)
656      return UPPER_CASE_CHARS[c];
657    return Character.toUpperCase(c);
658  }
659
660  static int maxNamedChar = 0; 
661  static Map<String, LispCharacter> namedToChar = new HashMap<String, LispCharacter>(); 
662 
663  static void setCharNames(int i, String[] string) { 
664    int settingChar = i; 
665    int index = 0; 
666    int stringLen = string.length; 
667    while(stringLen-->0) { 
668      setCharName(settingChar,string[index]); 
669      index++; 
670      settingChar++; 
671    } 
672    if (maxNamedChar<settingChar) maxNamedChar = settingChar; 
673  } 
674 
675  static void setCharName(int settingChar, String string) { 
676    LispCharacter c = lispChars.get((char)settingChar); 
677    c.name = string; 
678    namedToChar.put(string.toLowerCase(), c); 
679  } 
680   
681  static { 
682   new CharNameMaker0(); 
683  } 
684   
685  static class CharNameMaker0{ 
686    { 
687      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"}); 
688      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"}); 
689    } 
690  } 
691
692  static final char[] UPPER_CASE_CHARS = new char[128];
693
694  static
695  {
696    for (int i = UPPER_CASE_CHARS.length; i-- > 0;)
697      UPPER_CASE_CHARS[i] = Character.toUpperCase((char)i);
698  }
699
700  public static final char toLowerCase(char c)
701  {
702    if (c < 128)
703      return LOWER_CASE_CHARS[c];
704    return Character.toLowerCase(c);
705  }
706
707  static final char[] LOWER_CASE_CHARS = new char[128];
708
709  static
710  {
711    for (int i = LOWER_CASE_CHARS.length; i-- > 0;)
712      LOWER_CASE_CHARS[i] = Character.toLowerCase((char)i);
713  }
714}
Note: See TracBrowser for help on using the repository browser.