Mercurial > hg > xemacs-beta
view lisp/mule/china-util.el @ 5327:d1b17a33450b
Move the heavy lifting from cl-seq.el to C.
src/ChangeLog addition:
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
Move the heavy lifting from cl-seq.el to C, finally making those
functions first-class XEmacs citizens, with circularity checking,
built-in support for tests other than #'eql, and as much
compatibility with current Common Lisp as Paul Dietz' tests require.
* fns.c (check_eq_nokey, check_eq_key, check_eql_nokey)
(check_eql_key, check_equal_nokey, check_equal_key)
(check_equalp_nokey, check_equalp_key, check_string_match_nokey)
(check_string_match_key, check_other_nokey, check_other_key)
(check_if_nokey, check_if_key, check_match_eq_key)
(check_match_eql_key, check_match_equal_key)
(check_match_equalp_key, check_match_other_key): New. These are
basically to provide function pointers to be used by Lisp
functions that take TEST, TEST-NOT and KEY arguments.
(get_check_match_function_1, get_check_test_function)
(get_check_match_function): These functions work out which of the
previous list of functions to use, given the keywords supplied by
the user.
(count_with_tail): New. This is the bones of #'count.
(list_count_from_end, string_count_from_end): Utility functions
for #'count.
(Fcount): New, moved from cl-seq.el.
(list_position_cons_before): New. The implementation of #'member*,
and important in implementing various other functions.
(FmemberX, Fadjoin, FassocX, FrassocX, Fposition, Ffind)
(FdeleteX, FremoveX, Fdelete_duplicates, Fremove_duplicates)
(Fnsubstitute, Fsubstitute, Fsublis, Fnsublis, Fsubst, Fnsubst)
(Ftree_equal, Fmismatch, Fsearch, Fintersection, Fnintersection)
(Fsubsetp, Fset_difference, Fnset_difference, Fnunion, Funion)
(Fset_exclusive_or, Fnset_exclusive_or): New, moved here from
cl-seq.el.
(position): New. The implementation of #'find and #'position.
(list_delete_duplicates_from_end, subst, sublis, nsublis)
(tree_equal, mismatch_from_end, mismatch_list_list)
(mismatch_list_string, mismatch_list_array)
(mismatch_string_array, mismatch_string_string)
(mismatch_array_array, get_mismatch_func): Helper C functions for
the Lisp-visible functions.
(venn, nvenn): New. The implementation of the main Lisp functions that
treat lists as sets.
lisp/ChangeLog addition:
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* cl-seq.el:
Move the heavy lifting from this file to C. Dump the
cl-parsing-keywords macro, but don't use defun* for the functions
we define that do take keywords, dynamic scope lossage makes that
not practical.
* subr.el (sort, fillarray): Move these aliases here.
(map-plist): #'nsublis is now built-in, but at this point #'eql
isn't necessarily available as a test; use #'eq.
* obsolete.el (cl-delete-duplicates): Make this available for old
compiler macros and old code.
(memql): Document that this is equivalent to #'member*, and worse.
* cl.el (adjoin, subst): Removed. These are in C.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Thu, 30 Dec 2010 01:59:52 +0000 |
parents | 2923009caf47 |
children | 308d34e9f07d |
line wrap: on
line source
;;; china-util.el --- utilities for Chinese -*- coding: iso-2022-7bit; -*- ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. ;; Licensed to the Free Software Foundation. ;; Keywords: mule, multilingual, Chinese ;; This file is part of XEmacs. ;; XEmacs is free software; you can redistribute it and/or modify it ;; under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; XEmacs is distributed in the hope that it will be useful, but ;; WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;; General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with XEmacs; see the file COPYING. If not, write to the Free ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA ;; 02111-1307, USA. ;;; Synched up with: Emacs 21.1 (language/china-util.el). ;;; Commentary: ;;; Code: ;; Hz/ZW encoding stuffs ;; HZ is an encoding method for Chinese character set GB2312 used ;; widely in Internet. It is very similar to 7-bit environment of ;; ISO-2022. The difference is that HZ uses the sequence "~{" and ;; "~}" for designating GB2312 and ASCII respectively, hence, it ;; doesn't uses ESC (0x1B) code. ;; ZW is another encoding method for Chinese character set GB2312. It ;; encodes Chinese characters line by line by starting each line with ;; the sequence "zW". It also uses only 7-bit as HZ. ;; ISO-2022 escape sequence to designate GB2312. (defvar iso2022-gb-designation "\e$A") ;; HZ escape sequence to designate GB2312. (defvar hz-gb-designnation "~{") ;; ISO-2022 escape sequence to designate ASCII. (defvar iso2022-ascii-designation "\e(B") ;; HZ escape sequence to designate ASCII. (defvar hz-ascii-designnation "~}") ;; Regexp of ZW sequence to start GB2312. (defvar zw-start-gb "^zW") ;; Regexp for start of GB2312 in an encoding mixture of HZ and ZW. (defvar hz/zw-start-gb (concat hz-gb-designnation "\\|" zw-start-gb "\\|[^\0-\177]")) (defvar decode-hz-line-continuation nil "Flag to tell if we should care line continuation convention of Hz.") (defconst hz-set-msb-table (let ((str (make-string 127 0)) (i 0)) (while (< i 33) (aset str i i) (setq i (1+ i))) (while (< i 127) (aset str i (+ i 128)) (setq i (1+ i))) str)) ;;;###autoload (defun decode-hz-region (beg end) "Decode HZ/ZW encoded text in the current region. Return the length of resulting text." (interactive "r") (save-excursion (save-restriction (let (pos ch) (narrow-to-region beg end) ;; We, at first, convert HZ/ZW to `euc-china', ;; then decode it. ;; "~\n" -> "\n", "~~" -> "~" (goto-char (point-min)) (while (search-forward "~" nil t) (setq ch (following-char)) (if (or (= ch ?\n) (= ch ?~)) (delete-char -1))) ;; "^zW...\n" -> Chinese GB2312 ;; "~{...~}" -> Chinese GB2312 (goto-char (point-min)) (setq beg nil) (while (re-search-forward hz/zw-start-gb nil t) (setq pos (match-beginning 0) ch (char-after pos)) ;; Record the first position to start conversion. (or beg (setq beg pos)) (end-of-line) (setq end (point)) (if (>= ch 128) ; 8bit GB2312 nil (goto-char pos) (delete-char 2) (setq end (- end 2)) (if (= ch ?z) ; ZW -> euc-china (progn (translate-region (point) end hz-set-msb-table) (goto-char end)) (if (search-forward hz-ascii-designnation (if decode-hz-line-continuation nil end) t) (delete-char -2)) (setq end (point)) (translate-region pos (point) hz-set-msb-table)))) (if beg (decode-coding-region beg end 'euc-china))) (- (point-max) (point-min))))) ;;;###autoload (defun decode-hz-buffer () "Decode HZ/ZW encoded text in the current buffer." (interactive) (decode-hz-region (point-min) (point-max))) ;;;###autoload (defun encode-hz-region (beg end) "Encode the text in the current region to HZ. Return the length of resulting text." (interactive "r") (save-excursion (save-restriction (narrow-to-region beg end) ;; "~" -> "~~" (goto-char (point-min)) (while (search-forward "~" nil t) (insert ?~)) ;; Chinese GB2312 -> "~{...~}" (goto-char (point-min)) (if (re-search-forward "\\cc" nil t) (let (pos) (goto-char (setq pos (match-beginning 0))) (encode-coding-region pos (point-max) 'iso-2022-7bit) (goto-char pos) (while (search-forward iso2022-gb-designation nil t) (delete-char -3) (insert hz-gb-designnation)) (goto-char pos) (while (search-forward iso2022-ascii-designation nil t) (delete-char -3) (insert hz-ascii-designnation)))) (- (point-max) (point-min))))) ;;;###autoload (defun encode-hz-buffer () "Encode the text in the current buffer to HZ." (interactive) (encode-hz-region (point-min) (point-max))) ;; (provide 'china-util) ;;; china-util.el ends here