;;; mule.el --- basic commands for mulitilingual environment
-;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006
+;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation, Inc.
-;; Copyright (C) 1995, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;; 2005, 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
;; GNU Emacs 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)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
(defun load-with-code-conversion (fullname file &optional noerror nomessage)
"Execute a file of Lisp code named FILE whose absolute name is FULLNAME.
The file contents are decoded before evaluation if necessary.
-If optional second arg NOERROR is non-nil,
+If optional third arg NOERROR is non-nil,
report no error if FILE doesn't exist.
Print messages at start and end of loading unless
- optional third arg NOMESSAGE is non-nil.
+ optional fourth arg NOMESSAGE is non-nil.
Return t if file exists."
(if (null (file-readable-p fullname))
(and (null noerror)
(let ((load-file-name fullname)
(set-auto-coding-for-load t)
(inhibit-file-name-operation nil))
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
;; Don't let deactivate-mark remain set.
(let (deactivate-mark)
(insert-file-contents fullname))
(kill-buffer buffer)))
(unless purify-flag
(do-after-load-evaluation fullname))
-
+
(unless (or nomessage noninteractive)
(if source
(message "Loading %s (source)...done" file)
(< (aref vector 0) 160)))))
(defsubst charsetp (object)
- "T if OBJECT is a charset."
+ "Return t if OBJECT is a charset."
(and (symbolp object) (vectorp (get object 'charset))))
(defsubst charset-info (charset)
CODE1 and CODE2 are optional, but if you don't supply
sufficient position codes, return a generic character which stands for
all characters or group of characters in the character set.
-A generic character can be used to index a char table (e.g. syntax-table).
+A generic character can be used to index a char table (e.g. `syntax-table').
Such character sets as ascii, eight-bit-control, and eight-bit-graphic
don't have corresponding generic characters. If CHARSET is one of
char))))))))
\f
+;; Save the ASCII case table in case we need it later. Some locales
+;; (such as Turkish) modify the case behavior of ASCII characters,
+;; which can interfere with networking code that uses ASCII strings.
+
+(defvar ascii-case-table
+ ;; Code copied from copy-case-table to avoid requiring case-table.el
+ (let ((tbl (copy-sequence (standard-case-table)))
+ (up (char-table-extra-slot (standard-case-table) 0)))
+ (if up (set-char-table-extra-slot tbl 0 (copy-sequence up)))
+ (set-char-table-extra-slot tbl 1 nil)
+ (set-char-table-extra-slot tbl 2 nil)
+ tbl)
+ "Case table for the ASCII character set.")
+\f
;; Coding system stuff
;; Coding system is a symbol that has the property `coding-system'.
;;; FILE I/O
(defcustom auto-coding-alist
- '(("\\.\\(arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\)\\'" . no-conversion)
- ("\\.\\(ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\)\\'" . no-conversion)
+ ;; .exe and .EXE are added to support archive-mode looking at DOS
+ ;; self-extracting exe archives.
+ '(("\\.\\(arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\|exe\\)\\'" . no-conversion)
+ ("\\.\\(ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|EXE\\)\\'" . no-conversion)
("\\.\\(sx[dmicw]\\|odt\\|tar\\|tgz\\)\\'" . no-conversion)
("\\.\\(gz\\|Z\\|bz\\|bz2\\|gpg\\)\\'" . no-conversion)
("\\.\\(jpe?g\\|png\\|gif\\|tiff?\\|p[bpgn]m\\)\\'" . no-conversion)
+ ("\\.pdf\\'" . no-conversion)
("/#[^/]+#\\'" . emacs-mule))
"Alist of filename patterns vs corresponding coding systems.
Each element looks like (REGEXP . CODING-SYSTEM).
system and SOURCE is a symbol `auto-coding-alist',
`auto-coding-regexp-alist', `coding:', or `auto-coding-functions'
indicating by what CODING is specified. Note that the validity
-of CODING is not checked; it's callers responsibility to check
-it.
+of CODING is not checked; it's the caller's responsibility to check it.
If nothing is specified, the return value is nil."
(or (let ((coding-system (auto-coding-alist-lookup filename)))
;; and for "unibyte:" at the head and tail of SIZE bytes.
(setq head-found (or (search-forward "coding:" head-end t)
(search-forward "unibyte:" head-end t)
- (search-forward "enable-character-translation:"
+ (search-forward "enable-character-translation:"
head-end t)))
(if (and head-found (> head-found tail-start))
;; Head and tail are overlapped.
;; is just "\r" and we can't use "^" nor "$" in regexp.
(when (and tail-found (or (not coding-system) (not char-trans)))
(goto-char tail-start)
- (re-search-forward "[\r\n]\^L" nil t)
+ (re-search-forward "[\r\n]\^L" tail-end t)
(if (re-search-forward
"[\r\n]\\([^[\r\n]*\\)[ \t]*Local Variables:[ \t]*\\([^\r\n]*\\)[\r\n]"
tail-end t)
(set-buffer-multibyte nil))
(set-buffer-multibyte nil))
(setq inserted (- pos-marker (point)))))
- (set-buffer-modified-p modified-p))))
+ (restore-buffer-modified-p modified-p))))
inserted)
;; The coding-spec and eol-type of coding-system returned is decided
(progn
(set-category-table ,table)
,@body)
- (save-current-buffer
- (set-buffer ,old-buffer)
+ (with-current-buffer ,old-buffer
(set-category-table ,old-table))))))
(defun define-translation-hash-table (symbol table)
(defun sgml-html-meta-auto-coding-function (size)
"If the buffer has an HTML meta tag, use it to determine encoding.
This function is intended to be added to `auto-coding-functions'."
- (setq size (min (+ (point) size)
- (save-excursion
- ;; Limit the search by the end of the HTML header.
- (or (search-forward "</head>" size t)
- ;; In case of no header, search only 10 lines.
- (forward-line 10))
- (point))))
- (when (re-search-forward "<meta\\s-+http-equiv=[\"']?content-type[\"']?\\s-+content=[\"']text/\\sw+;\\s-*charset=\\(.+?\\)[\"']" size t)
- (let* ((match (match-string 1))
- (sym (intern (downcase match))))
- (if (coding-system-p sym)
- sym
- (message "Warning: unknown coding system \"%s\"" match)
- nil))))
+ (let ((case-fold-search t))
+ (setq size (min (+ (point) size)
+ (save-excursion
+ ;; Limit the search by the end of the HTML header.
+ (or (search-forward "</head>" size t)
+ ;; In case of no header, search only 10 lines.
+ (forward-line 10))
+ (point))))
+ ;; Make sure that the buffer really contains an HTML document, by
+ ;; checking that it starts with a doctype or a <HTML> start tag
+ ;; (allowing for whitespace at bob). Note: 'DOCTYPE NETSCAPE' is
+ ;; useful for Mozilla bookmark files.
+ (when (and (re-search-forward "\\`[[:space:]\n]*\\(<!doctype[[:space:]\n]+\\(html\\|netscape\\)\\|<html\\)" size t)
+ (re-search-forward "<meta\\s-+http-equiv=[\"']?content-type[\"']?\\s-+content=[\"']text/\\sw+;\\s-*charset=\\(.+?\\)[\"']" size t))
+ (let* ((match (match-string 1))
+ (sym (intern (downcase match))))
+ (if (coding-system-p sym)
+ sym
+ (message "Warning: unknown coding system \"%s\"" match)
+ nil)))))
;;;
(provide 'mule)
HCoop / bpt / emacs.git / blobdiff