;;; mule.el --- basic commands for mulitilingual environment
-;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
-;; Licensed to the Free Software Foundation.
-;; Copyright (C) 2001, 2002 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
+;; Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H14PRO021
;; Keywords: mule, multilingual, character set, coding system
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; Make `kill-buffer' quiet.
(set-buffer-modified-p nil))
;; Have the original buffer current while we eval.
- (eval-buffer buffer nil file
+ (eval-buffer buffer nil
+ ;; This is compatible with what `load' does.
+ (if purify-flag file fullname)
;; If this Emacs is running with --unibyte,
;; convert multibyte strings to unibyte
;; after reading them.
Any alias nor subsidiary coding systems are not base coding system."
(car (coding-system-get coding-system 'alias-coding-systems)))
-(defalias 'coding-system-parent 'coding-system-base)
-(make-obsolete 'coding-system-parent 'coding-system-base "20.3")
-
;; Coding system also has a property `eol-type'.
;;
;; This property indicates how the coding system handles end-of-line
(and (not (> (downcase c1) (downcase c2)))
(< c1 c2)))))))
+(defun coding-system-equal (coding-system-1 coding-system-2)
+ "Return t if and only if CODING-SYSTEM-1 and CODING-SYSTEM-2 are identical.
+Two coding systems are identical if two symbols are equal
+or one is an alias of the other."
+ (or (eq coding-system-1 coding-system-2)
+ (and (equal (coding-system-spec coding-system-1)
+ (coding-system-spec coding-system-2))
+ (let ((eol-type-1 (coding-system-eol-type coding-system-1))
+ (eol-type-2 (coding-system-eol-type coding-system-2)))
+ (or (eq eol-type-1 eol-type-2)
+ (and (vectorp eol-type-1) (vectorp eol-type-2)))))))
+
(defun add-to-coding-system-list (coding-system)
"Add CODING-SYSTEM to `coding-system-list' while keeping it sorted."
(if (or (null coding-system-list)
If the value is non-nil, the coding system preserves composition
information.
+ o ascii-incompatible
+
+ If the value is non-nil, the coding system is not compatible
+ with ASCII, which means it encodes or decodes ASCII character
+ string to the different byte sequence.
+
These properties are set in PLIST, a property list. This function
also sets properties `coding-category' and `alias-coding-systems'
automatically.
(setq coding-category (plist-get plist 'coding-category))
(aset coding-spec coding-spec-plist-idx plist))
(put coding-system 'coding-system coding-spec)
+ (put coding-system 'coding-system-define-form nil)
(put coding-category 'coding-systems
(cons coding-system (get coding-category 'coding-systems))))
(defun define-coding-system-alias (alias coding-system)
"Define ALIAS as an alias for coding system CODING-SYSTEM."
(put alias 'coding-system (coding-system-spec coding-system))
+ (put alias 'coding-system-define-form nil)
(add-to-coding-system-list alias)
(setq coding-system-alist (cons (list (symbol-name alias))
coding-system-alist))
(setq coding-system-alist (cons (list (symbol-name symbol))
coding-system-alist)))
-(defun set-buffer-file-coding-system (coding-system &optional force)
+(defun set-buffer-file-coding-system (coding-system &optional force nomodify)
"Set the file coding-system of the current buffer to CODING-SYSTEM.
This means that when you save the buffer, it will be converted
according to CODING-SYSTEM. For a list of possible values of CODING-SYSTEM,
This marks the buffer modified so that the succeeding \\[save-buffer]
surely saves the buffer with CODING-SYSTEM. From a program, if you
-don't want to mark the buffer modified, just set the variable
-`buffer-file-coding-system' directly."
- (interactive "zCoding system for saving file (default, nil): \nP")
+don't want to mark the buffer modified, specify t for NOMODIFY.
+If you know exactly what coding system you want to use,
+just set the variable `buffer-file-coding-system' directly."
+ (interactive "zCoding system for saving file (default nil): \nP")
(check-coding-system coding-system)
(if (and coding-system buffer-file-coding-system (null force))
(setq coding-system
;; `set-buffer-major-mode-hook' take care of setting the table.
(if (fboundp 'ucs-set-table-for-input) ; don't lose when building
(ucs-set-table-for-input))
- (set-buffer-modified-p t)
+ (unless nomodify
+ (set-buffer-modified-p t))
(force-mode-line-update))
(defun revert-buffer-with-coding-system (coding-system &optional force)
buffer's previous `buffer-file-coding-system' value (if it is
specified there). Otherwise, determine it from the file contents as
usual for visiting a file."
- (interactive "zCoding system for visited file (default, nil): \nP")
+ (interactive "zCoding system for visited file (default nil): \nP")
(check-coding-system coding-system)
(if (and coding-system buffer-file-coding-system (null force))
(setq coding-system
"Set coding system for decoding and encoding file names to CODING-SYSTEM.
It actually just set the variable `file-name-coding-system' (which
see) to CODING-SYSTEM."
- (interactive "zCoding system for file names (default, nil): ")
+ (interactive "zCoding system for file names (default nil): ")
(check-coding-system coding-system)
+ (if (and coding-system
+ (coding-system-get coding-system 'ascii-incompatible))
+ (error "%s is not ASCII-compatible" coding-system))
(setq file-name-coding-system coding-system))
(defvar default-terminal-coding-system nil
This is normally set according to the selected language environment.
See also the command `set-terminal-coding-system'.")
-(defun set-terminal-coding-system (coding-system)
- "Set coding system of your terminal to CODING-SYSTEM.
-All text output to the terminal will be encoded
+(defun set-terminal-coding-system (coding-system &optional display)
+ "Set coding system of terminal output to CODING-SYSTEM.
+All text output to DISPLAY will be encoded
with the specified coding system.
+
For a list of possible values of CODING-SYSTEM, use \\[list-coding-systems].
The default is determined by the selected language environment
-or by the previous use of this command."
+or by the previous use of this command.
+
+DISPLAY may be a display id, a frame, or nil for the selected frame's display.
+The setting has no effect on graphical displays."
(interactive
(list (let ((default (if (and (not (terminal-coding-system))
default-terminal-coding-system)
default-terminal-coding-system)))
(read-coding-system
- (format "Coding system for terminal display (default, %s): "
+ (format "Coding system for terminal display (default %s): "
default)
default))))
(if (and (not coding-system)
(setq coding-system default-terminal-coding-system))
(if coding-system
(setq default-terminal-coding-system coding-system))
- (set-terminal-coding-system-internal coding-system)
+ (set-terminal-coding-system-internal coding-system display)
(redraw-frame (selected-frame)))
(defvar default-keyboard-coding-system nil
This is normally set according to the selected language environment.
See also the command `set-keyboard-coding-system'.")
-(defun set-keyboard-coding-system (coding-system)
- "Set coding system for keyboard input to CODING-SYSTEM.
-In addition, this command enables Encoded-kbd minor mode.
-\(If CODING-SYSTEM is nil, Encoded-kbd mode is turned off -- see
-`encoded-kbd-mode'.)
+(defun set-keyboard-coding-system (coding-system &optional display)
+ "Set coding system for keyboard input on DISPLAY to CODING-SYSTEM.
+In addition, this command calls `encoded-kbd-setup-display' to set up the
+translation of keyboard input events to the specified coding system.
+
For a list of possible values of CODING-SYSTEM, use \\[list-coding-systems].
The default is determined by the selected language environment
-or by the previous use of this command."
+or by the previous use of this command.
+
+DISPLAY may be a display id, a frame, or nil for the selected frame's display.
+The setting has no effect on graphical displays."
(interactive
(list (let ((default (if (and (not (keyboard-coding-system))
default-keyboard-coding-system)
default-keyboard-coding-system)))
(read-coding-system
- (format "Coding system for keyboard input (default, %s): "
+ (format "Coding system for keyboard input (default %s): "
default)
default))))
(if (and (not coding-system)
(setq coding-system default-keyboard-coding-system))
(if coding-system
(setq default-keyboard-coding-system coding-system))
- (set-keyboard-coding-system-internal coding-system)
+ (if (and coding-system
+ (coding-system-get coding-system 'ascii-incompatible))
+ (error "%s is not ASCII-compatible" coding-system))
+ (set-keyboard-coding-system-internal coding-system display)
(setq keyboard-coding-system coding-system)
- (encoded-kbd-mode (if coding-system 1 0)))
+ (encoded-kbd-setup-display display))
(defcustom keyboard-coding-system nil
"Specify coding system for keyboard input.
:link '(info-link "(emacs)Specify Coding")
:link '(info-link "(emacs)Single-Byte Character Support")
:set (lambda (symbol value)
- ;; Don't load encoded-kbd-mode unnecessarily.
- (if (or value (boundp 'encoded-kbd-mode))
+ ;; Don't load encoded-kb unnecessarily.
+ (if (or value (boundp 'encoded-kbd-setup-display))
(set-keyboard-coding-system value)
(set-default 'keyboard-coding-system nil))) ; must initialize
- :version "21.4"
+ :version "22.1"
:group 'keyboard
:group 'mule)
(interactive
(list (read-coding-system
(if last-next-selection-coding-system
- (format "Coding system for the next X selection (default, %S): "
+ (format "Coding system for the next X selection (default %S): "
last-next-selection-coding-system)
"Coding system for the next X selection: ")
last-next-selection-coding-system)))
by encode-coding-string, generate a new temp buffer, insert the
text, and convert it in the temporary buffer. Otherwise, convert in-place."
(save-match-data
- ;; Setup a working buffer if necessary.
- (cond ((stringp from)
- (let ((buf (current-buffer)))
- (set-buffer (generate-new-buffer " *temp"))
+ (let ((workbuf (get-buffer-create " *code-conversion-work*")))
+ ;; Setup a working buffer if necessary.
+ (cond ((stringp from)
+ (set-buffer workbuf)
+ (erase-buffer)
(set-buffer-multibyte (multibyte-string-p from))
- (insert from)))
- ((not (string= (buffer-name) " *code-converting-work*"))
- (let ((buf (current-buffer))
- (multibyte enable-multibyte-characters))
- (set-buffer (generate-new-buffer " *temp"))
- (set-buffer-multibyte multibyte)
- (insert-buffer-substring buf from to))))
+ (insert from))
+ ((not (eq (current-buffer) workbuf))
+ (let ((buf (current-buffer))
+ (multibyte enable-multibyte-characters))
+ (set-buffer workbuf)
+ (erase-buffer)
+ (set-buffer-multibyte multibyte)
+ (insert-buffer-substring buf from to)))))
;; Now we can encode the whole buffer.
(let ((encoding-table (ctext-non-standard-encodings-table))
;;; FILE I/O
(defcustom auto-coding-alist
- '(("\\.\\(arc\\|zip\\|lzh\\|zoo\\|jar\\|sx[dmicw]\\|tar\\|tgz\\)\\'" . no-conversion)
+ '(("\\.\\(arc\\|zip\\|lzh\\|zoo\\|[jew]ar\\|xpi\\)\\'" . no-conversion)
+ ("\\.\\(ARC\\|ZIP\\|LZH\\|ZOO\\|[JEW]AR\\|XPI\\)\\'" . no-conversion)
+ ("\\.\\(sx[dmicw]\\|tar\\|tgz\\)\\'" . no-conversion)
("\\.\\(gz\\|Z\\|bz\\|bz2\\|gpg\\)\\'" . no-conversion)
+ ("\\.\\(jpe?g\\|png\\|gif\\|tiff?\\|p[bpgn]m\\)\\'" . no-conversion)
("/#[^/]+#\\'" . emacs-mule))
"Alist of filename patterns vs corresponding coding systems.
Each element looks like (REGEXP . CODING-SYSTEM).
(setq alist (cdr alist))))
coding-system))
-(defun set-auto-coding (filename size)
- "Return coding system for a file FILENAME of which SIZE bytes follow point.
+(defun find-auto-coding (filename size)
+ "Find a coding system for a file FILENAME of which SIZE bytes follow point.
These bytes should include at least the first 1k of the file
and the last 3k of the file, but the middle may be omitted.
succeed, it checks to see if any function in `auto-coding-functions'
gives a match.
-The return value is the specified coding system, or nil if nothing is
-specified.
+If a coding system is specifed, the return value is a
+cons (CODING . SOURCE), where CODING is the specified coding
+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.
+
+If nothing is specified, the return value is nil.
The variable `set-auto-coding-function' (which see) is set to this
function by default."
- (or (auto-coding-alist-lookup filename)
+ (or (let ((coding-system (auto-coding-alist-lookup filename)))
+ (if coding-system
+ (cons coding-system 'auto-coding-alist)))
;; Try using `auto-coding-regexp-alist'.
(save-excursion
(let ((alist auto-coding-regexp-alist)
(when (re-search-forward regexp (+ (point) size) t)
(setq coding-system (cdr (car alist)))))
(setq alist (cdr alist)))
- coding-system))
+ (if coding-system
+ (cons coding-system 'auto-coding-regexp-alist))))
(let* ((case-fold-search t)
(head-start (point))
(head-end (+ head-start (min size 1024)))
(re-search-forward
"\\(.*;\\)?[ \t]*coding:[ \t]*\\([^ ;]+\\)"
head-end t))
- (setq coding-system (intern (match-string 2)))
- (or (coding-system-p coding-system)
- (setq coding-system nil)))))
+ (setq coding-system (intern (match-string 2))))))
;; If no coding: tag in the head, check the tail.
;; Here we must pay attention to the case that the end-of-line
(setq coding-system 'raw-text))
(when (and (not coding-system)
(re-search-forward re-coding tail-end t))
- (setq coding-system (intern (match-string 1)))
- (or (coding-system-p coding-system)
- (setq coding-system nil))))))
- coding-system)
+ (setq coding-system (intern (match-string 1)))))))
+ (if coding-system
+ (cons coding-system :coding)))
;; Finally, try all the `auto-coding-functions'.
(let ((funcs auto-coding-functions)
(coding-system nil))
(goto-char (point-min))
(funcall (pop funcs) size))
(error nil))))
- coding-system)))
+ (if coding-system
+ (cons coding-system 'auto-coding-functions)))))
+
+(defun set-auto-coding (filename size)
+ "Return coding system for a file FILENAME of which SIZE bytes follow point.
+See `find-auto-coding' for how the coding system is found.
+Return nil if an invalid coding system is found."
+ (let ((found (find-auto-coding filename size)))
+ (if (and found (coding-system-p (car found)))
+ (car found))))
(setq set-auto-coding-function 'set-auto-coding)
-(defun after-insert-file-set-coding (inserted)
+;; This variable is set in these two cases:
+;; (1) A file is read by a coding system specified explicitly.
+;; after-insert-file-set-coding sets this value to
+;; coding-system-for-read.
+;; (2) A buffer is saved.
+;; After writing, basic-save-buffer-1 sets this value to
+;; last-coding-system-used.
+;; This variable is used for decoding in revert-buffer.
+(defvar buffer-file-coding-system-explicit nil
+ "The file coding system explicitly specified for the current buffer.
+Internal use only.")
+(make-variable-buffer-local 'buffer-file-coding-system-explicit)
+(put 'buffer-file-coding-system-explicit 'permanent-local t)
+
+(defun after-insert-file-set-coding (inserted &optional visit)
"Set `buffer-file-coding-system' of current buffer after text is inserted.
INSERTED is the number of characters that were inserted, as figured
in the situation before this function. Return the number of characters
inserted, as figured in the situation after. The two numbers can be
-different if the buffer has become unibyte."
+different if the buffer has become unibyte.
+The optional second arg VISIT non-nil means that we are visiting a file."
+ (if (and visit
+ coding-system-for-read
+ (not (eq coding-system-for-read 'auto-save-coding)))
+ (setq buffer-file-coding-system-explicit coding-system-for-read))
(if last-coding-system-used
(let ((coding-system
(find-new-buffer-file-coding-system last-coding-system-used))
(modified-p (buffer-modified-p)))
(when coding-system
- (set-buffer-file-coding-system coding-system t)
+ ;; Tell set-buffer-file-coding-system not to mark the file
+ ;; as modified; we just read it, and it's supposed to be unmodified.
+ ;; Marking it modified would try to lock it, which would
+ ;; check the modtime, and we don't want to do that again now.
+ (set-buffer-file-coding-system coding-system t t)
(if (and enable-multibyte-characters
(or (eq coding-system 'no-conversion)
(eq (coding-system-type coding-system) 5))
(= (buffer-size) inserted))
;; For coding systems no-conversion and raw-text...,
;; edit the buffer as unibyte.
- (let ((pos-marker (copy-marker (+ (point) inserted))))
+ (let ((pos-marker (copy-marker (+ (point) inserted)))
+ ;; Prevent locking.
+ (buffer-file-name nil))
(set-buffer-multibyte nil)
(setq inserted (- pos-marker (point)))))
(set-buffer-modified-p modified-p))))
(defun decode-coding-inserted-region (from to filename
&optional visit beg end replace)
"Decode the region between FROM and TO as if it is read from file FILENAME.
+The idea is that the text between FROM and TO was just inserted somehow.
Optional arguments VISIT, BEG, END, and REPLACE are the same as those
-of the function `insert-file-contents'."
+of the function `insert-file-contents'.
+Part of the job of this function is setting `buffer-undo-list' appropriately."
(save-excursion
(save-restriction
- (narrow-to-region from to)
- (goto-char (point-min))
- (let ((coding coding-system-for-read))
+ (let ((coding coding-system-for-read)
+ undo-list-saved)
+ (if visit
+ ;; Temporarily turn off undo recording, if we're decoding the
+ ;; text of a visited file.
+ (setq buffer-undo-list t)
+ ;; Otherwise, if we can recognize the undo elt for the insertion,
+ ;; remove it and get ready to replace it later.
+ ;; In the mean time, turn off undo recording.
+ (let ((last (car-safe buffer-undo-list)))
+ (if (and (consp last) (eql (car last) from) (eql (cdr last) to))
+ (setq undo-list-saved (cdr buffer-undo-list)
+ buffer-undo-list t))))
+ (narrow-to-region from to)
+ (goto-char (point-min))
(or coding
(setq coding (funcall set-auto-coding-function
filename (- (point-max) (point-min)))))
(setq coding nil))
(if coding
(decode-coding-region (point-min) (point-max) coding)
- (setq last-coding-system-used coding))))))
+ (setq last-coding-system-used coding))
+ ;; If we're decoding the text of a visited file,
+ ;; the undo list should start out empty.
+ (if visit
+ (setq buffer-undo-list nil)
+ ;; If we decided to replace the undo entry for the insertion,
+ ;; do so now.
+ (if undo-list-saved
+ (setq buffer-undo-list
+ (cons (cons from (point-max)) undo-list-saved))))))))
+
+(defun recode-region (start end new-coding coding)
+ "Re-decode the region (previously decoded by CODING) by NEW-CODING."
+ (interactive
+ (list (region-beginning) (region-end)
+ (read-coding-system "Text was really in: ")
+ (let ((coding (or buffer-file-coding-system last-coding-system-used)))
+ (read-coding-system
+ (concat "But was interpreted as"
+ (if coding (format " (default %S): " coding) ": "))
+ coding))))
+ (or (and new-coding coding)
+ (error "Coding system not specified"))
+ ;; Check it before we encode the region.
+ (check-coding-system new-coding)
+ (save-restriction
+ (narrow-to-region start end)
+ (encode-coding-region (point-min) (point-max) coding)
+ (decode-coding-region (point-min) (point-max) new-coding)))
(defun make-translation-table (&rest args)
"Make a translation table from arguments.
(put symbol 'translation-table-id id)
id))
+(defun translate-region (start end table)
+ "From START to END, translate characters according to TABLE.
+TABLE is a string or a char-table.
+If TABLE is a string, the Nth character in it is the mapping
+for the character with code N.
+If TABLE is a char-table, the element for character N is the mapping
+for the character with code N.
+It returns the number of characters changed."
+ (interactive
+ (list (region-beginning)
+ (region-end)
+ (let (table l)
+ (dotimes (i (length translation-table-vector))
+ (if (consp (aref translation-table-vector i))
+ (push (list (symbol-name
+ (car (aref translation-table-vector i)))) l)))
+ (if (not l)
+ (error "No translation table defined"))
+ (while (not table)
+ (setq table (completing-read "Translation table: " l nil t)))
+ (intern table))))
+ (if (symbolp table)
+ (let ((val (get table 'translation-table)))
+ (or (char-table-p val)
+ (error "Invalid translation table name: %s" table))
+ (setq table val)))
+ (translate-region-internal start end table))
+
(put 'with-category-table 'lisp-indent-function 1)
(defmacro with-category-table (table &rest body)
(when (re-search-forward "\\`[[:space:]\n]*<\\?xml" size t)
(let ((end (save-excursion
;; This is a hack.
- (re-search-forward "\"\\s-*\\?>" size t))))
+ (re-search-forward "[\"']\\s-*\\?>" size t))))
(when end
- (if (re-search-forward "encoding=\"\\(.+?\\)\"" end t)
+ (if (re-search-forward "encoding=[\"']\\(.+?\\)[\"']" end t)
(let* ((match (match-string 1))
(sym (intern (downcase match))))
(if (coding-system-p sym)
(save-excursion
(forward-line 10)
(point))))
- (when (and (search-forward "<html>" size t)
+ (when (and (search-forward "<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))))
HCoop / bpt / emacs.git / blobdiff