Mercurial > emacs
comparison lisp/international/mule.el @ 64482:62fe32ed4496
(find-auto-coding): New function created
by modifying the body of set-auto-coding.
(set-auto-coding): Use find-auto-coding to find a coding.
author | Kenichi Handa <handa@m17n.org> |
---|---|
date | Tue, 19 Jul 2005 02:30:29 +0000 |
parents | 9f966287a535 |
children | ed770a0a7846 532e0a9335a9 187d6a1f84f7 |
comparison
equal
deleted
inserted
replaced
64481:0626bdaeea77 | 64482:62fe32ed4496 |
---|---|
1619 (if (string-match (car (car alist)) filename) | 1619 (if (string-match (car (car alist)) filename) |
1620 (setq coding-system (cdr (car alist))) | 1620 (setq coding-system (cdr (car alist))) |
1621 (setq alist (cdr alist)))) | 1621 (setq alist (cdr alist)))) |
1622 coding-system)) | 1622 coding-system)) |
1623 | 1623 |
1624 (defun set-auto-coding (filename size) | 1624 (defun find-auto-coding (filename size) |
1625 "Return coding system for a file FILENAME of which SIZE bytes follow point. | 1625 "Find a coding system for a file FILENAME of which SIZE bytes follow point. |
1626 These bytes should include at least the first 1k of the file | 1626 These bytes should include at least the first 1k of the file |
1627 and the last 3k of the file, but the middle may be omitted. | 1627 and the last 3k of the file, but the middle may be omitted. |
1628 | 1628 |
1629 The function checks FILENAME against the variable `auto-coding-alist'. | 1629 The function checks FILENAME against the variable `auto-coding-alist'. |
1630 If FILENAME doesn't match any entries in the variable, it checks the | 1630 If FILENAME doesn't match any entries in the variable, it checks the |
1634 `coding:' tag is found, it checks any local variables list in the last | 1634 `coding:' tag is found, it checks any local variables list in the last |
1635 3K bytes out of the SIZE bytes. Finally, if none of these methods | 1635 3K bytes out of the SIZE bytes. Finally, if none of these methods |
1636 succeed, it checks to see if any function in `auto-coding-functions' | 1636 succeed, it checks to see if any function in `auto-coding-functions' |
1637 gives a match. | 1637 gives a match. |
1638 | 1638 |
1639 The return value is the specified coding system, or nil if nothing is | 1639 If a coding system is specifed, the return value is a |
1640 specified. | 1640 cons (CODING . SOURCE), where CODING is the specified coding |
1641 system and SOURCE is a symbol `auto-coding-alist', | |
1642 `auto-coding-regexp-alist', `coding:', or `auto-coding-functions' | |
1643 indicating by what CODING is specified. Note that the validity | |
1644 of CODING is not checked; it's callers responsibility to check | |
1645 it. | |
1646 | |
1647 If nothing is specified, the return value is nil. | |
1641 | 1648 |
1642 The variable `set-auto-coding-function' (which see) is set to this | 1649 The variable `set-auto-coding-function' (which see) is set to this |
1643 function by default." | 1650 function by default." |
1644 (or (auto-coding-alist-lookup filename) | 1651 (or (let ((coding-system (auto-coding-alist-lookup filename))) |
1652 (if coding-system | |
1653 (cons coding-system 'auto-coding-alist))) | |
1645 ;; Try using `auto-coding-regexp-alist'. | 1654 ;; Try using `auto-coding-regexp-alist'. |
1646 (save-excursion | 1655 (save-excursion |
1647 (let ((alist auto-coding-regexp-alist) | 1656 (let ((alist auto-coding-regexp-alist) |
1648 coding-system) | 1657 coding-system) |
1649 (while (and alist (not coding-system)) | 1658 (while (and alist (not coding-system)) |
1650 (let ((regexp (car (car alist)))) | 1659 (let ((regexp (car (car alist)))) |
1651 (when (re-search-forward regexp (+ (point) size) t) | 1660 (when (re-search-forward regexp (+ (point) size) t) |
1652 (setq coding-system (cdr (car alist))))) | 1661 (setq coding-system (cdr (car alist))))) |
1653 (setq alist (cdr alist))) | 1662 (setq alist (cdr alist))) |
1654 coding-system)) | 1663 (if coding-system |
1664 (cons coding-system 'auto-coding-regexp-alist)))) | |
1655 (let* ((case-fold-search t) | 1665 (let* ((case-fold-search t) |
1656 (head-start (point)) | 1666 (head-start (point)) |
1657 (head-end (+ head-start (min size 1024))) | 1667 (head-end (+ head-start (min size 1024))) |
1658 (tail-start (+ head-start (max (- size 3072) 0))) | 1668 (tail-start (+ head-start (max (- size 3072) 0))) |
1659 (tail-end (+ head-start size)) | 1669 (tail-end (+ head-start size)) |
1683 (setq coding-system 'raw-text)) | 1693 (setq coding-system 'raw-text)) |
1684 (when (and (not coding-system) | 1694 (when (and (not coding-system) |
1685 (re-search-forward | 1695 (re-search-forward |
1686 "\\(.*;\\)?[ \t]*coding:[ \t]*\\([^ ;]+\\)" | 1696 "\\(.*;\\)?[ \t]*coding:[ \t]*\\([^ ;]+\\)" |
1687 head-end t)) | 1697 head-end t)) |
1688 (setq coding-system (intern (match-string 2))) | 1698 (setq coding-system (intern (match-string 2)))))) |
1689 (or (coding-system-p coding-system) | |
1690 (setq coding-system nil))))) | |
1691 | 1699 |
1692 ;; If no coding: tag in the head, check the tail. | 1700 ;; If no coding: tag in the head, check the tail. |
1693 ;; Here we must pay attention to the case that the end-of-line | 1701 ;; Here we must pay attention to the case that the end-of-line |
1694 ;; is just "\r" and we can't use "^" nor "$" in regexp. | 1702 ;; is just "\r" and we can't use "^" nor "$" in regexp. |
1695 (when (and tail-found (not coding-system)) | 1703 (when (and tail-found (not coding-system)) |
1726 (when (and set-auto-coding-for-load | 1734 (when (and set-auto-coding-for-load |
1727 (re-search-forward re-unibyte tail-end t)) | 1735 (re-search-forward re-unibyte tail-end t)) |
1728 (setq coding-system 'raw-text)) | 1736 (setq coding-system 'raw-text)) |
1729 (when (and (not coding-system) | 1737 (when (and (not coding-system) |
1730 (re-search-forward re-coding tail-end t)) | 1738 (re-search-forward re-coding tail-end t)) |
1731 (setq coding-system (intern (match-string 1))) | 1739 (setq coding-system (intern (match-string 1))))))) |
1732 (or (coding-system-p coding-system) | 1740 (if coding-system |
1733 (setq coding-system nil)))))) | 1741 (cons coding-system :coding))) |
1734 coding-system) | |
1735 ;; Finally, try all the `auto-coding-functions'. | 1742 ;; Finally, try all the `auto-coding-functions'. |
1736 (let ((funcs auto-coding-functions) | 1743 (let ((funcs auto-coding-functions) |
1737 (coding-system nil)) | 1744 (coding-system nil)) |
1738 (while (and funcs (not coding-system)) | 1745 (while (and funcs (not coding-system)) |
1739 (setq coding-system (condition-case e | 1746 (setq coding-system (condition-case e |
1740 (save-excursion | 1747 (save-excursion |
1741 (goto-char (point-min)) | 1748 (goto-char (point-min)) |
1742 (funcall (pop funcs) size)) | 1749 (funcall (pop funcs) size)) |
1743 (error nil)))) | 1750 (error nil)))) |
1744 coding-system))) | 1751 (if coding-system |
1752 (cons coding-system 'auto-coding-functions))))) | |
1753 | |
1754 (defun set-auto-coding (filename size) | |
1755 "Return coding system for a file FILENAME of which SIZE bytes follow point. | |
1756 See `find-auto-coding' for how the coding system is found. | |
1757 Return nil if an invalid coding system is found." | |
1758 (let ((found (find-auto-coding filename size))) | |
1759 (if (and found (coding-system-p (car found))) | |
1760 (car found)))) | |
1745 | 1761 |
1746 (setq set-auto-coding-function 'set-auto-coding) | 1762 (setq set-auto-coding-function 'set-auto-coding) |
1747 | 1763 |
1748 ;; This variable is set in these two cases: | 1764 ;; This variable is set in these two cases: |
1749 ;; (1) A file is read by a coding system specified explicitly. | 1765 ;; (1) A file is read by a coding system specified explicitly. |