and CODE-POINT to a character. Currently not supported and just ignored."
(cond
((eq ccs 'ucs)
- (or (gethash code-point
- (get 'utf-subst-table-for-decode 'translation-hash-table))
+ (or (utf-lookup-subst-table-for-decode code-point)
(let ((c (cond
((< code-point 160)
code-point)
(charset (car split))
trans)
(cond ((eq ccs 'ucs)
- (or (gethash char (get 'utf-subst-table-for-encode
- 'translation-hash-table))
+ (or (utf-lookup-subst-table-for-encode char)
(let ((table (get 'utf-translation-table-for-encode
'translation-table)))
(setq trans (aref table char))
(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)
(make-char charset (+ i start) start)
(make-char charset (+ i start) (+ start chars -1)))))))
-(defun register-char-codings (coding-system safe-chars)
- "This is an obsolete function.
-It exists just for backward compatibility, and it does nothing.")
+(defalias 'register-char-codings 'ignore "")
(make-obsolete 'register-char-codings
- "Unnecessary function. Calling it has no effect."
+ "it exists just for backward compatibility, and does nothing."
"21.3")
(defconst char-coding-system-table nil
(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."
+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))
;; `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)
(let* ((M (char-after (+ pos 4)))
(L (char-after (+ pos 5)))
(encoding (match-string 2))
- (encoding-info (assoc-ignore-case
+ (encoding-info (assoc-string
encoding
- ctext-non-standard-encodings-alist))
+ ctext-non-standard-encodings-alist t))
(coding (if encoding-info
(nth 1 encoding-info)
(setq encoding (intern (downcase encoding)))
(dolist (elt charset)
(aset table (make-char elt) slot)))
((char-table-p charset)
- (map-char-table #'(lambda (k v)
+ (map-char-table #'(lambda (k v)
(if (and v (> k 128)) (aset table k slot)))
charset))))))
table))
(- (point) last-pos)))
(save-excursion
(goto-char last-pos)
- (insert (string-to-multibyte
+ (insert (string-to-multibyte
(format "\e%%/%d%c%c%s\ 2"
noctets
(+ (/ len 128) 128)
(goto-char tail-start)
(re-search-forward "[\r\n]\^L" nil t)
(if (re-search-forward
- "[\r\n]\\([^[\r\n]*\\)[ \t]*Local Variables:[ \t]*\\([^\r\n]*\\)[\r\n]"
+ "[\r\n]\\([^[\r\n]*\\)[ \t]*Local Variables:[ \t]*\\([^\r\n]*\\)[\r\n]"
tail-end t)
;; The prefix is what comes before "local variables:" in its
;; line. The suffix is what comes after "local variables:"
"[ \t]*unibyte[ \t]*:[ \t]*\\([^ \t\r\n]+\\)[ \t]*"
suffix "[\r\n]"))
(re-end
- (concat "[\r\n]" prefix "[ \t]*End *:[ \t]*" suffix
+ (concat "[\r\n]" prefix "[ \t]*End *:[ \t]*" suffix
"[\r\n]?"))
(pos (1- (point))))
(forward-char -1) ; skip back \r or \n.
(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 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)))))
(coding-system-change-text-conversion coding 'raw-text)))
(setq coding nil))
(if coding
- (decode-coding-region (point-min) (point-max) coding))
- (setq last-coding-system-used coding)))))
+ (decode-coding-region (point-min) (point-max) 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 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)
(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