Re: enhanced select-safe-coding-system

[Dave Love]

Richard Stallman <address@hidden> writes:

> Your code was based on an older version

Yes, probably over a year old.

> did not have some other changes that are in the sources now.  I
> merged it, and the changes you made seem to be these.

They look like the right sort of changes, but you want to break this
line so that it's obvious that `coding-system' is being returned.

> !           (error "Save aborted")))))    coding-system))

Incidentally, I think Emacs should have `remove-if', or whatever
Common Lisp calls the function for filtering lists according to a
predicate, as I needed to filter the coding list.  That operation seems
quite common.

If you want to make select-safe-coding-system more helpful, you could
also use code like this to find at least the first unencodable
character and display that part of the buffer when
select-safe-coding-system needs to prompt for a coding system.  Emacs
20 used to do something similar, but it was only necessary to check
charsets then.

(defun unencodable-char-position (start end coding-system)
  "Return position of first un-encodable character in a region.
START and END specfiy the region and CODING-SYSTEM specifies the
encoding to check.  Return nil if CODING-SYSTEM does encode the region.

CODING-SYSTEM may also be a list of coding systems, in which case return
the first position not encodable by any of them.

This function is fairly slow."
  ;; Use recursive calls in the binary chop below, since we're
  ;; O(logN), and the call overhead shouldn't be a bottleneck.
  (unless enable-multibyte-characters
    (error "unibyte buffer"))
  ;; Recurse if list of coding systems.
  (if (consp coding-system)
      (let ((end end) res)
        (dolist (elt coding-system (and res (>= res 0) res))
          (let ((pos (unencodable-char-position start end elt)))
            (if pos
                (setq end pos
                      res pos)))))
    ;; Skip ASCII initially.
    (save-excursion
      (skip-chars-forward "\000-\177" end)
      (setq start (point)))
    (unless (= start end)
      (setq coding-system (coding-system-base coding-system)) ; canonicalize
      (let ((codings (find-coding-systems-region start end)))
        (unless (or (equal codings '(undecided))
                    (memq coding-system
                          (find-coding-systems-region start end)))
          ;; Binary chop.
          (if (= start (1- end))
              start
            (or (unencodable-char-position start (/ (+ start end) 2)
                                           coding-system)
                (unencodable-char-position (/ (+ start end) 2) end
                                           coding-system))))))))