with-case-table / ascii-case-table (was: address@hidden: Locale Dependent Downcasing in smtpmail])

[Reiner Steib]

On Tue, Apr 03 2007, Chong Yidong wrote:

> How about the following approach?  At the beginning of characters.el,
> save the standard case table (which AFAICT hasn't been modified at
> that point), as a variable ascii-case-table.  Then downcase-ascii can
> use it.
[...]
> + (defun downcase-ascii (string)
> +   "Convert ASCII argument to lower case and return that.
> + The argument may be a character or string.  The result has the same type.
> + The argument object is not altered--the value is a copy."
> +   (let ((old-case-table (current-case-table)))
> +     (unwind-protect
> +     (progn (set-case-table ascii-case-table)
> +            (downcase string))
> +       (set-case-table old-case-table))))

Note that the problem is not only the `downcase' function.  So maybe
adding `with-case-table' would be a good idea.

Turkish Gnus user's might still suffer from the "slow search
operations problem" [1] in `gnus/nnfolder.el'.  Based on your previous
patch, I've made a preliminary patch for `nnfolder.el' [2].  I didn't
test it yet (I don't use the nnfolder back end).  It has to be
adjusted to use `ascii-case-table' and some compatibility code for
Emacs 21 (where the downcase problem is not present).

Bye, Reiner.

[1]
,----[ http://thread.gmane.org/gmane.emacs.gnus.general/63925/focus=63979 ]
| From: Reiner Steib
| Subject: Re: Slow operations on buffers of tens of megabytes
| Newsgroups: gmane.emacs.pretest.bugs, gmane.emacs.gnus.general
| Date: 2006-11-13 17:28:58 GMT (19 weeks, 5 days, 3 hours and 34 minutes ago)
| 
| On Thu, Nov 09 2006, Alexandre Oliva wrote:
| 
| > Ultimately, I'm a bit concerned about messing with the case table of
| > an nnfolder buffer for the entire duration of the buffer.  It's hard
| > to tell whether there'd be any less visible fallouts.
| 
| Richard has eliminated the peculiar upcasing dotless-i to I in CVS.
| Does it fix your problem?
| 
| (IIUC, it should fix it _unless_ the user has a Turkish language
| environment.  I.e. Turkish Gnus user's might still suffer from this
| problem.)
| 
| ,----
| | 2006-11-12  Richard Stallman  <rms <at> gnu.org>
| | 
| |     * language/european.el (turkish-case-conversion-enable)
| |     (turkish-case-conversion-disable): New functions.
| |     ("Turkish" lang env): Use them.
| | 
| |     * international/characters.el (case table):
| |     Do nothing special for i and I.
| `----
`----

[2] 

--- nnfolder.el 26 Jan 2007 20:41:00 +0100      7.17
+++ nnfolder.el 01 Apr 2007 23:09:26 +0200      
@@ -104,6 +104,39 @@
 (defconst nnfolder-article-marker "X-Gnus-Article-Number: "
   "String used to demarcate what the article number for a message is.")
 
+;; Make sure we're using the standard case table.  In a Turkish locale, the
+;; "i" in "X-Gnus-Article-Number: " makes parsing large nnfolder groups very
+;; slow.
+;; ,----[ http://thread.gmane.org/gmane.emacs.gnus.general/63925/focus=63979 ]
+;; | Subject: Slow operations on buffers of tens of megabytes
+;; | Newsgroups: gmane.emacs.pretest.bugs,gmane.emacs.gnus.general
+;; | Date: 2006-11-13
+;; `----
+(defun nnfolder-search (&optional function string &rest args)
+  "Search for `nnfolder-article-marker' using the standard case table.
+FUNCTION is used for searching.  If STRING is given, it's used
+instead of `nnfolder-article-marker'.  The remaining ARGS are
+passed to the FUNCTION."
+  (let ((old-case-table (current-case-table))
+       point)
+    (unwind-protect
+       (progn
+         (set-case-table (standard-case-table))
+         (setq point
+               (apply (cond
+                       ((fboundp function)
+                        function)
+                       (function
+                        'search-backward)
+                       (t
+                        'search-forward))
+                      (or string
+                          (concat "\n" nnfolder-article-marker))
+                      args)))
+      (set-case-table old-case-table))
+    ;; Be sure to return what the FUNCTION returned.
+    point))
+
 (defvoo nnfolder-current-group nil)
 (defvoo nnfolder-current-buffer nil)
 (defvoo nnfolder-status-string "")
@@ -198,8 +231,7 @@
                      ;; as caused by active file bogosity.
                      (cond
                       ((bobp))
-                      ((search-backward (concat "\n" nnfolder-article-marker)
-                                        nil t)
+                      ((nnfolder-search 'search-backward nil nil t)
                        (goto-char (match-end 0))
                        (setq num (string-to-number
                                   (buffer-substring
@@ -208,8 +240,7 @@
                        (< num article)))
                      ;; Check that we are before an article with a
                      ;; higher number.
-                     (search-forward (concat "\n" nnfolder-article-marker)
-                                     nil t)
+                     (nnfolder-search 'search-forward nil nil t)
                      (progn
                        (setq num (string-to-number
                                   (buffer-substring
@@ -284,8 +315,7 @@
              (cons nnfolder-current-group article)
            (goto-char (point-min))
            (cons nnfolder-current-group
-                 (if (search-forward (concat "\n" nnfolder-article-marker)
-                                     nil t)
+                 (if (nnfolder-search 'search-forward nil nil t)
                      (string-to-number (buffer-substring
                                      (point) (point-at-eol)))
                    -1))))))))
@@ -405,10 +435,9 @@
     (when nnfolder-current-buffer
       (set-buffer nnfolder-current-buffer)
       (goto-char (point-min))
-      (let ((marker (concat "\n" nnfolder-article-marker))
-           (number "[0-9]+")
+      (let ((number "[0-9]+")
            numbers)
-       (while (and (search-forward marker nil t)
+       (while (and (nnfolder-search 'search-forward nil nil t)
                    (re-search-forward number nil t))
          (let ((newnum (string-to-number (match-string 0))))
            (if (nnmail-within-headers-p)
@@ -436,8 +465,7 @@
       (while (and maybe-expirable is-old)
        (goto-char (point-min))
        (when (and (nnfolder-goto-article (car maybe-expirable))
-                  (search-forward (concat "\n" nnfolder-article-marker)
-                                  nil t))
+                  (nnfolder-search 'search-forward nil nil t))
          (forward-sexp)
          (when (setq is-old
                      (nnmail-expired-article-p
@@ -480,8 +508,7 @@
         (erase-buffer)
         (insert-buffer-substring nntp-server-buffer)
         (goto-char (point-min))
-        (while (re-search-forward
-                (concat "^" nnfolder-article-marker)
+        (while (nnfolder-search 're-search-forward nil
                 (save-excursion (and (search-forward "\n\n" nil t) (point)))
                 t)
           (gnus-delete-line))
@@ -523,7 +550,9 @@
        (if (search-forward "\n\n" nil t)
            (forward-line -1)
          (goto-char (point-max)))
-       (while (re-search-backward (concat "^" nnfolder-article-marker) nil t)
+       (while (nnfolder-search 're-search-backward
+                               (concat "^" nnfolder-article-marker)
+                               nil t)
          (delete-region (point) (progn (forward-line 1) (point))))
        (when nnmail-cache-accepted-message-ids
          (nnmail-cache-insert (nnmail-fetch-field "message-id") 
@@ -642,13 +671,12 @@
 (defun nnfolder-adjust-min-active (group)
   ;; Find the lowest active article in this group.
   (let* ((active (cadr (assoc group nnfolder-group-alist)))
-        (marker (concat "\n" nnfolder-article-marker))
         (number "[0-9]+")
         (activemin (cdr active)))
     (save-excursion
       (set-buffer nnfolder-current-buffer)
       (goto-char (point-min))
-      (while (and (search-forward marker nil t)
+      (while (and (nnfolder-search 'search-forward nil nil t)
                  (re-search-forward number nil t))
        (let ((newnum (string-to-number (match-string 0))))
          (if (nnmail-within-headers-p)
@@ -788,7 +816,7 @@
       (if (search-forward "\n\n" nil t)
          (forward-line -1)
        (goto-char (point-max)))
-      (while (search-backward (concat "\n" nnfolder-article-marker) nil t)
+      (while (nnfolder-search 'search-backward nil nil t)
        (delete-region (1+ (point)) (progn (forward-line 2) (point))))
 
       ;; Insert the new newsgroup marker.
@@ -894,7 +922,6 @@
        (nnmail-activate 'nnfolder)
        ;; Read in the file.
        (let ((delim "^From ")
-             (marker (concat "\n" nnfolder-article-marker))
              (number "[0-9]+")
              (active (or (cadr (assoc group nnfolder-group-alist))
                          (cons 1 0)))
@@ -928,7 +955,7 @@
          (when (or nnfolder-ignore-active-file
                    novbuf
                    (< maxid 2))
-           (while (and (search-forward marker nil t)
+           (while (and (nnfolder-search 'search-forward nil nil t)
                        (looking-at number))
              (setq newnum (string-to-number (match-string 0)))
              (when (nnmail-within-headers-p)
@@ -959,7 +986,7 @@
          (when (not (or nnfolder-distrust-mbox
                         (< maxid 2)))
            (goto-char (point-max))
-           (unless (re-search-backward marker nil t)
+           (unless (nnfolder-search 're-search-backward nil nil t)
              (goto-char (point-min)))
            ;;(when (nnmail-search-unix-mail-delim)
            ;;  (goto-char (point-min)))
@@ -982,7 +1009,7 @@
                                (point)
                              (point-max)))
            (goto-char start)
-           (when (not (search-forward marker end t))
+           (when (not (nnfolder-search 'search-forward nil end t))
              (narrow-to-region start end)
              (nnmail-insert-lines)
              (nnfolder-insert-newsgroup-line

-- 
       ,,,
      (o o)
---ooO-(_)-Ooo---  |  PGP key available  |  http://rsteib.home.pages.de/