September 2010 - cmucl-cvs - mailman3.common-lisp.net

[cmucl-cvs] CMUCL commit: src/i18n/locale (cmucl-x87.pot)
by Raymond Toy 20 Sep '10

20 Sep '10

Date: Monday, September 20, 2010 @ 16:32:23 Author: rtoy Path: /project/cmucl/cvsroot/src/i18n/locale Modified: cmucl-x87.pot Update from latest sources to get new messages strings from x86/float.lisp. ---------------+ cmucl-x87.pot | 184 +++++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 183 insertions(+), 1 deletion(-) Index: src/i18n/locale/cmucl-x87.pot diff -u src/i18n/locale/cmucl-x87.pot:1.3 src/i18n/locale/cmucl-x87.pot:1.4 --- src/i18n/locale/cmucl-x87.pot:1.3 Tue Apr 20 14:05:43 2010 +++ src/i18n/locale/cmucl-x87.pot Mon Sep 20 16:32:23 2010 @@ -15,8 +15,190 @@ "Content-Type: text/plain; charset=UTF-8\n" "Content-Transfer-Encoding: 8bit\n" +#: src/compiler/x86/float.lisp +msgid "Ignoring bogus i387 Constant ~a" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "float move" +msgstr "" + #: src/compiler/x86/x87-array.lisp src/compiler/x86/x87-c-call.lisp -#: src/compiler/x86/x87-sap.lisp +#: src/compiler/x86/x87-sap.lisp src/compiler/x86/float.lisp msgid "Unknown SC to SC-Case for ~S:~% ~S" msgstr "" +#: src/compiler/x86/float.lisp +msgid "complex float move" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "float to pointer coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "" +"Load TN allocated, but no move function?~@\n" +" VM definition inconsistent, recompile and try again." +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "pointer to float coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "complex float to pointer coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "complex double-double float to pointer coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "pointer to complex float coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "float argument move" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "complex float argument move" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "complex double-double-float argument move" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline float arithmetic" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline float comparison" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline float coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline float truncate" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline NPX function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline tan function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline sin/cos function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline exp function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline expm1 function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline log function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline log10 function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline pow function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline scalbn function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline scalb function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline log1p function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline log1p with limited x range function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline logb function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline atan function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline atan2 function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline complex single-float creation" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline complex double-float creation" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline complex long-float creation" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "complex float realpart" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "complex float imagpart" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline dummy FP register bias" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "double-double float move" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "double double float to pointer coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "pointer to double-double-float coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "double double-float argument move" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline double-double-float creation" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "double-double high part" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "double-double low part" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline complex double-double-float creation" +msgstr "" +

1 0

[cmucl-cvs] CMUCL commit: src/i18n/locale (cmucl.pot)
by Raymond Toy 20 Sep '10

20 Sep '10

Date: Monday, September 20, 2010 @ 16:25:10 Author: rtoy Path: /project/cmucl/cvsroot/src/i18n/locale Modified: cmucl.pot Update from latest sources to get new messages strings. -----------+ cmucl.pot | 47 ++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 46 insertions(+), 1 deletion(-) Index: src/i18n/locale/cmucl.pot diff -u src/i18n/locale/cmucl.pot:1.13 src/i18n/locale/cmucl.pot:1.14 --- src/i18n/locale/cmucl.pot:1.13 Wed Sep 15 16:00:46 2010 +++ src/i18n/locale/cmucl.pot Mon Sep 20 16:25:09 2010 @@ -5265,6 +5265,17 @@ msgstr "" #: src/code/unidata.lisp +msgid "" +"Search the Unicode name dictionary for the longest entry that\n" +" matches STRING. STRING must be in Unicode name format. That is, it\n" +" must be upper case with spaces separating each word.\n" +"\n" +" Two values are returned. The first value is index into the codebook\n" +" that continues the string.. The second value is the length of the\n" +" substring of string that matches the codebook. " +msgstr "" + +#: src/code/unidata.lisp msgid "The Unicode data file is broken." msgstr "" @@ -5276,6 +5287,37 @@ msgid "No data in file." msgstr "" +#: src/code/unidata.lisp +msgid "Dictionary of Hangul syllables" +msgstr "" + +#: src/code/unidata.lisp +msgid "Dictionary of CJK Unified ideographs" +msgstr "" + +#: src/code/unidata.lisp +msgid "" +"Try to complete the string Prefix using the dictionary in Dict.\n" +" Three values are returned: (1) The best match of prefix, (2) a list\n" +" of possible completions, (3) a boolean indicating whether the best\n" +" match is a complete unicode name. " +msgstr "" + +#: src/code/unidata.lisp +msgid "" +"Search the dictionary in Dict and return a list of the possible\n" +" completions starting with Prefix. If there is no match, NIL is\n" +" returned." +msgstr "" + +#: src/code/unidata.lisp +msgid "Build the dictionary for Hangul syllables" +msgstr "" + +#: src/code/unidata.lisp +msgid "Build the dictionary for CJK Unified Ideographs" +msgstr "" + #: src/code/char.lisp msgid "The upper exclusive bound on values produced by CHAR-CODE." msgstr "" @@ -12956,7 +12998,10 @@ " same place as normal output.\n" " :status-hook -\n" " This is a function the system calls whenever the status of the\n" -" process changes. The function takes the process as an argument." +" process changes. The function takes the process as an argument.\n" +" :external-format -\n" +" This is the external-format used for communication with the subproce" +"ss." msgstr "" #: src/code/run-program.lisp

1 0

[cmucl-cvs] CMUCL commit: src/compiler/x86 (float.lisp)
by Raymond Toy 20 Sep '10

20 Sep '10

Date: Monday, September 20, 2010 @ 16:22:03 Author: rtoy Path: /project/cmucl/cvsroot/src/compiler/x86 Modified: float.lisp This entire file should be in the cmucl-x87 domain, not cmucl-x86-vm. ------------+ float.lisp | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) Index: src/compiler/x86/float.lisp diff -u src/compiler/x86/float.lisp:1.60 src/compiler/x86/float.lisp:1.61 --- src/compiler/x86/float.lisp:1.60 Tue Apr 20 13:57:47 2010 +++ src/compiler/x86/float.lisp Mon Sep 20 16:22:03 2010 @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group(a)cs.cmu.edu. ;;; (ext:file-comment - "$Header: /project/cmucl/cvsroot/src/compiler/x86/float.lisp,v 1.60 2010-04-20 17:57:47 rtoy Exp $") + "$Header: /project/cmucl/cvsroot/src/compiler/x86/float.lisp,v 1.61 2010-09-20 20:22:03 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -22,7 +22,7 @@ ;;; (in-package :x86) -(intl:textdomain "cmucl-x86-vm") +(intl:textdomain "cmucl-x87") @@ -1709,6 +1709,7 @@ ;;; Comparisons with 0 can use the FTST instruction. + (define-vop (float-test) (:args (x)) (:temporary (:sc word-reg :offset eax-offset :from :eval) temp)

1 0

[cmucl-cvs] CMUCL commit: src/code (run-program.lisp)
by Raymond Toy 20 Sep '10

20 Sep '10

Date: Monday, September 20, 2010 @ 09:50:53 Author: rtoy Path: /project/cmucl/cvsroot/src/code Modified: run-program.lisp Add support for external formats for RUN-PROGRAM, which now takes an :EXTERNAL-FORMAT keyword argument to specify the format to use for any streams that RUN-PROGRAM needs to create. Patch from Paul Foley. ------------------+ run-program.lisp | 36 ++++++++++++++++++++++++------------ 1 file changed, 24 insertions(+), 12 deletions(-) Index: src/code/run-program.lisp diff -u src/code/run-program.lisp:1.31 src/code/run-program.lisp:1.32 --- src/code/run-program.lisp:1.31 Tue Apr 20 13:57:45 2010 +++ src/code/run-program.lisp Mon Sep 20 09:50:52 2010 @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /project/cmucl/cvsroot/src/code/run-program.lisp,v 1.31 2010-04-20 17:57:45 rtoy Exp $") + "$Header: /project/cmucl/cvsroot/src/code/run-program.lisp,v 1.32 2010-09-20 13:50:52 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -325,7 +325,7 @@ ;;; OPEN-PTY -- internal ;;; -(defun open-pty (pty cookie) +(defun open-pty (pty cookie &optional (external-format :default)) (when pty (multiple-value-bind (master slave name) @@ -340,7 +340,8 @@ (push new-fd *close-on-error*) (copy-descriptor-to-stream new-fd pty cookie))) (values name - (system:make-fd-stream master :input t :output t))))) + (system:make-fd-stream master :input t :output t + :external-format external-format))))) (defmacro round-bytes-to-words (n) @@ -454,7 +455,8 @@ (defun run-program (program args &key (env *environment-list*) (wait t) pty input if-input-does-not-exist output (if-output-exists :error) - (error :output) (if-error-exists :error) status-hook) + (error :output) (if-error-exists :error) status-hook + (external-format :default)) "RUN-PROGRAM creates a new process and runs the unix program in the file specified by the simple-string PROGRAM. ARGS are the standard arguments that can be passed to a Unix program, for no arguments @@ -506,14 +508,16 @@ same place as normal output. :status-hook - This is a function the system calls whenever the status of the - process changes. The function takes the process as an argument." + process changes. The function takes the process as an argument. + :external-format - + This is the external-format used for communication with the subprocess." ;; Make sure the interrupt handler is installed. (system:enable-interrupt unix:sigchld #'sigchld-handler) ;; Make sure all the args are okay. (unless (every #'simple-string-p args) (error (intl:gettext "All args to program must be simple strings -- ~S.") args)) - ;; Pre-pend the program to the argument list. + ;; Prepend the program to the argument list. (push (namestring program) args) ;; Clear random specials used by GET-DESCRIPTOR-FOR to communicate cleanup ;; info. Also, establish proc at this level so we can return it. @@ -526,21 +530,24 @@ (multiple-value-bind (stdin input-stream) (get-descriptor-for input cookie :direction :input - :if-does-not-exist if-input-does-not-exist) + :if-does-not-exist if-input-does-not-exist + :external-format external-format) (multiple-value-bind (stdout output-stream) (get-descriptor-for output cookie :direction :output :if-does-not-exist :create - :if-exists if-output-exists) + :if-exists if-output-exists + :external-format external-format) (multiple-value-bind (stderr error-stream) (if (eq error :output) (values stdout output-stream) (get-descriptor-for error cookie :direction :output :if-does-not-exist :create - :if-exists if-error-exists)) + :if-exists if-error-exists + :external-format external-format)) (multiple-value-bind (pty-name pty-stream) - (open-pty pty cookie) + (open-pty pty cookie external-format) ;; Make sure we are not notified about the child death before ;; we have installed the process struct in *active-processes* (system:without-interrupts @@ -644,6 +651,7 @@ ;;; second value. ;;; (defun get-descriptor-for (object cookie &rest keys &key direction + external-format &allow-other-keys) (cond ((eq object t) ;; No new descriptor is needed. @@ -674,12 +682,16 @@ (:input (push read-fd *close-in-parent*) (push write-fd *close-on-error*) - (let ((stream (system:make-fd-stream write-fd :output t))) + (let ((stream (system:make-fd-stream write-fd :output t + :external-format + external-format))) (values read-fd stream))) (:output (push read-fd *close-on-error*) (push write-fd *close-in-parent*) - (let ((stream (system:make-fd-stream read-fd :input t))) + (let ((stream (system:make-fd-stream read-fd :input t + :external-format + external-format))) (values write-fd stream))) (t (unix:unix-close read-fd)

1 0

[cmucl-cvs] CMUCL commit: src/code (unidata.lisp)
by Raymond Toy 20 Sep '10

20 Sep '10

Date: Sunday, September 19, 2010 @ 21:17:14 Author: rtoy Path: /project/cmucl/cvsroot/src/code Modified: unidata.lisp Was mishandling the case where there are no more completions. In this case we were returning the prefix string, but that would be incorrect if the prefix string is not a valid character. So check that it is valid and return it. Otherwise do nothing (thereby returning nil) so slime can note the character is invalid. --------------+ unidata.lisp | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) Index: src/code/unidata.lisp diff -u src/code/unidata.lisp:1.20 src/code/unidata.lisp:1.21 --- src/code/unidata.lisp:1.20 Sun Sep 19 20:59:22 2010 +++ src/code/unidata.lisp Sun Sep 19 21:17:14 2010 @@ -4,7 +4,7 @@ ;;; This code was written by Paul Foley and has been placed in the public ;;; domain. ;;; -(ext:file-comment "$Header: /project/cmucl/cvsroot/src/code/unidata.lisp,v 1.20 2010-09-20 00:59:22 rtoy Exp $") +(ext:file-comment "$Header: /project/cmucl/cvsroot/src/code/unidata.lisp,v 1.21 2010-09-20 01:17:14 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -18,7 +18,7 @@ (defconstant +unidata-path+ #p"ext-formats:unidata.bin") -(defvar *unidata-version* "$Revision: 1.20 $") +(defvar *unidata-version* "$Revision: 1.21 $") (defstruct unidata range @@ -1291,7 +1291,12 @@ (if suffixes (loop for n in suffixes do (push (concatenate 'string full-prefix n) names)) - (push full-prefix names)))))) + ;; No suffixes. So either the prefix is the + ;; only possible completion or it's not valid. + ;; Figure that out. If it's valid, add it to + ;; names. + (when (search-dictionary (string-upcase prefix-tail) dictionary) + (push prefix-match names))))))) ;; Match prefix for Hangul syllables or CJK unified ideographs. (cond ((char= (char prefix-match 0) #\H) ;; Add "Hangul_Syllable_" as possible completion for @@ -1312,7 +1317,8 @@ (unless *cjk-unified-ideograph-dictionary* (build-cjk-unified-ideograph-dictionary)) (han-or-cjk-completion prefix-match "Cjk_Unified_Ideograph-" - *cjk-unified-ideograph-dictionary*))))) + *cjk-unified-ideograph-dictionary*) + )))) (setf names (mapcar #'string-capitalize names)) ;;(format t "Final names = ~S~%" names) names)))

1 0

[cmucl-cvs] CMUCL commit: src/code (unidata.lisp)
by Raymond Toy 20 Sep '10

20 Sep '10

Date: Sunday, September 19, 2010 @ 20:59:22 Author: rtoy Path: /project/cmucl/cvsroot/src/code Modified: unidata.lisp Improve completion of Hangul syllables and CJK unified ideographs some more and fix some bugs in previous change. --------------+ unidata.lisp | 87 ++++++++++++++++++++++----------------------------------- 1 file changed, 35 insertions(+), 52 deletions(-) Index: src/code/unidata.lisp diff -u src/code/unidata.lisp:1.19 src/code/unidata.lisp:1.20 --- src/code/unidata.lisp:1.19 Sun Sep 19 19:07:46 2010 +++ src/code/unidata.lisp Sun Sep 19 20:59:22 2010 @@ -4,7 +4,7 @@ ;;; This code was written by Paul Foley and has been placed in the public ;;; domain. ;;; -(ext:file-comment "$Header: /project/cmucl/cvsroot/src/code/unidata.lisp,v 1.19 2010-09-19 23:07:46 rtoy Exp $") +(ext:file-comment "$Header: /project/cmucl/cvsroot/src/code/unidata.lisp,v 1.20 2010-09-20 00:59:22 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -18,7 +18,7 @@ (defconstant +unidata-path+ #p"ext-formats:unidata.bin") -(defvar *unidata-version* "$Revision: 1.19 $") +(defvar *unidata-version* "$Revision: 1.20 $") (defstruct unidata range @@ -1274,62 +1274,45 @@ completions starting with Prefix. If there is no match, NIL is returned." (let (names) - (cond ((search "Hangul_Syllable_" prefix) - (initialize-reverse-hangul-tables) - (unless *hangul-syllable-dictionary* - (build-hangul-syllable-dictionary)) - (multiple-value-bind (prefix-match next completep) - (unicode-complete-name (subseq prefix 16) - *hangul-syllable-dictionary*) - (loop for x in next - do (push (concatenate 'string "Hangul_Syllable_" prefix-match x) - names)) - (when completep - (push (concatenate 'string "Hangul_Syllable_" prefix-match) - names)))) - ((search "Cjk_Unified_Ideograph-" prefix) - (unless *cjk-unified-ideograph-dictionary* - (build-cjk-unified-ideograph-dictionary)) - (multiple-value-bind (prefix-match next completep) - (unicode-complete-name (subseq prefix 22) - *cjk-unified-ideograph-dictionary*) - (loop for x in next - do (push (concatenate 'string "Cjk_Unified_Ideograph-" prefix-match x) - names)) - (when completep - (push (concatenate 'string "Cjk_Unified_Ideograph-" prefix-match) - names))))) (multiple-value-bind (prefix-match next completep) (unicode-complete-name prefix dict) (loop for x in next do (push (concatenate 'string prefix-match x) names)) (when completep (push prefix-match names)) - ;; Match prefix against Hangul and/or Hangul_syllable - (cond ((search "Hangul_S" prefix-match - :end1 (min 8 (length prefix-match))) - ;; Add syllable as possible completion, and then try to - ;; complete some more so that we don't end up with slime - ;; saying "Hangul_Syllable_" is the only completion. - (multiple-value-bind (m suffixes) - (unicode-complete-name (subseq prefix-match (min 16 (length prefix-match))) - *hangul-syllable-dictionary*) - (declare (ignore m)) - (if suffixes - (loop for n in suffixes - do (push (concatenate 'string "Hangul_Syllable_" n) names)) - (push "Hangul_Syllable_" names)))) - ((or ;;(string= prefix-match "Cjk_") - (search "Cjk_Unified_Ideograph-" prefix-match - :end1 (min 22 (length prefix-match)))) - ;; Try to complete the first part so we don't get - ;; "Cjk_Unified_Ideograph-" as the only completion. - (multiple-value-bind (m suffixes) - (unicode-complete-name (subseq prefix-match (min 22 (length prefix-match))) - *cjk-unified-ideograph-dictionary*) - (declare (ignore m)) - (loop for n in suffixes - do (push (concatenate 'string "Cjk_Unified_Ideograph-" n) names))))) + (flet ((han-or-cjk-completion (prefix-match prefix dictionary) + (let* ((prefix-tail (subseq prefix-match + (min (length prefix) + (length prefix-match)))) + (full-prefix (concatenate 'string prefix prefix-tail))) + (multiple-value-bind (m suffixes) + (unicode-complete-name prefix-tail dictionary) + (declare (ignore m)) + (if suffixes + (loop for n in suffixes + do (push (concatenate 'string full-prefix n) names)) + (push full-prefix names)))))) + ;; Match prefix for Hangul syllables or CJK unified ideographs. + (cond ((char= (char prefix-match 0) #\H) + ;; Add "Hangul_Syllable_" as possible completion for + ;; anything beginning with "H". + (push "Hangul_Syllable_" names) + (when (<= (length names) 1) + ;; Hangul_Syllable is the only match, so let's extend it. + (unless *hangul-syllable-dictionary* + (initialize-reverse-hangul-tables) + (build-hangul-syllable-dictionary)) + (han-or-cjk-completion prefix-match "Hangul_Syllable_" + *hangul-syllable-dictionary*))) + ((char= (char prefix-match 0) #\C) + ;; Add "Cjk_Unified_Ideograph-" as possible completion + ;; for anything beginning with "C". + (push "Cjk_Unified_Ideograph-" names) + (when (<= (length names) 1) + (unless *cjk-unified-ideograph-dictionary* + (build-cjk-unified-ideograph-dictionary)) + (han-or-cjk-completion prefix-match "Cjk_Unified_Ideograph-" + *cjk-unified-ideograph-dictionary*))))) (setf names (mapcar #'string-capitalize names)) ;;(format t "Final names = ~S~%" names) names)))

1 0

[cmucl-cvs] CMUCL commit: src/code (unidata.lisp)
by Raymond Toy 19 Sep '10

19 Sep '10

Date: Sunday, September 19, 2010 @ 19:07:46 Author: rtoy Path: /project/cmucl/cvsroot/src/code Modified: unidata.lisp o Move %STR, %STRX and %MATCH around so that we can inline them (because they're so simple). o Add some comments for %STR. o Change implementation of %MATCH to be simpler and add comments on why we do what we do and explain what happens if we don't. o Handle completion of Hangul syllables better: - Match "Hangul_S" instead of "Hangul_Syllable" because there's #\Hangul_Single_Dot_Tone_Mark. - If we match "Hangul_S", try to complete some Hangul syllables so we don't fool slime into thinking "Hangul_Syllable_" is the only completion. There are obviously more. o Handle completion of CJK Unified Ideographs better by trying to complete more so slime isn't fooled into thinking "CJK_Unified_Ideograph-" is the only possible completion. --------------+ unidata.lisp | 91 +++++++++++++++++++++++++++++++++++++++------------------ 1 file changed, 63 insertions(+), 28 deletions(-) Index: src/code/unidata.lisp diff -u src/code/unidata.lisp:1.18 src/code/unidata.lisp:1.19 --- src/code/unidata.lisp:1.18 Sat Sep 18 22:37:10 2010 +++ src/code/unidata.lisp Sun Sep 19 19:07:46 2010 @@ -4,7 +4,7 @@ ;;; This code was written by Paul Foley and has been placed in the public ;;; domain. ;;; -(ext:file-comment "$Header: /project/cmucl/cvsroot/src/code/unidata.lisp,v 1.18 2010-09-19 02:37:10 rtoy Exp $") +(ext:file-comment "$Header: /project/cmucl/cvsroot/src/code/unidata.lisp,v 1.19 2010-09-19 23:07:46 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -18,7 +18,7 @@ (defconstant +unidata-path+ #p"ext-formats:unidata.bin") -(defvar *unidata-version* "$Revision: 1.18 $") +(defvar *unidata-version* "$Revision: 1.19 $") (defstruct unidata range @@ -1132,7 +1132,43 @@ (defvar *cjk-unified-ideograph-dictionary* nil "Dictionary of CJK Unified ideographs") -;; +;; Convert the string into the form we want for character names. +;; Basically the Unicode name has spaces replaced by underscores, and +;; the result is capitalized. +(declaim (inline %str %strx)) +(defun %str (x) + (nsubstitute #\_ #\Space (string-capitalize x))) + +(defun %strx (x) + (%str (car x))) + +(declaim (inline %match)) +#+(or) +(defun %match (part prefix posn) + (and (>= (length part) (- (length prefix) posn)) + (string= part prefix :start2 posn :end1 (- (length prefix) posn)))) + +#+(or) +(defun %match (part prefix posn) + (let ((s1 (search part prefix :start2 posn)) + (s2 (search prefix part :start1 posn))) + (or (and s1 (= s1 posn)) + (and s2 (zerop s2))))) + +;; Test if the string PART matches the string PREFIX starting from +;; position POSN. Basically test that the initial parts of the +;; strings match each other exactly. For if the prefix is "BO", then +;; both "B" and "BOX" should match. (This is needed to get the +;; completion of "cjk_radical_bo" to match "cjk_radical_box" as well +;; as "cjk_radical_bone" and others because at one point in the +;; algorithm the part is "B", which we do want to match "BO" so that +;; we can get the possible completions BONE" and "BOLT OF CLOTH". +(defun %match (part prefix posn) + (let ((len (min (length part) + (- (length prefix) posn)))) + (string= part prefix :end1 len :start2 posn :end2 (+ posn len)))) + + (defun unicode-complete-name (prefix &optional (dict (unidata-name+ *unicode-data*))) @@ -1270,36 +1306,35 @@ (when completep (push prefix-match names)) ;; Match prefix against Hangul and/or Hangul_syllable - (cond ((or (string= prefix-match "Hangul_") - (search "Hangul_Syllable_" prefix-match :end1 (min 16 (length prefix-match)))) - ;; Add syllable as possible completion - (push "Hangul_Syllable_" names)) + (cond ((search "Hangul_S" prefix-match + :end1 (min 8 (length prefix-match))) + ;; Add syllable as possible completion, and then try to + ;; complete some more so that we don't end up with slime + ;; saying "Hangul_Syllable_" is the only completion. + (multiple-value-bind (m suffixes) + (unicode-complete-name (subseq prefix-match (min 16 (length prefix-match))) + *hangul-syllable-dictionary*) + (declare (ignore m)) + (if suffixes + (loop for n in suffixes + do (push (concatenate 'string "Hangul_Syllable_" n) names)) + (push "Hangul_Syllable_" names)))) ((or ;;(string= prefix-match "Cjk_") - (search "Cjk_Unified_Ideograph-" prefix-match :end1 (min 22 (length prefix-match)))) - ;; Add Unified - (push "Cjk_Unified_Ideograph-" names))) + (search "Cjk_Unified_Ideograph-" prefix-match + :end1 (min 22 (length prefix-match)))) + ;; Try to complete the first part so we don't get + ;; "Cjk_Unified_Ideograph-" as the only completion. + (multiple-value-bind (m suffixes) + (unicode-complete-name (subseq prefix-match (min 22 (length prefix-match))) + *cjk-unified-ideograph-dictionary*) + (declare (ignore m)) + (loop for n in suffixes + do (push (concatenate 'string "Cjk_Unified_Ideograph-" n) names))))) (setf names (mapcar #'string-capitalize names)) ;;(format t "Final names = ~S~%" names) names))) -;; Convert the string into the form we want for character names. -(defun %str (x) - (nsubstitute #\_ #\Space (string-capitalize x))) - -(defun %strx (x) - (%str (car x))) - -#+(or) -(defun %match (part prefix posn) - (and (>= (length part) (- (length prefix) posn)) - (string= part prefix :start2 posn :end1 (- (length prefix) posn)))) - -(defun %match (part prefix posn) - (let ((s1 (search part prefix :start2 posn)) - (s2 (search prefix part :start1 posn))) - (or (and s1 (= s1 posn)) - (and s2 (zerop s2))))) - +;; Find the longest initial substring of the STRINGS. (defun %mip (strings) (let* ((first (first strings)) (posn (length first)))

1 0

[cmucl-cvs] CMUCL commit: src/general-info (release-20b.txt)
by Raymond Toy 19 Sep '10

19 Sep '10

Date: Sunday, September 19, 2010 @ 00:10:52 Author: rtoy Path: /project/cmucl/cvsroot/src/general-info Modified: release-20b.txt Merge from 20b-branch for bug fix for Unicode 1.0 names. -----------------+ release-20b.txt | 3 +++ 1 file changed, 3 insertions(+) Index: src/general-info/release-20b.txt diff -u src/general-info/release-20b.txt:1.48 src/general-info/release-20b.txt:1.49 --- src/general-info/release-20b.txt:1.48 Wed Sep 8 20:22:03 2010 +++ src/general-info/release-20b.txt Sun Sep 19 00:10:52 2010 @@ -205,6 +205,9 @@ - For SSE2 builds, SIGCONTEXT-FLOAT-REGISTER returned the wrong value for single-floats. Easily noticead when tracing a function with single-float arguments. + - The table for Unicode 1.0 names was constructed incorrectly. + Thus, UNICODE-1.0-NAME would return the wrong names for many + (all?) codepoints. * Trac Tickets: #33: get-dispatch-macro-character doesn't signal errors in

1 0

[cmucl-cvs] CMUCL commit: src/i18n (unidata.bin)
by Raymond Toy 19 Sep '10

19 Sep '10

Date: Sunday, September 19, 2010 @ 00:10:16 Author: rtoy Path: /project/cmucl/cvsroot/src/i18n Modified: unidata.bin Regenerated with correct table for Unicode 1.0 names. -------------+ unidata.bin | <<Binary file>> 1 file changed, 1 insertion(+) Index: src/i18n/unidata.bin <<Binary file>>

1 0

[cmucl-cvs] CMUCL commit: RELEASE-20B-BRANCH src (general-info/release-20b.txt i18n/unidata.bin)
by Raymond Toy 19 Sep '10

19 Sep '10

Date: Saturday, September 18, 2010 @ 23:46:03 Author: rtoy Path: /project/cmucl/cvsroot/src Tag: RELEASE-20B-BRANCH Modified: general-info/release-20b.txt i18n/unidata.bin release-20b.txt: o Note bug fix for Unicode 1.0 names unidata.bin: o Regenerated with correct table for Unicode 1.0 names. ------------------------------+ general-info/release-20b.txt | 3 +++ i18n/unidata.bin | <<Binary file>> 2 files changed, 4 insertions(+) Index: src/general-info/release-20b.txt diff -u src/general-info/release-20b.txt:1.41.2.6 src/general-info/release-20b.txt:1.41.2.7 --- src/general-info/release-20b.txt:1.41.2.6 Wed Sep 8 20:23:56 2010 +++ src/general-info/release-20b.txt Sat Sep 18 23:46:02 2010 @@ -200,6 +200,9 @@ - For SSE2 builds, SIGCONTEXT-FLOAT-REGISTER returned the wrong value for single-floats. Easily noticead when tracing a function with single-float arguments. + - The table for Unicode 1.0 names was constructed incorrectly. + Thus, UNICODE-1.0-NAME would return the wrong names for many + (all?) codepoints. * Trac Tickets: #33: get-dispatch-macro-character doesn't signal errors in Index: src/i18n/unidata.bin <<Binary file>>

1 0