xemacs-beta: lisp/coding.el comparison

comparison lisp/coding.el @ 771:943eaba38521

[xemacs-hg @ 2002-03-13 08:51:24 by ben] The big ben-mule-21-5 check-in! Various files were added and deleted. See CHANGES-ben-mule. There are still some test suite failures. No crashes, though. Many of the failures have to do with problems in the test suite itself rather than in the actual code. I'll be addressing these in the next day or so -- none of the test suite failures are at all critical. Meanwhile I'll be trying to address the biggest issues -- i.e. build or run failures, which will almost certainly happen on various platforms. All comments should be sent to ben@xemacs.org -- use a Cc: if necessary when sending to mailing lists. There will be pre- and post- tags, something like pre-ben-mule-21-5-merge-in, and post-ben-mule-21-5-merge-in.

author	ben
date	Wed, 13 Mar 2002 08:54:06 +0000
parents	4d00488244c1
children	7f62a956b825

comparison

equal deleted inserted replaced

-:336a418893b5
+:943eaba38521
 ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
 ;; Licensed to the Free Software Foundation.
 ;; Copyright (C) 1995 Amdahl Corporation.
 ;; Copyright (C) 1995 Sun Microsystems.
 ;; Copyright (C) 1997 MORIOKA Tomohiko
+;; Copyright (C) 2000, 2001, 2002 Ben Wing.
 ;; This file is part of XEmacs.
-;; This file is very similar to mule-coding.el
 ;; 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.
 (globally-declare-fboundp
 '(coding-system-lock-shift
 coding-system-seven coding-system-charset charset-dimension))
 (defalias 'check-coding-system 'get-coding-system)
-(defconst modeline-multibyte-status '("%C")
-"Modeline control for showing multibyte extension status.")
-;; override the default value defined in loaddefs.el.
-(setq-default modeline-format
-	      (cons ""
-		    (cons 'modeline-multibyte-status
-			  (cdr modeline-format))))
 (defun modify-coding-system-alist (target-type regexp coding-system)
 "Modify one of look up tables for finding a coding system on I/O operation.
 There are three of such tables, `file-coding-system-alist',
 `process-coding-system-alist', and `network-coding-system-alist'.
 (if (eq (device-type) 'tty)
 (declare-fboundp (set-console-tty-output-coding-system
 			(device-console) terminal-coding-system)))
 (redraw-modeline t))
-(defun set-pathname-coding-system (coding-system)
-"Set the coding system used for file system path names."
-(interactive "zPathname-coding-system: ")
-(get-coding-system coding-system) ; correctness check
-(setq file-name-coding-system coding-system))
 (defun what-coding-system (start end &optional arg)
 "Show the encoding of text in the region.
 This function is meant to be called interactively;
 from a Lisp program, use `detect-coding-region' instead."
 (interactive "r\nP")
 (defun coding-system-mnemonic (coding-system)
 "Return the 'mnemonic property of CODING-SYSTEM."
 (coding-system-property coding-system 'mnemonic))
-(defalias 'coding-system-docstring 'coding-system-doc-string)
+(defun coding-system-documentation (coding-system)
+"Return the 'documentation property of CODING-SYSTEM."
+(coding-system-property coding-system 'documentation))
+(define-obsolete-function-alias 'coding-system-doc-string
+'coding-system-description)
 (defun coding-system-eol-type (coding-system)
 "Return the 'eol-type property of CODING-SYSTEM."
 (coding-system-property coding-system 'eol-type))
 (coding-system-property coding-system 'post-read-conversion))
 (defun coding-system-pre-write-conversion (coding-system)
 "Return the 'pre-write-conversion property of CODING-SYSTEM."
 (coding-system-property coding-system 'pre-write-conversion))
-(defun coding-system-base (coding-system)
-"Return the base coding system of CODING-SYSTEM."
-(if (not (coding-system-eol-type coding-system))
-coding-system
-(find-coding-system
-(intern
-(substring
-(symbol-name (coding-system-name coding-system))
-0
-(string-match "-unix$\\|-dos$\\|-mac$"
-		     (symbol-name (coding-system-name coding-system))))))))
 ;;; #### bleagh!!!!!!!
 (defun coding-system-get (coding-system prop)
 "Extract a value from CODING-SYSTEM's property list for property PROP."
 		  prop value)))
 (defun coding-system-category (coding-system)
 "Return the coding category of CODING-SYSTEM."
 (or (coding-system-get coding-system 'category)
-(let ((type (coding-system-type coding-system)))
+(case (coding-system-type coding-system)
-	(cond ((eq type 'no-conversion)
+	(no-conversion 'no-conversion)
-	       'no-conversion)
+	(shift-jis 'shift-jis)
-	      ((eq type 'shift-jis)
+	(unicode (case (coding-system-property coding-system 'type)
-	       'shift-jis)
+		   (utf-8 'utf-8)
-	      ((eq type 'ucs-4)
+		   (ucs-4 'ucs-4)
-	       'ucs-4)
+		   (utf-16 (let ((bom (coding-system-property coding-system
-	      ((eq type 'utf-8)
+							      'need-bom))
-	       'utf-8)
+				 (le (coding-system-property coding-system
-	      ((eq type 'big5)
+							     'little-endian)))
-	       'big5)
+			     (cond ((and bom le) 'utf-16-little-endian-bom)
-	      ((eq type 'iso2022)
+				   ((and bom (not le) 'utf-16-bom))
-	       (cond ((coding-system-lock-shift coding-system)
+				   ((and (not bom) le) 'utf-16-little-endian)
-		      'iso-lock-shift)
+				   ((and (not bom) (not le) 'utf-16)))))))
-		     ((coding-system-seven coding-system)
+	(big5 'big5)
-		      'iso-7)
+	(iso2022 (cond ((coding-system-lock-shift coding-system)
-		     (t
+			'iso-lock-shift)
-		      (let ((dim 0)
+		       ((coding-system-seven coding-system)
-			    ccs
+			'iso-7)
-			    (i 0))
+		       (t
-			(while (< i 4)
+			(let ((dim 0)
-			  (setq ccs (coding-system-charset coding-system i))
+			      ccs
-			  (if (and ccs
+			      (i 0))
-				   (> (charset-dimension ccs) dim))
+			  (while (< i 4)
-			      (setq dim (charset-dimension ccs))
+			    (setq ccs (declare-fboundp
-			    )
+				       (coding-system-iso2022-charset
-			  (setq i (1+ i)))
+					coding-system i)))
-			(cond ((= dim 1) 'iso-8-1)
+			    (if (and ccs
-			      ((= dim 2) 'iso-8-2)
+				     (> (charset-dimension ccs) dim))
-			      (t 'iso-8-designate))
+				(setq dim (charset-dimension ccs))
-			))))))))
+			      )
+			    (setq i (1+ i)))
+			  (cond ((= dim 1) 'iso-8-1)
+				((= dim 2) 'iso-8-2)
+				(t 'iso-8-designate))))))
+	)))
-;;;; Definitions of predefined coding systems
-(make-coding-system
-'undecided 'undecided
-"Automatic conversion."
-'(mnemonic "Auto"))
 ;;; Make certain variables equivalent to coding-system aliases
 (defun dontusethis-set-value-file-name-coding-system-handler (sym args fun harg handlers)
 (define-coding-system-alias 'file-name (or (car args) 'binary)))
 (dontusethis-set-symbol-value-handler
 (dontusethis-set-symbol-value-handler
 'keyboard-coding-system
 'set-value
 'dontusethis-set-value-keyboard-coding-system-handler)
-(unless (boundp 'file-name-coding-system)
-(setq file-name-coding-system nil))
 (when (not (featurep 'mule))
+(define-coding-system-alias 'escape-quoted 'binary)
 ;; these are so that gnus and friends work when not mule
-(copy-coding-system 'undecided 'iso-8859-1)
+(define-coding-system-alias 'iso-8859-1 'undecided)
-(copy-coding-system 'undecided 'iso-8859-2)
+(define-coding-system-alias 'iso-8859-2 'undecided)
 (define-coding-system-alias 'ctext 'binary))
 ;; compatibility for old XEmacsen (don't use it)
-(copy-coding-system 'undecided 'automatic-conversion)
+(define-coding-system-alias 'automatic-conversion 'undecided)
 (make-compatible-variable 'enable-multibyte-characters "Unimplemented")
-(define-obsolete-variable-alias
-'pathname-coding-system 'file-name-coding-system)
 ;;; coding.el ends here

Mercurial > hg > xemacs-beta

comparison lisp/coding.el @ 771:943eaba38521