diff options
| -rw-r--r-- | doc/misc/ChangeLog | 4 | ||||
| -rw-r--r-- | doc/misc/gnus.texi | 81 | ||||
| -rw-r--r-- | lisp/ChangeLog | 10 | ||||
| -rw-r--r-- | lisp/emacs-lisp/pcase.el | 34 | ||||
| -rw-r--r-- | lisp/gnus/ChangeLog | 66 | ||||
| -rw-r--r-- | lisp/gnus/gnus-cite.el | 140 | ||||
| -rw-r--r-- | lisp/gnus/gnus-ems.el | 53 | ||||
| -rw-r--r-- | lisp/gnus/gnus-group.el | 169 | ||||
| -rw-r--r-- | lisp/gnus/gnus-html.el | 108 | ||||
| -rw-r--r-- | lisp/gnus/gnus-sum.el | 2 | ||||
| -rw-r--r-- | lisp/gnus/gnus.el | 13 | ||||
| -rw-r--r-- | lisp/gnus/message.el | 1 | ||||
| -rw-r--r-- | lisp/gnus/nndb.el | 325 | ||||
| -rw-r--r-- | lisp/gnus/nnir.el | 8 | ||||
| -rw-r--r-- | lisp/gnus/nnkiboze.el | 391 | ||||
| -rw-r--r-- | lisp/gnus/nnlistserv.el | 152 | ||||
| -rw-r--r-- | lisp/gnus/nnwfm.el | 432 | ||||
| -rw-r--r-- | lisp/htmlfontify.el | 2 | ||||
| -rw-r--r-- | lisp/simple.el | 18 | ||||
| -rw-r--r-- | src/ChangeLog | 8 | ||||
| -rw-r--r-- | src/cmds.c | 105 |
21 files changed, 431 insertions, 1691 deletions
diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index 482499d4df5..d811c3b7e43 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog | |||
| @@ -1,3 +1,7 @@ | |||
| 1 | 2010-09-01 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 2 | |||
| 3 | * gnus.texi (HTML): Document gnus-max-image-proportion. | ||
| 4 | |||
| 1 | 2010-08-31 Lars Magne Ingebrigtsen <larsi@gnus.org> | 5 | 2010-08-31 Lars Magne Ingebrigtsen <larsi@gnus.org> |
| 2 | 6 | ||
| 3 | * gnus.texi (HTML): Document gnus-blocked-images. | 7 | * gnus.texi (HTML): Document gnus-blocked-images. |
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 745d2333c0c..3db39e32101 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi | |||
| @@ -721,7 +721,6 @@ Document Groups | |||
| 721 | Combined Groups | 721 | Combined Groups |
| 722 | 722 | ||
| 723 | * Virtual Groups:: Combining articles from many groups. | 723 | * Virtual Groups:: Combining articles from many groups. |
| 724 | * Kibozed Groups:: Looking through parts of the newsfeed for articles. | ||
| 725 | 724 | ||
| 726 | Email Based Diary | 725 | Email Based Diary |
| 727 | 726 | ||
| @@ -2624,15 +2623,6 @@ default a group pointing to the most recent articles will be created | |||
| 2624 | (@code{gnus-group-recent-archive-directory}), but given a prefix, a full | 2623 | (@code{gnus-group-recent-archive-directory}), but given a prefix, a full |
| 2625 | group will be created from @code{gnus-group-archive-directory}. | 2624 | group will be created from @code{gnus-group-archive-directory}. |
| 2626 | 2625 | ||
| 2627 | @item G k | ||
| 2628 | @kindex G k (Group) | ||
| 2629 | @findex gnus-group-make-kiboze-group | ||
| 2630 | @cindex nnkiboze | ||
| 2631 | Make a kiboze group. You will be prompted for a name, for a regexp to | ||
| 2632 | match groups to be ``included'' in the kiboze group, and a series of | ||
| 2633 | strings to match on headers (@code{gnus-group-make-kiboze-group}). | ||
| 2634 | @xref{Kibozed Groups}. | ||
| 2635 | |||
| 2636 | @item G D | 2626 | @item G D |
| 2637 | @kindex G D (Group) | 2627 | @kindex G D (Group) |
| 2638 | @findex gnus-group-enter-directory | 2628 | @findex gnus-group-enter-directory |
| @@ -4420,8 +4410,7 @@ which point to the ``real'' message files (if mbox is used, copies are | |||
| 4420 | made). Since mairix already presents search results in such a virtual | 4410 | made). Since mairix already presents search results in such a virtual |
| 4421 | mail folder, it is very well suited for using it as an external program | 4411 | mail folder, it is very well suited for using it as an external program |
| 4422 | for creating @emph{smart} mail folders, which represent certain mail | 4412 | for creating @emph{smart} mail folders, which represent certain mail |
| 4423 | searches. This is similar to a Kiboze group (@pxref{Kibozed Groups}), | 4413 | searches. |
| 4424 | but much faster. | ||
| 4425 | 4414 | ||
| 4426 | @node nnmairix requirements | 4415 | @node nnmairix requirements |
| 4427 | @subsubsection nnmairix requirements | 4416 | @subsubsection nnmairix requirements |
| @@ -12515,6 +12504,14 @@ directory, the oldest files will be deleted. The default is 500MB. | |||
| 12515 | @vindex gnus-html-frame-width | 12504 | @vindex gnus-html-frame-width |
| 12516 | The width to use when rendering HTML. The default is 70. | 12505 | The width to use when rendering HTML. The default is 70. |
| 12517 | 12506 | ||
| 12507 | @item gnus-max-image-proportion | ||
| 12508 | @vindex gnus-max-image-proportion | ||
| 12509 | How big pictures displayed are in relation to the window they're in. | ||
| 12510 | A value of 0.7 (the default) means that they are allowed to take up | ||
| 12511 | 70% of the width and height of the window. If they are larger than | ||
| 12512 | this, and Emacs supports it, then the images will be rescaled down to | ||
| 12513 | fit these criteria. | ||
| 12514 | |||
| 12518 | @end table | 12515 | @end table |
| 12519 | 12516 | ||
| 12520 | To use this, make sure that you have @code{w3m} and @code{curl} | 12517 | To use this, make sure that you have @code{w3m} and @code{curl} |
| @@ -18925,7 +18922,6 @@ groups. | |||
| 18925 | 18922 | ||
| 18926 | @menu | 18923 | @menu |
| 18927 | * Virtual Groups:: Combining articles from many groups. | 18924 | * Virtual Groups:: Combining articles from many groups. |
| 18928 | * Kibozed Groups:: Looking through parts of the newsfeed for articles. | ||
| 18929 | @end menu | 18925 | @end menu |
| 18930 | 18926 | ||
| 18931 | 18927 | ||
| @@ -19015,58 +19011,6 @@ from component groups---group parameters, for instance, are not | |||
| 19015 | inherited. | 19011 | inherited. |
| 19016 | 19012 | ||
| 19017 | 19013 | ||
| 19018 | @node Kibozed Groups | ||
| 19019 | @subsection Kibozed Groups | ||
| 19020 | @cindex nnkiboze | ||
| 19021 | @cindex kibozing | ||
| 19022 | |||
| 19023 | @dfn{Kibozing} is defined by the @acronym{OED} as ``grepping through | ||
| 19024 | (parts of) the news feed''. @code{nnkiboze} is a back end that will | ||
| 19025 | do this for you. Oh joy! Now you can grind any @acronym{NNTP} server | ||
| 19026 | down to a halt with useless requests! Oh happiness! | ||
| 19027 | |||
| 19028 | @kindex G k (Group) | ||
| 19029 | To create a kibozed group, use the @kbd{G k} command in the group | ||
| 19030 | buffer. | ||
| 19031 | |||
| 19032 | The address field of the @code{nnkiboze} method is, as with | ||
| 19033 | @code{nnvirtual}, a regexp to match groups to be ``included'' in the | ||
| 19034 | @code{nnkiboze} group. That's where most similarities between | ||
| 19035 | @code{nnkiboze} and @code{nnvirtual} end. | ||
| 19036 | |||
| 19037 | In addition to this regexp detailing component groups, an | ||
| 19038 | @code{nnkiboze} group must have a score file to say what articles are | ||
| 19039 | to be included in the group (@pxref{Scoring}). | ||
| 19040 | |||
| 19041 | @kindex M-x nnkiboze-generate-groups | ||
| 19042 | @findex nnkiboze-generate-groups | ||
| 19043 | You must run @kbd{M-x nnkiboze-generate-groups} after creating the | ||
| 19044 | @code{nnkiboze} groups you want to have. This command will take time. | ||
| 19045 | Lots of time. Oodles and oodles of time. Gnus has to fetch the | ||
| 19046 | headers from all the articles in all the component groups and run them | ||
| 19047 | through the scoring process to determine if there are any articles in | ||
| 19048 | the groups that are to be part of the @code{nnkiboze} groups. | ||
| 19049 | |||
| 19050 | Please limit the number of component groups by using restrictive | ||
| 19051 | regexps. Otherwise your sysadmin may become annoyed with you, and the | ||
| 19052 | @acronym{NNTP} site may throw you off and never let you back in again. | ||
| 19053 | Stranger things have happened. | ||
| 19054 | |||
| 19055 | @code{nnkiboze} component groups do not have to be alive---they can be dead, | ||
| 19056 | and they can be foreign. No restrictions. | ||
| 19057 | |||
| 19058 | @vindex nnkiboze-directory | ||
| 19059 | The generation of an @code{nnkiboze} group means writing two files in | ||
| 19060 | @code{nnkiboze-directory}, which is @file{~/News/kiboze/} by default. | ||
| 19061 | One contains the @acronym{NOV} header lines for all the articles in | ||
| 19062 | the group, and the other is an additional @file{.newsrc} file to store | ||
| 19063 | information on what groups have been searched through to find | ||
| 19064 | component articles. | ||
| 19065 | |||
| 19066 | Articles marked as read in the @code{nnkiboze} group will have | ||
| 19067 | their @acronym{NOV} lines removed from the @acronym{NOV} file. | ||
| 19068 | |||
| 19069 | |||
| 19070 | @node Email Based Diary | 19014 | @node Email Based Diary |
| 19071 | @section Email Based Diary | 19015 | @section Email Based Diary |
| 19072 | @cindex diary | 19016 | @cindex diary |
| @@ -27415,10 +27359,6 @@ You can set the process mark on both groups and articles and perform | |||
| 27415 | operations on all the marked items (@pxref{Process/Prefix}). | 27359 | operations on all the marked items (@pxref{Process/Prefix}). |
| 27416 | 27360 | ||
| 27417 | @item | 27361 | @item |
| 27418 | You can grep through a subset of groups and create a group from the | ||
| 27419 | results (@pxref{Kibozed Groups}). | ||
| 27420 | |||
| 27421 | @item | ||
| 27422 | You can list subsets of groups according to, well, anything | 27362 | You can list subsets of groups according to, well, anything |
| 27423 | (@pxref{Listing Groups}). | 27363 | (@pxref{Listing Groups}). |
| 27424 | 27364 | ||
| @@ -29126,8 +29066,7 @@ As the variables for the other back ends, there are | |||
| 29126 | @code{nnfolder-nov-is-evil}, @code{nnimap-nov-is-evil}, | 29066 | @code{nnfolder-nov-is-evil}, @code{nnimap-nov-is-evil}, |
| 29127 | @code{nnml-nov-is-evil}, and @code{nnspool-nov-is-evil}. Note that a | 29067 | @code{nnml-nov-is-evil}, and @code{nnspool-nov-is-evil}. Note that a |
| 29128 | non-@code{nil} value for @code{gnus-nov-is-evil} overrides all those | 29068 | non-@code{nil} value for @code{gnus-nov-is-evil} overrides all those |
| 29129 | variables.@footnote{Although the back ends @code{nnkiboze}, and | 29069 | variables. |
| 29130 | @code{nnwfm} don't have their own nn*-nov-is-evil.} | ||
| 29131 | @end table | 29070 | @end table |
| 29132 | 29071 | ||
| 29133 | 29072 | ||
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index cea29413eb9..cd86f9d20e4 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,13 @@ | |||
| 1 | 2010-09-01 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * simple.el (blink-paren-function): Move from C to here. | ||
| 4 | (blink-paren-post-self-insert-function): New function. | ||
| 5 | (post-self-insert-hook): Use it. | ||
| 6 | |||
| 7 | * emacs-lisp/pcase.el (pcase-split-memq): | ||
| 8 | Fix overenthusiastic optimisation. | ||
| 9 | (pcase-u1): Handle the case of a lambda pred. | ||
| 10 | |||
| 1 | 2010-08-31 Kenichi Handa <handa@m17n.org> | 11 | 2010-08-31 Kenichi Handa <handa@m17n.org> |
| 2 | 12 | ||
| 3 | * international/mule-cmds.el (standard-display-european-internal): | 13 | * international/mule-cmds.el (standard-display-european-internal): |
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 0b46eb2a301..b2b27a0e0d6 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el | |||
| @@ -290,9 +290,13 @@ MATCH is the pattern that needs to be matched, of the form: | |||
| 290 | (defun pcase-split-memq (elems pat) | 290 | (defun pcase-split-memq (elems pat) |
| 291 | ;; Based on pcase-split-eq. | 291 | ;; Based on pcase-split-eq. |
| 292 | (cond | 292 | (cond |
| 293 | ;; The same match will give the same result. | 293 | ;; The same match will give the same result, but we don't know how |
| 294 | ;; to check it. | ||
| 295 | ;; (??? | ||
| 296 | ;; (cons :pcase-succeed nil)) | ||
| 297 | ;; A match for one of the elements may succeed or fail. | ||
| 294 | ((and (eq (car-safe pat) '\`) (member (cadr pat) elems)) | 298 | ((and (eq (car-safe pat) '\`) (member (cadr pat) elems)) |
| 295 | (cons :pcase-succeed nil)) | 299 | nil) |
| 296 | ;; A different match will fail if this one succeeds. | 300 | ;; A different match will fail if this one succeeds. |
| 297 | ((and (eq (car-safe pat) '\`) | 301 | ((and (eq (car-safe pat) '\`) |
| 298 | ;; (or (integerp (cadr pat)) (symbolp (cadr pat)) | 302 | ;; (or (integerp (cadr pat)) (symbolp (cadr pat)) |
| @@ -383,18 +387,20 @@ and otherwise defers to REST which is a list of branches of the form | |||
| 383 | `(,(cadr upat) ,sym) | 387 | `(,(cadr upat) ,sym) |
| 384 | (let* ((exp (cadr upat)) | 388 | (let* ((exp (cadr upat)) |
| 385 | ;; `vs' is an upper bound on the vars we need. | 389 | ;; `vs' is an upper bound on the vars we need. |
| 386 | (vs (pcase-fgrep (mapcar #'car vars) exp))) | 390 | (vs (pcase-fgrep (mapcar #'car vars) exp)) |
| 387 | (if vs | 391 | (call (if (functionp exp) |
| 388 | ;; Let's not replace `vars' in `exp' since it's | 392 | `(,exp ,sym) `(,@exp ,sym)))) |
| 389 | ;; too difficult to do it right, instead just | 393 | (if (null vs) |
| 390 | ;; let-bind `vars' around `exp'. | 394 | call |
| 391 | `(let ,(mapcar (lambda (var) | 395 | ;; Let's not replace `vars' in `exp' since it's |
| 392 | (list var (cdr (assq var vars)))) | 396 | ;; too difficult to do it right, instead just |
| 393 | vs) | 397 | ;; let-bind `vars' around `exp'. |
| 394 | ;; FIXME: `vars' can capture `sym'. E.g. | 398 | `(let ,(mapcar (lambda (var) |
| 395 | ;; (pcase x ((and `(,x . ,y) (pred (fun x))))) | 399 | (list var (cdr (assq var vars)))) |
| 396 | (,@exp ,sym)) | 400 | vs) |
| 397 | `(,@exp ,sym)))) | 401 | ;; FIXME: `vars' can capture `sym'. E.g. |
| 402 | ;; (pcase x ((and `(,x . ,y) (pred (fun x))))) | ||
| 403 | ,call)))) | ||
| 398 | (pcase-u1 matches code vars then-rest) | 404 | (pcase-u1 matches code vars then-rest) |
| 399 | (pcase-u else-rest)))) | 405 | (pcase-u else-rest)))) |
| 400 | ((symbolp upat) | 406 | ((symbolp upat) |
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index dd1b54f9a0e..11ce61ce496 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog | |||
| @@ -1,3 +1,69 @@ | |||
| 1 | 2010-09-01 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 2 | |||
| 3 | * nnwfm.el: Removed. | ||
| 4 | |||
| 5 | * nnlistserv.el: Removed. | ||
| 6 | |||
| 7 | 2010-09-01 Teodor Zlatanov <tzz@lifelogs.com> | ||
| 8 | |||
| 9 | * gnus-html.el (gnus-html-image-url-blocked-p): New function. | ||
| 10 | (gnus-html-prefetch-images, gnus-html-wash-tags): Use it. | ||
| 11 | |||
| 12 | 2010-09-01 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 13 | |||
| 14 | * nnkiboze.el: Removed. | ||
| 15 | |||
| 16 | * nndb.el: Removed. | ||
| 17 | |||
| 18 | * gnus-html.el (gnus-html-put-image): Use the deleted text as the image | ||
| 19 | alt text. | ||
| 20 | (gnus-html-rescale-image): Try to get the rescaling logic right for | ||
| 21 | images that are just wide and not tall. | ||
| 22 | |||
| 23 | * gnus.el (gnus-string-or): Fix the syntax to not use eval or | ||
| 24 | overshadow variable bindings. | ||
| 25 | |||
| 26 | 2010-09-01 Teodor Zlatanov <tzz@lifelogs.com> | ||
| 27 | |||
| 28 | * gnus-html.el (gnus-html-wash-tags) | ||
| 29 | (gnus-html-schedule-image-fetching, gnus-html-prefetch-images): Add | ||
| 30 | extra logging. | ||
| 31 | |||
| 32 | 2010-09-01 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 33 | |||
| 34 | * gnus-html.el (gnus-html-wash-tags): Delete the IMG_ALT region. | ||
| 35 | (gnus-max-image-proportion): New variable. | ||
| 36 | (gnus-html-rescale-image): New function. | ||
| 37 | (gnus-html-put-image): Rescale images. | ||
| 38 | |||
| 39 | 2010-09-01 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 40 | |||
| 41 | Fix up some byte-compiler warnings. | ||
| 42 | * gnus.el (gnus-group-find-parameter, gnus-kill-save-kill-buffer): | ||
| 43 | * gnus-cite.el (gnus-article-highlight-citation, gnus-dissect-cited-text) | ||
| 44 | (gnus-article-fill-cited-article, gnus-article-hide-citation) | ||
| 45 | (gnus-article-hide-citation-in-followups, gnus-cite-toggle): | ||
| 46 | * gnus-group.el (gnus-group-set-mode-line, gnus-group-quit) | ||
| 47 | (gnus-group-set-info, gnus-add-mark): Use with-current-buffer. | ||
| 48 | (gnus-group-update-group): Use save-excursion and with-current-buffer. | ||
| 49 | |||
| 50 | 2010-09-01 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 51 | |||
| 52 | * gnus-html.el (gnus-article-html): Decode contents by charset. | ||
| 53 | |||
| 54 | 2010-09-01 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 55 | |||
| 56 | * gnus-html.el (gnus-html-cache-directory, gnus-html-cache-size) | ||
| 57 | (gnus-html-frame-width, gnus-blocked-images) | ||
| 58 | * message.el (message-prune-recipient-rules): Add custom version. | ||
| 59 | * gnus-sum.el (gnus-auto-expirable-marks): Bump custom version. | ||
| 60 | |||
| 61 | * gnus-ems.el (gnus-process-get, gnus-process-put): New compatibility | ||
| 62 | functions. | ||
| 63 | |||
| 64 | * gnus-html.el (gnus-html-curl-sentinel): Replace process-get with | ||
| 65 | gnus-process-get. | ||
| 66 | |||
| 1 | 2010-08-31 Julien Danjou <julien@danjou.info> (tiny change) | 67 | 2010-08-31 Julien Danjou <julien@danjou.info> (tiny change) |
| 2 | 68 | ||
| 3 | * nnimap.el (nnimap-request-newgroups): Use nnimap-request-list-method | 69 | * nnimap.el (nnimap-request-newgroups): Use nnimap-request-list-method |
diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el index 9502bd819cc..ebc84b6e0b6 100644 --- a/lisp/gnus/gnus-cite.el +++ b/lisp/gnus/gnus-cite.el | |||
| @@ -407,9 +407,7 @@ lines matches `message-cite-prefix-regexp' with the same prefix. | |||
| 407 | Lines matching `gnus-cite-attribution-suffix' and perhaps | 407 | Lines matching `gnus-cite-attribution-suffix' and perhaps |
| 408 | `gnus-cite-attribution-prefix' are considered attribution lines." | 408 | `gnus-cite-attribution-prefix' are considered attribution lines." |
| 409 | (interactive (list 'force)) | 409 | (interactive (list 'force)) |
| 410 | (save-excursion | 410 | (with-current-buffer (if same-buffer (current-buffer) gnus-article-buffer) |
| 411 | (unless same-buffer | ||
| 412 | (set-buffer gnus-article-buffer)) | ||
| 413 | (gnus-cite-parse-maybe force) | 411 | (gnus-cite-parse-maybe force) |
| 414 | (let ((buffer-read-only nil) | 412 | (let ((buffer-read-only nil) |
| 415 | (alist gnus-cite-prefix-alist) | 413 | (alist gnus-cite-prefix-alist) |
| @@ -462,8 +460,7 @@ Lines matching `gnus-cite-attribution-suffix' and perhaps | |||
| 462 | 460 | ||
| 463 | (defun gnus-dissect-cited-text () | 461 | (defun gnus-dissect-cited-text () |
| 464 | "Dissect the article buffer looking for cited text." | 462 | "Dissect the article buffer looking for cited text." |
| 465 | (save-excursion | 463 | (with-current-buffer gnus-article-buffer |
| 466 | (set-buffer gnus-article-buffer) | ||
| 467 | (gnus-cite-parse-maybe nil t) | 464 | (gnus-cite-parse-maybe nil t) |
| 468 | (let ((alist gnus-cite-prefix-alist) | 465 | (let ((alist gnus-cite-prefix-alist) |
| 469 | prefix numbers number marks m) | 466 | prefix numbers number marks m) |
| @@ -523,8 +520,7 @@ Lines matching `gnus-cite-attribution-suffix' and perhaps | |||
| 523 | "Do word wrapping in the current article. | 520 | "Do word wrapping in the current article. |
| 524 | If WIDTH (the numerical prefix), use that text width when filling." | 521 | If WIDTH (the numerical prefix), use that text width when filling." |
| 525 | (interactive (list t current-prefix-arg)) | 522 | (interactive (list t current-prefix-arg)) |
| 526 | (save-excursion | 523 | (with-current-buffer gnus-article-buffer |
| 527 | (set-buffer gnus-article-buffer) | ||
| 528 | (let ((buffer-read-only nil) | 524 | (let ((buffer-read-only nil) |
| 529 | (inhibit-point-motion-hooks t) | 525 | (inhibit-point-motion-hooks t) |
| 530 | (marks (gnus-dissect-cited-text)) | 526 | (marks (gnus-dissect-cited-text)) |
| @@ -578,67 +574,66 @@ always hide." | |||
| 578 | (interactive (append (gnus-article-hidden-arg) (list 'force))) | 574 | (interactive (append (gnus-article-hidden-arg) (list 'force))) |
| 579 | (gnus-set-format 'cited-opened-text-button t) | 575 | (gnus-set-format 'cited-opened-text-button t) |
| 580 | (gnus-set-format 'cited-closed-text-button t) | 576 | (gnus-set-format 'cited-closed-text-button t) |
| 581 | (save-excursion | 577 | (with-current-buffer gnus-article-buffer |
| 582 | (set-buffer gnus-article-buffer) | 578 | (let ((buffer-read-only nil) |
| 583 | (let ((buffer-read-only nil) | 579 | marks |
| 584 | marks | 580 | (inhibit-point-motion-hooks t) |
| 585 | (inhibit-point-motion-hooks t) | 581 | (props (nconc (list 'article-type 'cite) |
| 586 | (props (nconc (list 'article-type 'cite) | 582 | gnus-hidden-properties)) |
| 587 | gnus-hidden-properties)) | 583 | (point (point-min)) |
| 588 | (point (point-min)) | 584 | found beg end start) |
| 589 | found beg end start) | 585 | (while (setq point |
| 590 | (while (setq point | 586 | (text-property-any point (point-max) |
| 591 | (text-property-any point (point-max) | 587 | 'gnus-callback |
| 592 | 'gnus-callback | 588 | 'gnus-article-toggle-cited-text)) |
| 593 | 'gnus-article-toggle-cited-text)) | 589 | (setq found t) |
| 594 | (setq found t) | 590 | (goto-char point) |
| 595 | (goto-char point) | 591 | (gnus-article-toggle-cited-text |
| 596 | (gnus-article-toggle-cited-text | 592 | (get-text-property point 'gnus-data) arg) |
| 597 | (get-text-property point 'gnus-data) arg) | 593 | (forward-line 1) |
| 598 | (forward-line 1) | 594 | (setq point (point))) |
| 599 | (setq point (point))) | 595 | (unless found |
| 600 | (unless found | 596 | (setq marks (gnus-dissect-cited-text)) |
| 601 | (setq marks (gnus-dissect-cited-text)) | 597 | (while marks |
| 602 | (while marks | 598 | (setq beg nil |
| 603 | (setq beg nil | 599 | end nil) |
| 604 | end nil) | 600 | (while (and marks (string= (cdar marks) "")) |
| 605 | (while (and marks (string= (cdar marks) "")) | 601 | (setq marks (cdr marks))) |
| 606 | (setq marks (cdr marks))) | 602 | (when marks |
| 607 | (when marks | 603 | (setq beg (caar marks))) |
| 608 | (setq beg (caar marks))) | 604 | (while (and marks (not (string= (cdar marks) ""))) |
| 609 | (while (and marks (not (string= (cdar marks) ""))) | 605 | (setq marks (cdr marks))) |
| 610 | (setq marks (cdr marks))) | 606 | (when marks |
| 611 | (when marks | ||
| 612 | (setq end (caar marks))) | 607 | (setq end (caar marks))) |
| 613 | ;; Skip past lines we want to leave visible. | 608 | ;; Skip past lines we want to leave visible. |
| 614 | (when (and beg end gnus-cited-lines-visible) | 609 | (when (and beg end gnus-cited-lines-visible) |
| 615 | (goto-char beg) | 610 | (goto-char beg) |
| 616 | (forward-line (if (consp gnus-cited-lines-visible) | 611 | (forward-line (if (consp gnus-cited-lines-visible) |
| 617 | (car gnus-cited-lines-visible) | 612 | (car gnus-cited-lines-visible) |
| 618 | gnus-cited-lines-visible)) | 613 | gnus-cited-lines-visible)) |
| 619 | (if (>= (point) end) | 614 | (if (>= (point) end) |
| 620 | (setq beg nil) | 615 | (setq beg nil) |
| 621 | (setq beg (point-marker)) | 616 | (setq beg (point-marker)) |
| 622 | (when (consp gnus-cited-lines-visible) | 617 | (when (consp gnus-cited-lines-visible) |
| 623 | (goto-char end) | 618 | (goto-char end) |
| 624 | (forward-line (- (cdr gnus-cited-lines-visible))) | 619 | (forward-line (- (cdr gnus-cited-lines-visible))) |
| 625 | (if (<= (point) beg) | 620 | (if (<= (point) beg) |
| 626 | (setq beg nil) | 621 | (setq beg nil) |
| 627 | (setq end (point-marker)))))) | 622 | (setq end (point-marker)))))) |
| 628 | (when (and beg end) | 623 | (when (and beg end) |
| 629 | (gnus-add-wash-type 'cite) | 624 | (gnus-add-wash-type 'cite) |
| 630 | ;; We use markers for the end-points to facilitate later | 625 | ;; We use markers for the end-points to facilitate later |
| 631 | ;; wrapping and mangling of text. | 626 | ;; wrapping and mangling of text. |
| 632 | (setq beg (set-marker (make-marker) beg) | 627 | (setq beg (set-marker (make-marker) beg) |
| 633 | end (set-marker (make-marker) end)) | 628 | end (set-marker (make-marker) end)) |
| 634 | (gnus-add-text-properties-when 'article-type nil beg end props) | 629 | (gnus-add-text-properties-when 'article-type nil beg end props) |
| 635 | (goto-char beg) | 630 | (goto-char beg) |
| 636 | (when (and gnus-cite-blank-line-after-header | 631 | (when (and gnus-cite-blank-line-after-header |
| 637 | (not (save-excursion (search-backward "\n\n" nil t)))) | 632 | (not (save-excursion (search-backward "\n\n" nil t)))) |
| 638 | (insert "\n")) | 633 | (insert "\n")) |
| 639 | (put-text-property | 634 | (put-text-property |
| 640 | (setq start (point-marker)) | 635 | (setq start (point-marker)) |
| 641 | (progn | 636 | (progn |
| 642 | (gnus-article-add-button | 637 | (gnus-article-add-button |
| 643 | (point) | 638 | (point) |
| 644 | (progn (eval gnus-cited-closed-text-button-line-format-spec) | 639 | (progn (eval gnus-cited-closed-text-button-line-format-spec) |
| @@ -646,8 +641,8 @@ always hide." | |||
| 646 | `gnus-article-toggle-cited-text | 641 | `gnus-article-toggle-cited-text |
| 647 | (list (cons beg end) start)) | 642 | (list (cons beg end) start)) |
| 648 | (point)) | 643 | (point)) |
| 649 | 'article-type 'annotation) | 644 | 'article-type 'annotation) |
| 650 | (set-marker beg (point)))))))) | 645 | (set-marker beg (point)))))))) |
| 651 | 646 | ||
| 652 | (defun gnus-article-toggle-cited-text (args &optional arg) | 647 | (defun gnus-article-toggle-cited-text (args &optional arg) |
| 653 | "Toggle hiding the text in REGION. | 648 | "Toggle hiding the text in REGION. |
| @@ -750,11 +745,9 @@ See also the documentation for `gnus-article-highlight-citation'." | |||
| 750 | (defun gnus-article-hide-citation-in-followups () | 745 | (defun gnus-article-hide-citation-in-followups () |
| 751 | "Hide cited text in non-root articles." | 746 | "Hide cited text in non-root articles." |
| 752 | (interactive) | 747 | (interactive) |
| 753 | (save-excursion | 748 | (with-current-buffer gnus-article-buffer |
| 754 | (set-buffer gnus-article-buffer) | ||
| 755 | (let ((article (cdr gnus-article-current))) | 749 | (let ((article (cdr gnus-article-current))) |
| 756 | (unless (save-excursion | 750 | (unless (with-current-buffer gnus-summary-buffer |
| 757 | (set-buffer gnus-summary-buffer) | ||
| 758 | (gnus-article-displayed-root-p article)) | 751 | (gnus-article-displayed-root-p article)) |
| 759 | (gnus-article-hide-citation))))) | 752 | (gnus-article-hide-citation))))) |
| 760 | 753 | ||
| @@ -1097,8 +1090,7 @@ See also the documentation for `gnus-article-highlight-citation'." | |||
| 1097 | (gnus-overlay-put overlay 'face face)))))) | 1090 | (gnus-overlay-put overlay 'face face)))))) |
| 1098 | 1091 | ||
| 1099 | (defun gnus-cite-toggle (prefix) | 1092 | (defun gnus-cite-toggle (prefix) |
| 1100 | (save-excursion | 1093 | (with-current-buffer gnus-article-buffer |
| 1101 | (set-buffer gnus-article-buffer) | ||
| 1102 | (gnus-cite-parse-maybe nil t) | 1094 | (gnus-cite-parse-maybe nil t) |
| 1103 | (let ((buffer-read-only nil) | 1095 | (let ((buffer-read-only nil) |
| 1104 | (numbers (cdr (assoc prefix gnus-cite-prefix-alist))) | 1096 | (numbers (cdr (assoc prefix gnus-cite-prefix-alist))) |
diff --git a/lisp/gnus/gnus-ems.el b/lisp/gnus/gnus-ems.el index 32b126a2713..155741231ab 100644 --- a/lisp/gnus/gnus-ems.el +++ b/lisp/gnus/gnus-ems.el | |||
| @@ -305,26 +305,39 @@ | |||
| 305 | (setq start end | 305 | (setq start end |
| 306 | end nil)))))) | 306 | end nil)))))) |
| 307 | 307 | ||
| 308 | (if (fboundp 'set-process-plist) | 308 | (eval-and-compile |
| 309 | (progn | 309 | (if (fboundp 'set-process-plist) |
| 310 | (defalias 'gnus-set-process-plist 'set-process-plist) | 310 | (progn |
| 311 | (defalias 'gnus-process-plist 'process-plist)) | 311 | (defalias 'gnus-set-process-plist 'set-process-plist) |
| 312 | (defun gnus-set-process-plist (process plist) | 312 | (defalias 'gnus-process-plist 'process-plist) |
| 313 | "Replace the plist of PROCESS with PLIST. Returns PLIST." | 313 | (defalias 'gnus-process-get 'process-get) |
| 314 | (put 'gnus-process-plist process plist)) | 314 | (defalias 'gnus-process-put 'process-put)) |
| 315 | (defun gnus-process-plist (process) | 315 | (defun gnus-set-process-plist (process plist) |
| 316 | "Return the plist of PROCESS." | 316 | "Replace the plist of PROCESS with PLIST. Returns PLIST." |
| 317 | ;; Remove those of dead processes from `gnus-process-plist' | 317 | (put 'gnus-process-plist process plist)) |
| 318 | ;; to prevent it from growing. | 318 | (defun gnus-process-plist (process) |
| 319 | (let ((plist (symbol-plist 'gnus-process-plist)) | 319 | "Return the plist of PROCESS." |
| 320 | proc) | 320 | ;; Remove those of dead processes from `gnus-process-plist' |
| 321 | (while (setq proc (car plist)) | 321 | ;; to prevent it from growing. |
| 322 | (if (and (processp proc) | 322 | (let ((plist (symbol-plist 'gnus-process-plist)) |
| 323 | (memq (process-status proc) '(open run))) | 323 | proc) |
| 324 | (setq plist (cddr plist)) | 324 | (while (setq proc (car plist)) |
| 325 | (setcar plist (caddr plist)) | 325 | (if (and (processp proc) |
| 326 | (setcdr plist (or (cdddr plist) '(nil)))))) | 326 | (memq (process-status proc) '(open run))) |
| 327 | (get 'gnus-process-plist process))) | 327 | (setq plist (cddr plist)) |
| 328 | (setcar plist (caddr plist)) | ||
| 329 | (setcdr plist (or (cdddr plist) '(nil)))))) | ||
| 330 | (get 'gnus-process-plist process)) | ||
| 331 | (defun gnus-process-get (process propname) | ||
| 332 | "Return the value of PROCESS' PROPNAME property. | ||
| 333 | This is the last value stored with `(gnus-process-put PROCESS PROPNAME VALUE)'." | ||
| 334 | (plist-get (gnus-process-plist process) propname)) | ||
| 335 | (defun gnus-process-put (process propname value) | ||
| 336 | "Change PROCESS' PROPNAME property to VALUE. | ||
| 337 | It can be retrieved with `(gnus-process-get PROCESS PROPNAME)'." | ||
| 338 | (gnus-set-process-plist process | ||
| 339 | (plist-put (gnus-process-plist process) | ||
| 340 | propname value))))) | ||
| 328 | 341 | ||
| 329 | (provide 'gnus-ems) | 342 | (provide 'gnus-ems) |
| 330 | 343 | ||
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index e4758fadb85..b59407d1302 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el | |||
| @@ -660,7 +660,6 @@ simple manner.") | |||
| 660 | "h" gnus-group-make-help-group | 660 | "h" gnus-group-make-help-group |
| 661 | "u" gnus-group-make-useful-group | 661 | "u" gnus-group-make-useful-group |
| 662 | "a" gnus-group-make-archive-group | 662 | "a" gnus-group-make-archive-group |
| 663 | "k" gnus-group-make-kiboze-group | ||
| 664 | "l" gnus-group-nnimap-edit-acl | 663 | "l" gnus-group-nnimap-edit-acl |
| 665 | "m" gnus-group-make-group | 664 | "m" gnus-group-make-group |
| 666 | "E" gnus-group-edit-group | 665 | "E" gnus-group-edit-group |
| @@ -931,7 +930,6 @@ simple manner.") | |||
| 931 | ["Add the archive group" gnus-group-make-archive-group t] | 930 | ["Add the archive group" gnus-group-make-archive-group t] |
| 932 | ["Make a doc group..." gnus-group-make-doc-group t] | 931 | ["Make a doc group..." gnus-group-make-doc-group t] |
| 933 | ["Make a web group..." gnus-group-make-web-group t] | 932 | ["Make a web group..." gnus-group-make-web-group t] |
| 934 | ["Make a kiboze group..." gnus-group-make-kiboze-group t] | ||
| 935 | ["Make a virtual group..." gnus-group-make-empty-virtual t] | 933 | ["Make a virtual group..." gnus-group-make-empty-virtual t] |
| 936 | ["Add a group to a virtual..." gnus-group-add-to-virtual t] | 934 | ["Add a group to a virtual..." gnus-group-add-to-virtual t] |
| 937 | ["Make an ephemeral group..." gnus-group-read-ephemeral-group t] | 935 | ["Make an ephemeral group..." gnus-group-read-ephemeral-group t] |
| @@ -982,7 +980,6 @@ simple manner.") | |||
| 982 | ["Browse foreign server..." gnus-group-browse-foreign-server t] | 980 | ["Browse foreign server..." gnus-group-browse-foreign-server t] |
| 983 | ["Enter server buffer" gnus-group-enter-server-mode t] | 981 | ["Enter server buffer" gnus-group-enter-server-mode t] |
| 984 | ["Expire all expirable articles" gnus-group-expire-all-groups t] | 982 | ["Expire all expirable articles" gnus-group-expire-all-groups t] |
| 985 | ["Generate any kiboze groups" nnkiboze-generate-groups t] | ||
| 986 | ["Gnus version" gnus-version t] | 983 | ["Gnus version" gnus-version t] |
| 987 | ["Save .newsrc files" gnus-group-save-newsrc t] | 984 | ["Save .newsrc files" gnus-group-save-newsrc t] |
| 988 | ["Suspend Gnus" gnus-group-suspend t] | 985 | ["Suspend Gnus" gnus-group-suspend t] |
| @@ -1691,72 +1688,66 @@ if it is a string, only list groups matching REGEXP." | |||
| 1691 | "Update all lines where GROUP appear. | 1688 | "Update all lines where GROUP appear. |
| 1692 | If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't | 1689 | If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't |
| 1693 | already." | 1690 | already." |
| 1694 | ;; Can't use `save-excursion' here, so we do it manually. | 1691 | (with-current-buffer gnus-group-buffer |
| 1695 | (let ((buf (current-buffer)) | 1692 | (save-excursion |
| 1696 | mark) | 1693 | ;; The buffer may be narrowed. |
| 1697 | (set-buffer gnus-group-buffer) | 1694 | (save-restriction |
| 1698 | (setq mark (point-marker)) | 1695 | (widen) |
| 1699 | ;; The buffer may be narrowed. | 1696 | (let ((ident (gnus-intern-safe group gnus-active-hashtb)) |
| 1700 | (save-restriction | 1697 | (loc (point-min)) |
| 1701 | (widen) | 1698 | found buffer-read-only) |
| 1702 | (let ((ident (gnus-intern-safe group gnus-active-hashtb)) | 1699 | ;; Enter the current status into the dribble buffer. |
| 1703 | (loc (point-min)) | 1700 | (let ((entry (gnus-group-entry group))) |
| 1704 | found buffer-read-only) | 1701 | (when (and entry |
| 1705 | ;; Enter the current status into the dribble buffer. | 1702 | (not (gnus-ephemeral-group-p group))) |
| 1706 | (let ((entry (gnus-group-entry group))) | 1703 | (gnus-dribble-enter |
| 1707 | (when (and entry | 1704 | (concat "(gnus-group-set-info '" |
| 1708 | (not (gnus-ephemeral-group-p group))) | 1705 | (gnus-prin1-to-string (nth 2 entry)) |
| 1709 | (gnus-dribble-enter | 1706 | ")")))) |
| 1710 | (concat "(gnus-group-set-info '" | 1707 | ;; Find all group instances. If topics are in use, each group |
| 1711 | (gnus-prin1-to-string (nth 2 entry)) | 1708 | ;; may be listed in more than once. |
| 1712 | ")")))) | 1709 | (while (setq loc (text-property-any |
| 1713 | ;; Find all group instances. If topics are in use, each group | 1710 | loc (point-max) 'gnus-group ident)) |
| 1714 | ;; may be listed in more than once. | 1711 | (setq found t) |
| 1715 | (while (setq loc (text-property-any | 1712 | (goto-char loc) |
| 1716 | loc (point-max) 'gnus-group ident)) | 1713 | (let ((gnus-group-indentation (gnus-group-group-indentation))) |
| 1717 | (setq found t) | 1714 | (gnus-delete-line) |
| 1718 | (goto-char loc) | 1715 | (gnus-group-insert-group-line-info group) |
| 1719 | (let ((gnus-group-indentation (gnus-group-group-indentation))) | 1716 | (save-excursion |
| 1720 | (gnus-delete-line) | 1717 | (forward-line -1) |
| 1721 | (gnus-group-insert-group-line-info group) | 1718 | (gnus-run-hooks 'gnus-group-update-group-hook))) |
| 1722 | (save-excursion | 1719 | (setq loc (1+ loc))) |
| 1723 | (forward-line -1) | 1720 | (unless (or found visible-only) |
| 1724 | (gnus-run-hooks 'gnus-group-update-group-hook))) | 1721 | ;; No such line in the buffer, find out where it's supposed to |
| 1725 | (setq loc (1+ loc))) | 1722 | ;; go, and insert it there (or at the end of the buffer). |
| 1726 | (unless (or found visible-only) | 1723 | (if gnus-goto-missing-group-function |
| 1727 | ;; No such line in the buffer, find out where it's supposed to | 1724 | (funcall gnus-goto-missing-group-function group) |
| 1728 | ;; go, and insert it there (or at the end of the buffer). | 1725 | (let ((entry (cddr (gnus-group-entry group)))) |
| 1729 | (if gnus-goto-missing-group-function | 1726 | (while (and entry (car entry) |
| 1730 | (funcall gnus-goto-missing-group-function group) | 1727 | (not |
| 1731 | (let ((entry (cddr (gnus-group-entry group)))) | 1728 | (gnus-goto-char |
| 1732 | (while (and entry (car entry) | 1729 | (text-property-any |
| 1733 | (not | 1730 | (point-min) (point-max) |
| 1734 | (gnus-goto-char | 1731 | 'gnus-group (gnus-intern-safe |
| 1735 | (text-property-any | 1732 | (caar entry) |
| 1736 | (point-min) (point-max) | 1733 | gnus-active-hashtb))))) |
| 1737 | 'gnus-group (gnus-intern-safe | 1734 | (setq entry (cdr entry))) |
| 1738 | (caar entry) gnus-active-hashtb))))) | 1735 | (or entry (goto-char (point-max))))) |
| 1739 | (setq entry (cdr entry))) | 1736 | ;; Finally insert the line. |
| 1740 | (or entry (goto-char (point-max))))) | 1737 | (let ((gnus-group-indentation (gnus-group-group-indentation))) |
| 1741 | ;; Finally insert the line. | 1738 | (gnus-group-insert-group-line-info group) |
| 1742 | (let ((gnus-group-indentation (gnus-group-group-indentation))) | 1739 | (save-excursion |
| 1743 | (gnus-group-insert-group-line-info group) | 1740 | (forward-line -1) |
| 1744 | (save-excursion | 1741 | (gnus-run-hooks 'gnus-group-update-group-hook)))) |
| 1745 | (forward-line -1) | 1742 | (when gnus-group-update-group-function |
| 1746 | (gnus-run-hooks 'gnus-group-update-group-hook)))) | 1743 | (funcall gnus-group-update-group-function group)) |
| 1747 | (when gnus-group-update-group-function | 1744 | (gnus-group-set-mode-line)))))) |
| 1748 | (funcall gnus-group-update-group-function group)) | ||
| 1749 | (gnus-group-set-mode-line))) | ||
| 1750 | (goto-char mark) | ||
| 1751 | (set-marker mark nil) | ||
| 1752 | (set-buffer buf))) | ||
| 1753 | 1745 | ||
| 1754 | (defun gnus-group-set-mode-line () | 1746 | (defun gnus-group-set-mode-line () |
| 1755 | "Update the mode line in the group buffer." | 1747 | "Update the mode line in the group buffer." |
| 1756 | (when (memq 'group gnus-updated-mode-lines) | 1748 | (when (memq 'group gnus-updated-mode-lines) |
| 1757 | ;; Yes, we want to keep this mode line updated. | 1749 | ;; Yes, we want to keep this mode line updated. |
| 1758 | (save-excursion | 1750 | (with-current-buffer gnus-group-buffer |
| 1759 | (set-buffer gnus-group-buffer) | ||
| 1760 | (let* ((gformat (or gnus-group-mode-line-format-spec | 1751 | (let* ((gformat (or gnus-group-mode-line-format-spec |
| 1761 | (gnus-set-format 'group-mode))) | 1752 | (gnus-set-format 'group-mode))) |
| 1762 | (gnus-tmp-news-server (cadr gnus-select-method)) | 1753 | (gnus-tmp-news-server (cadr gnus-select-method)) |
| @@ -1769,8 +1760,7 @@ already." | |||
| 1769 | (and gnus-dribble-buffer | 1760 | (and gnus-dribble-buffer |
| 1770 | (buffer-name gnus-dribble-buffer) | 1761 | (buffer-name gnus-dribble-buffer) |
| 1771 | (buffer-modified-p gnus-dribble-buffer) | 1762 | (buffer-modified-p gnus-dribble-buffer) |
| 1772 | (save-excursion | 1763 | (with-current-buffer gnus-dribble-buffer |
| 1773 | (set-buffer gnus-dribble-buffer) | ||
| 1774 | (not (zerop (buffer-size)))))) | 1764 | (not (zerop (buffer-size)))))) |
| 1775 | (mode-string (eval gformat))) | 1765 | (mode-string (eval gformat))) |
| 1776 | ;; Say whether the dribble buffer has been modified. | 1766 | ;; Say whether the dribble buffer has been modified. |
| @@ -3123,41 +3113,6 @@ mail messages or news articles in files that have numeric names." | |||
| 3123 | (gnus-group-real-name group) | 3113 | (gnus-group-real-name group) |
| 3124 | (list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir))))) | 3114 | (list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir))))) |
| 3125 | 3115 | ||
| 3126 | (defvar nnkiboze-score-file) | ||
| 3127 | (declare-function nnkiboze-score-file "nnkiboze" (group)) | ||
| 3128 | |||
| 3129 | (defun gnus-group-make-kiboze-group (group address scores) | ||
| 3130 | "Create an nnkiboze group. | ||
| 3131 | The user will be prompted for a name, a regexp to match groups, and | ||
| 3132 | score file entries for articles to include in the group." | ||
| 3133 | (interactive | ||
| 3134 | (list | ||
| 3135 | (read-string "nnkiboze group name: ") | ||
| 3136 | (read-string "Source groups (regexp): ") | ||
| 3137 | (let ((headers (mapcar 'list | ||
| 3138 | '("subject" "from" "number" "date" "message-id" | ||
| 3139 | "references" "chars" "lines" "xref" | ||
| 3140 | "followup" "all" "body" "head"))) | ||
| 3141 | scores header regexp regexps) | ||
| 3142 | (while (not (equal "" (setq header (completing-read | ||
| 3143 | "Match on header: " headers nil t)))) | ||
| 3144 | (setq regexps nil) | ||
| 3145 | (while (not (equal "" (setq regexp (read-string | ||
| 3146 | (format "Match on %s (regexp): " | ||
| 3147 | header))))) | ||
| 3148 | (push (list regexp nil nil 'r) regexps)) | ||
| 3149 | (push (cons header regexps) scores)) | ||
| 3150 | scores))) | ||
| 3151 | (gnus-group-make-group group "nnkiboze" address) | ||
| 3152 | (let* ((nnkiboze-current-group group) | ||
| 3153 | (score-file (car (nnkiboze-score-file ""))) | ||
| 3154 | (score-dir (file-name-directory score-file))) | ||
| 3155 | (unless (file-exists-p score-dir) | ||
| 3156 | (make-directory score-dir)) | ||
| 3157 | (with-temp-file score-file | ||
| 3158 | (let (emacs-lisp-mode-hook) | ||
| 3159 | (gnus-pp scores))))) | ||
| 3160 | |||
| 3161 | (defun gnus-group-add-to-virtual (n vgroup) | 3116 | (defun gnus-group-add-to-virtual (n vgroup) |
| 3162 | "Add the current group to a virtual group." | 3117 | "Add the current group to a virtual group." |
| 3163 | (interactive | 3118 | (interactive |
| @@ -4433,8 +4388,7 @@ The hook `gnus-exit-gnus-hook' is called before actually exiting." | |||
| 4433 | (gnus-run-hooks 'gnus-exit-gnus-hook) | 4388 | (gnus-run-hooks 'gnus-exit-gnus-hook) |
| 4434 | (gnus-configure-windows 'group t) | 4389 | (gnus-configure-windows 'group t) |
| 4435 | (when (and (gnus-buffer-live-p gnus-dribble-buffer) | 4390 | (when (and (gnus-buffer-live-p gnus-dribble-buffer) |
| 4436 | (not (zerop (save-excursion | 4391 | (not (zerop (with-current-buffer gnus-dribble-buffer |
| 4437 | (set-buffer gnus-dribble-buffer) | ||
| 4438 | (buffer-size))))) | 4392 | (buffer-size))))) |
| 4439 | (gnus-dribble-enter | 4393 | (gnus-dribble-enter |
| 4440 | ";;; Gnus was exited on purpose without saving the .newsrc files.")) | 4394 | ";;; Gnus was exited on purpose without saving the .newsrc files.")) |
| @@ -4495,13 +4449,11 @@ and the second element is the address." | |||
| 4495 | (setcar (nthcdr (1- total) info) part-info))) | 4449 | (setcar (nthcdr (1- total) info) part-info))) |
| 4496 | (unless entry | 4450 | (unless entry |
| 4497 | ;; This is a new group, so we just create it. | 4451 | ;; This is a new group, so we just create it. |
| 4498 | (save-excursion | 4452 | (with-current-buffer gnus-group-buffer |
| 4499 | (set-buffer gnus-group-buffer) | ||
| 4500 | (setq method (gnus-info-method info)) | 4453 | (setq method (gnus-info-method info)) |
| 4501 | (when (gnus-server-equal method "native") | 4454 | (when (gnus-server-equal method "native") |
| 4502 | (setq method nil)) | 4455 | (setq method nil)) |
| 4503 | (save-excursion | 4456 | (with-current-buffer gnus-group-buffer |
| 4504 | (set-buffer gnus-group-buffer) | ||
| 4505 | (if method | 4457 | (if method |
| 4506 | ;; It's a foreign group... | 4458 | ;; It's a foreign group... |
| 4507 | (gnus-group-make-group | 4459 | (gnus-group-make-group |
| @@ -4565,8 +4517,7 @@ and the second element is the address." | |||
| 4565 | "Mark ARTICLE in GROUP with MARK, whether the group is displayed or not." | 4517 | "Mark ARTICLE in GROUP with MARK, whether the group is displayed or not." |
| 4566 | (let ((buffer (gnus-summary-buffer-name group))) | 4518 | (let ((buffer (gnus-summary-buffer-name group))) |
| 4567 | (if (gnus-buffer-live-p buffer) | 4519 | (if (gnus-buffer-live-p buffer) |
| 4568 | (save-excursion | 4520 | (with-current-buffer (get-buffer buffer) |
| 4569 | (set-buffer (get-buffer buffer)) | ||
| 4570 | (gnus-summary-add-mark article mark)) | 4521 | (gnus-summary-add-mark article mark)) |
| 4571 | (gnus-add-marked-articles group (cdr (assq mark gnus-article-mark-lists)) | 4522 | (gnus-add-marked-articles group (cdr (assq mark gnus-article-mark-lists)) |
| 4572 | (list article))))) | 4523 | (list article))))) |
diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el index 576d8835dcc..9acbfa3915d 100644 --- a/lisp/gnus/gnus-html.el +++ b/lisp/gnus/gnus-html.el | |||
| @@ -34,24 +34,38 @@ | |||
| 34 | 34 | ||
| 35 | (defcustom gnus-html-cache-directory (nnheader-concat gnus-directory "html-cache/") | 35 | (defcustom gnus-html-cache-directory (nnheader-concat gnus-directory "html-cache/") |
| 36 | "Where Gnus will cache images it downloads from the web." | 36 | "Where Gnus will cache images it downloads from the web." |
| 37 | :version "24.1" | ||
| 37 | :group 'gnus-art | 38 | :group 'gnus-art |
| 38 | :type 'directory) | 39 | :type 'directory) |
| 39 | 40 | ||
| 40 | (defcustom gnus-html-cache-size 500000000 | 41 | (defcustom gnus-html-cache-size 500000000 |
| 41 | "The size of the Gnus image cache." | 42 | "The size of the Gnus image cache." |
| 43 | :version "24.1" | ||
| 42 | :group 'gnus-art | 44 | :group 'gnus-art |
| 43 | :type 'integer) | 45 | :type 'integer) |
| 44 | 46 | ||
| 45 | (defcustom gnus-html-frame-width 70 | 47 | (defcustom gnus-html-frame-width 70 |
| 46 | "What width to use when rendering HTML." | 48 | "What width to use when rendering HTML." |
| 49 | :version "24.1" | ||
| 47 | :group 'gnus-art | 50 | :group 'gnus-art |
| 48 | :type 'integer) | 51 | :type 'integer) |
| 49 | 52 | ||
| 50 | (defcustom gnus-blocked-images "." | 53 | (defcustom gnus-blocked-images "." |
| 51 | "Images that have URLs matching this regexp will be blocked." | 54 | "Images that have URLs matching this regexp will be blocked." |
| 55 | :version "24.1" | ||
| 52 | :group 'gnus-art | 56 | :group 'gnus-art |
| 53 | :type 'regexp) | 57 | :type 'regexp) |
| 54 | 58 | ||
| 59 | (defcustom gnus-max-image-proportion 0.7 | ||
| 60 | "How big pictures displayed are in relation to the window they're in. | ||
| 61 | A value of 0.7 means that they are allowed to take up 70% of the | ||
| 62 | width and height of the window. If they are larger than this, | ||
| 63 | and Emacs supports it, then the images will be rescaled down to | ||
| 64 | fit these criteria." | ||
| 65 | :version "24.1" | ||
| 66 | :group 'gnus-art | ||
| 67 | :type 'float) | ||
| 68 | |||
| 55 | ;;;###autoload | 69 | ;;;###autoload |
| 56 | (defun gnus-article-html (handle) | 70 | (defun gnus-article-html (handle) |
| 57 | (let ((article-buffer (current-buffer))) | 71 | (let ((article-buffer (current-buffer))) |
| @@ -62,7 +76,13 @@ | |||
| 62 | (let* ((coding-system-for-read 'utf-8) | 76 | (let* ((coding-system-for-read 'utf-8) |
| 63 | (coding-system-for-write 'utf-8) | 77 | (coding-system-for-write 'utf-8) |
| 64 | (default-process-coding-system | 78 | (default-process-coding-system |
| 65 | (cons coding-system-for-read coding-system-for-write))) | 79 | (cons coding-system-for-read coding-system-for-write)) |
| 80 | (charset (mail-content-type-get (mm-handle-type handle) | ||
| 81 | 'charset))) | ||
| 82 | (when (and charset | ||
| 83 | (setq charset (mm-charset-to-coding-system charset)) | ||
| 84 | (not (eq charset 'ascii))) | ||
| 85 | (mm-decode-coding-region (point-min) (point-max) charset)) | ||
| 66 | (call-process-region (point-min) (point-max) | 86 | (call-process-region (point-min) (point-max) |
| 67 | "w3m" | 87 | "w3m" |
| 68 | nil article-buffer nil | 88 | nil article-buffer nil |
| @@ -97,8 +117,9 @@ | |||
| 97 | (cond | 117 | (cond |
| 98 | ;; Fetch and insert a picture. | 118 | ;; Fetch and insert a picture. |
| 99 | ((equal tag "img_alt") | 119 | ((equal tag "img_alt") |
| 100 | (when (string-match "src=\"\\([^\"]+\\)" parameters) | 120 | (when (string-match "src=\"\\([^\"]+\\)" parameters) |
| 101 | (setq url (match-string 1 parameters)) | 121 | (setq url (match-string 1 parameters)) |
| 122 | (gnus-message 8 "Fetching image URL %s" url) | ||
| 102 | (if (string-match "^cid:\\(.*\\)" url) | 123 | (if (string-match "^cid:\\(.*\\)" url) |
| 103 | ;; URLs with cid: have their content stashed in other | 124 | ;; URLs with cid: have their content stashed in other |
| 104 | ;; parts of the MIME structure, so just insert them | 125 | ;; parts of the MIME structure, so just insert them |
| @@ -111,17 +132,18 @@ | |||
| 111 | (setq image (gnus-create-image (buffer-string) | 132 | (setq image (gnus-create-image (buffer-string) |
| 112 | nil t)))) | 133 | nil t)))) |
| 113 | (when image | 134 | (when image |
| 114 | (delete-region start end) | 135 | (let ((string (buffer-substring start end))) |
| 115 | (gnus-put-image image))) | 136 | (delete-region start end) |
| 137 | (gnus-put-image image (gnus-string-or string "*"))))) | ||
| 116 | ;; Normal, external URL. | 138 | ;; Normal, external URL. |
| 117 | (when (or (null gnus-blocked-images) | 139 | (unless (gnus-html-image-url-blocked-p url) |
| 118 | (not (string-match gnus-blocked-images url))) | ||
| 119 | (let ((file (gnus-html-image-id url))) | 140 | (let ((file (gnus-html-image-id url))) |
| 120 | (if (file-exists-p file) | 141 | (if (file-exists-p file) |
| 121 | ;; It's already cached, so just insert it. | 142 | ;; It's already cached, so just insert it. |
| 122 | (when (gnus-html-put-image file (point)) | 143 | (let ((string (buffer-substring start end))) |
| 123 | ;; Delete the ALT text. | 144 | ;; Delete the ALT text. |
| 124 | (delete-region start end)) | 145 | (delete-region start end) |
| 146 | (gnus-html-put-image file (point) string)) | ||
| 125 | ;; We don't have it, so schedule it for fetching | 147 | ;; We don't have it, so schedule it for fetching |
| 126 | ;; asynchronously. | 148 | ;; asynchronously. |
| 127 | (push (list url | 149 | (push (list url |
| @@ -132,6 +154,7 @@ | |||
| 132 | ((equal tag "a") | 154 | ((equal tag "a") |
| 133 | (when (string-match "href=\"\\([^\"]+\\)" parameters) | 155 | (when (string-match "href=\"\\([^\"]+\\)" parameters) |
| 134 | (setq url (match-string 1 parameters)) | 156 | (setq url (match-string 1 parameters)) |
| 157 | (gnus-message 8 "Fetching link URL %s" url) | ||
| 135 | (gnus-article-add-button start end | 158 | (gnus-article-add-button start end |
| 136 | 'browse-url url | 159 | 'browse-url url |
| 137 | url) | 160 | url) |
| @@ -140,6 +163,10 @@ | |||
| 140 | (gnus-overlay-put overlay 'gnus-button-url url) | 163 | (gnus-overlay-put overlay 'gnus-button-url url) |
| 141 | (when gnus-article-mouse-face | 164 | (when gnus-article-mouse-face |
| 142 | (gnus-overlay-put overlay 'mouse-face gnus-article-mouse-face))))) | 165 | (gnus-overlay-put overlay 'mouse-face gnus-article-mouse-face))))) |
| 166 | ;; The upper-case IMG_ALT is apparently just an artifact that | ||
| 167 | ;; should be deleted. | ||
| 168 | ((equal tag "IMG_ALT") | ||
| 169 | (delete-region start end)) | ||
| 143 | ;; Whatever. Just ignore the tag. | 170 | ;; Whatever. Just ignore the tag. |
| 144 | (t | 171 | (t |
| 145 | )) | 172 | )) |
| @@ -153,6 +180,7 @@ | |||
| 153 | (gnus-html-schedule-image-fetching (current-buffer) (nreverse images))))) | 180 | (gnus-html-schedule-image-fetching (current-buffer) (nreverse images))))) |
| 154 | 181 | ||
| 155 | (defun gnus-html-schedule-image-fetching (buffer images) | 182 | (defun gnus-html-schedule-image-fetching (buffer images) |
| 183 | (gnus-message 8 "Scheduling image fetching in buffer %s, images %s" buffer images) | ||
| 156 | (let* ((url (caar images)) | 184 | (let* ((url (caar images)) |
| 157 | (process (start-process | 185 | (process (start-process |
| 158 | "images" nil "curl" | 186 | "images" nil "curl" |
| @@ -171,8 +199,8 @@ | |||
| 171 | 199 | ||
| 172 | (defun gnus-html-curl-sentinel (process event) | 200 | (defun gnus-html-curl-sentinel (process event) |
| 173 | (when (string-match "finished" event) | 201 | (when (string-match "finished" event) |
| 174 | (let* ((images (process-get process 'images)) | 202 | (let* ((images (gnus-process-get process 'images)) |
| 175 | (buffer (process-get process 'buffer)) | 203 | (buffer (gnus-process-get process 'buffer)) |
| 176 | (spec (pop images)) | 204 | (spec (pop images)) |
| 177 | (file (gnus-html-image-id (car spec)))) | 205 | (file (gnus-html-image-id (car spec)))) |
| 178 | (when (and (buffer-live-p buffer) | 206 | (when (and (buffer-live-p buffer) |
| @@ -182,13 +210,14 @@ | |||
| 182 | ;; article before the image arrived. | 210 | ;; article before the image arrived. |
| 183 | (not (= (marker-position (cadr spec)) (point-min)))) | 211 | (not (= (marker-position (cadr spec)) (point-min)))) |
| 184 | (with-current-buffer buffer | 212 | (with-current-buffer buffer |
| 185 | (let ((inhibit-read-only t)) | 213 | (let ((inhibit-read-only t) |
| 186 | (when (gnus-html-put-image file (cadr spec)) | 214 | (string (buffer-substring (cadr spec) (caddr spec)))) |
| 187 | (delete-region (1+ (cadr spec)) (caddr spec)))))) | 215 | (delete-region (cadr spec) (caddr spec)) |
| 216 | (gnus-html-put-image file (cadr spec) string)))) | ||
| 188 | (when images | 217 | (when images |
| 189 | (gnus-html-schedule-image-fetching buffer images))))) | 218 | (gnus-html-schedule-image-fetching buffer images))))) |
| 190 | 219 | ||
| 191 | (defun gnus-html-put-image (file point) | 220 | (defun gnus-html-put-image (file point string) |
| 192 | (when (display-graphic-p) | 221 | (when (display-graphic-p) |
| 193 | (let ((image (ignore-errors | 222 | (let ((image (ignore-errors |
| 194 | (gnus-create-image file)))) | 223 | (gnus-create-image file)))) |
| @@ -202,13 +231,40 @@ | |||
| 202 | (= (car (image-size image t)) 30) | 231 | (= (car (image-size image t)) 30) |
| 203 | (= (cdr (image-size image t)) 30)))) | 232 | (= (cdr (image-size image t)) 30)))) |
| 204 | (progn | 233 | (progn |
| 205 | (gnus-put-image image) | 234 | (gnus-put-image (gnus-html-rescale-image image) |
| 235 | (gnus-string-or string "*")) | ||
| 206 | t) | 236 | t) |
| 237 | (insert string) | ||
| 207 | (when (fboundp 'find-image) | 238 | (when (fboundp 'find-image) |
| 208 | (gnus-put-image (find-image | 239 | (gnus-put-image (find-image |
| 209 | '((:type xpm :file "lock-broken.xpm"))))) | 240 | '((:type xpm :file "lock-broken.xpm"))) |
| 241 | (gnus-string-or string "*"))) | ||
| 210 | nil))))) | 242 | nil))))) |
| 211 | 243 | ||
| 244 | (defun gnus-html-rescale-image (image) | ||
| 245 | (if (or (not (fboundp 'imagemagick-types)) | ||
| 246 | (not (get-buffer-window (current-buffer)))) | ||
| 247 | image | ||
| 248 | (let* ((width (car (image-size image t))) | ||
| 249 | (height (cdr (image-size image t))) | ||
| 250 | (edges (window-pixel-edges (get-buffer-window (current-buffer)))) | ||
| 251 | (window-width (truncate (* gnus-max-image-proportion | ||
| 252 | (- (nth 2 edges) (nth 0 edges))))) | ||
| 253 | (window-height (truncate (* gnus-max-image-proportion | ||
| 254 | (- (nth 3 edges) (nth 1 edges))))) | ||
| 255 | scaled-image) | ||
| 256 | (when (> width window-width) | ||
| 257 | (setq window-height (truncate (* window-height | ||
| 258 | (/ (* 1.0 window-width) width))))) | ||
| 259 | (or | ||
| 260 | (cond ((> height window-height) | ||
| 261 | (create-image file 'imagemagick nil | ||
| 262 | :height window-height)) | ||
| 263 | ((> width window-width) | ||
| 264 | (create-image file 'imagemagick nil | ||
| 265 | :width window-width))) | ||
| 266 | image)))) | ||
| 267 | |||
| 212 | (defun gnus-html-prune-cache () | 268 | (defun gnus-html-prune-cache () |
| 213 | (let ((total-size 0) | 269 | (let ((total-size 0) |
| 214 | files) | 270 | files) |
| @@ -227,6 +283,15 @@ | |||
| 227 | (decf total-size (cadr file)) | 283 | (decf total-size (cadr file)) |
| 228 | (delete-file (nth 2 file))))))) | 284 | (delete-file (nth 2 file))))))) |
| 229 | 285 | ||
| 286 | |||
| 287 | (defun gnus-html-image-url-blocked-p (url) | ||
| 288 | "Find out if URL is blocked by `gnus-blocked-images'." | ||
| 289 | (let ((ret (and gnus-blocked-images | ||
| 290 | (string-match gnus-blocked-images url)))) | ||
| 291 | (when ret | ||
| 292 | (gnus-message 8 "Image URL %s is blocked by gnus-blocked-images regex %s" url gnus-blocked-images)) | ||
| 293 | ret)) | ||
| 294 | |||
| 230 | ;;;###autoload | 295 | ;;;###autoload |
| 231 | (defun gnus-html-prefetch-images (summary) | 296 | (defun gnus-html-prefetch-images (summary) |
| 232 | (let (blocked-images urls) | 297 | (let (blocked-images urls) |
| @@ -236,12 +301,11 @@ | |||
| 236 | (save-match-data | 301 | (save-match-data |
| 237 | (while (re-search-forward "<img.*src=[\"']\\([^\"']+\\)" nil t) | 302 | (while (re-search-forward "<img.*src=[\"']\\([^\"']+\\)" nil t) |
| 238 | (let ((url (match-string 1))) | 303 | (let ((url (match-string 1))) |
| 239 | (when (or (null blocked-images) | 304 | (unless (gnus-html-image-url-blocked-p url) |
| 240 | (not (string-match blocked-images url))) | 305 | (unless (file-exists-p (gnus-html-image-id url)) |
| 241 | (unless (file-exists-p (gnus-html-image-id url)) | 306 | (push url urls) |
| 242 | (push url urls) | 307 | (push (gnus-html-image-id url) urls) |
| 243 | (push (gnus-html-image-id url) urls) | 308 | (push "-o" urls))))) |
| 244 | (push "-o" urls))))) | ||
| 245 | (let ((process | 309 | (let ((process |
| 246 | (apply 'start-process | 310 | (apply 'start-process |
| 247 | "images" nil "curl" | 311 | "images" nil "curl" |
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index cd0824f9891..5aae825119c 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el | |||
| @@ -663,7 +663,7 @@ string with the suggested prefix." | |||
| 663 | gnus-low-score-mark gnus-ancient-mark gnus-read-mark | 663 | gnus-low-score-mark gnus-ancient-mark gnus-read-mark |
| 664 | gnus-duplicate-mark) | 664 | gnus-duplicate-mark) |
| 665 | "*The list of marks converted into expiration if a group is auto-expirable." | 665 | "*The list of marks converted into expiration if a group is auto-expirable." |
| 666 | :version "21.1" | 666 | :version "24.1" |
| 667 | :group 'gnus-summary | 667 | :group 'gnus-summary |
| 668 | :type '(repeat character)) | 668 | :type '(repeat character)) |
| 669 | 669 | ||
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index dece8dccece..2ff86bf53d9 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el | |||
| @@ -1740,14 +1740,11 @@ slower." | |||
| 1740 | ("nneething" none address prompt-address physical-address) | 1740 | ("nneething" none address prompt-address physical-address) |
| 1741 | ("nndoc" none address prompt-address) | 1741 | ("nndoc" none address prompt-address) |
| 1742 | ("nnbabyl" mail address respool) | 1742 | ("nnbabyl" mail address respool) |
| 1743 | ("nnkiboze" post virtual) | ||
| 1744 | ("nndraft" post-mail) | 1743 | ("nndraft" post-mail) |
| 1745 | ("nnfolder" mail respool address) | 1744 | ("nnfolder" mail respool address) |
| 1746 | ("nngateway" post-mail address prompt-address physical-address) | 1745 | ("nngateway" post-mail address prompt-address physical-address) |
| 1747 | ("nnweb" none) | 1746 | ("nnweb" none) |
| 1748 | ("nnrss" none) | 1747 | ("nnrss" none) |
| 1749 | ("nnwfm" none) | ||
| 1750 | ("nnlistserv" none) | ||
| 1751 | ("nnagent" post-mail) | 1748 | ("nnagent" post-mail) |
| 1752 | ("nnimap" post-mail address prompt-address physical-address) | 1749 | ("nnimap" post-mail address prompt-address physical-address) |
| 1753 | ("nnmaildir" mail respool address) | 1750 | ("nnmaildir" mail respool address) |
| @@ -3289,12 +3286,12 @@ with a `subscribed' parameter." | |||
| 3289 | (defmacro gnus-string-or (&rest strings) | 3286 | (defmacro gnus-string-or (&rest strings) |
| 3290 | "Return the first element of STRINGS that is a non-blank string. | 3287 | "Return the first element of STRINGS that is a non-blank string. |
| 3291 | STRINGS will be evaluated in normal `or' order." | 3288 | STRINGS will be evaluated in normal `or' order." |
| 3292 | `(gnus-string-or-1 ',strings)) | 3289 | `(gnus-string-or-1 (list ,@strings))) |
| 3293 | 3290 | ||
| 3294 | (defun gnus-string-or-1 (strings) | 3291 | (defun gnus-string-or-1 (strings) |
| 3295 | (let (string) | 3292 | (let (string) |
| 3296 | (while strings | 3293 | (while strings |
| 3297 | (setq string (eval (pop strings))) | 3294 | (setq string (pop strings)) |
| 3298 | (if (string-match "^[ \t]*$" string) | 3295 | (if (string-match "^[ \t]*$" string) |
| 3299 | (setq string nil) | 3296 | (setq string nil) |
| 3300 | (setq strings nil))) | 3297 | (setq strings nil))) |
| @@ -3937,8 +3934,7 @@ If SYMBOL, return the value of that symbol in the group parameters. | |||
| 3937 | 3934 | ||
| 3938 | If you call this function inside a loop, consider using the faster | 3935 | If you call this function inside a loop, consider using the faster |
| 3939 | `gnus-group-fast-parameter' instead." | 3936 | `gnus-group-fast-parameter' instead." |
| 3940 | (save-excursion | 3937 | (with-current-buffer gnus-group-buffer |
| 3941 | (set-buffer gnus-group-buffer) | ||
| 3942 | (if symbol | 3938 | (if symbol |
| 3943 | (gnus-group-fast-parameter group symbol allow-list) | 3939 | (gnus-group-fast-parameter group symbol allow-list) |
| 3944 | (nconc | 3940 | (nconc |
| @@ -4097,8 +4093,7 @@ Returns the number of articles marked as read." | |||
| 4097 | (defun gnus-kill-save-kill-buffer () | 4093 | (defun gnus-kill-save-kill-buffer () |
| 4098 | (let ((file (gnus-newsgroup-kill-file gnus-newsgroup-name))) | 4094 | (let ((file (gnus-newsgroup-kill-file gnus-newsgroup-name))) |
| 4099 | (when (get-file-buffer file) | 4095 | (when (get-file-buffer file) |
| 4100 | (save-excursion | 4096 | (with-current-buffer (get-file-buffer file) |
| 4101 | (set-buffer (get-file-buffer file)) | ||
| 4102 | (when (buffer-modified-p) | 4097 | (when (buffer-modified-p) |
| 4103 | (save-buffer)) | 4098 | (save-buffer)) |
| 4104 | (kill-buffer (current-buffer)))))) | 4099 | (kill-buffer (current-buffer)))))) |
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 2e27daca90b..7a1653acca0 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el | |||
| @@ -252,6 +252,7 @@ included. Organization and User-Agent are optional." | |||
| 252 | (defcustom message-prune-recipient-rules nil | 252 | (defcustom message-prune-recipient-rules nil |
| 253 | "Rules for how to prune the list of recipients when doing wide replies. | 253 | "Rules for how to prune the list of recipients when doing wide replies. |
| 254 | This is a list of regexps and regexp matches." | 254 | This is a list of regexps and regexp matches." |
| 255 | :version "24.1" | ||
| 255 | :group 'message-mail | 256 | :group 'message-mail |
| 256 | :group 'message-headers | 257 | :group 'message-headers |
| 257 | :link '(custom-manual "(message)Wide Reply") | 258 | :link '(custom-manual "(message)Wide Reply") |
diff --git a/lisp/gnus/nndb.el b/lisp/gnus/nndb.el deleted file mode 100644 index 2ba7f2901a6..00000000000 --- a/lisp/gnus/nndb.el +++ /dev/null | |||
| @@ -1,325 +0,0 @@ | |||
| 1 | ;;; nndb.el --- nndb access for Gnus | ||
| 2 | |||
| 3 | ;; Copyright (C) 1997, 1998, 2000, 2002, 2003, 2004, 2005, 2006, 2007, | ||
| 4 | ;; 2008, 2009, 2010 Free Software Foundation, Inc. | ||
| 5 | |||
| 6 | ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> | ||
| 7 | ;; Kai Grossjohann <grossjohann@ls6.informatik.uni-dortmund.de> | ||
| 8 | ;; Joe Hildebrand <joe.hildebrand@ilg.com> | ||
| 9 | ;; David Blacka <davidb@rwhois.net> | ||
| 10 | ;; Keywords: news | ||
| 11 | |||
| 12 | ;; This file is part of GNU Emacs. | ||
| 13 | |||
| 14 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 15 | ;; it under the terms of the GNU General Public License as published by | ||
| 16 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 17 | ;; (at your option) any later version. | ||
| 18 | |||
| 19 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 20 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 21 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 22 | ;; GNU General Public License for more details. | ||
| 23 | |||
| 24 | ;; You should have received a copy of the GNU General Public License | ||
| 25 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | ||
| 26 | |||
| 27 | ;;; Commentary: | ||
| 28 | |||
| 29 | ;;; This was based upon Kai Grossjohan's shamessly snarfed code and | ||
| 30 | ;;; further modified by Joe Hildebrand. It has been updated for Red | ||
| 31 | ;;; Gnus. | ||
| 32 | |||
| 33 | ;; TODO: | ||
| 34 | ;; | ||
| 35 | ;; * Fix bug where server connection can be lost and impossible to regain | ||
| 36 | ;; This hasn't happened to me in a while; think it was fixed in Rgnus | ||
| 37 | ;; | ||
| 38 | ;; * make it handle different nndb servers seemlessly | ||
| 39 | ;; | ||
| 40 | ;; * Optimize expire if FORCE | ||
| 41 | ;; | ||
| 42 | ;; * Optimize move (only expire once) | ||
| 43 | ;; | ||
| 44 | ;; * Deal with add/deletion of groups | ||
| 45 | ;; | ||
| 46 | ;; * make the backend TOUCH an article when marked as expireable (will | ||
| 47 | ;; make article expire 'expiry' days after that moment). | ||
| 48 | |||
| 49 | ;;; Code: | ||
| 50 | |||
| 51 | ;; For Emacs < 22.2. | ||
| 52 | (eval-and-compile | ||
| 53 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) | ||
| 54 | |||
| 55 | ;;- | ||
| 56 | ;; Register nndb with known select methods. | ||
| 57 | |||
| 58 | (require 'gnus-start) | ||
| 59 | (unless (assoc "nndb" gnus-valid-select-methods) | ||
| 60 | (gnus-declare-backend "nndb" 'mail 'respool 'address 'prompt-address)) | ||
| 61 | |||
| 62 | (require 'nnmail) | ||
| 63 | (require 'nnheader) | ||
| 64 | (require 'nntp) | ||
| 65 | (eval-when-compile (require 'cl)) | ||
| 66 | |||
| 67 | ;; Declare nndb as derived from nntp | ||
| 68 | |||
| 69 | (nnoo-declare nndb nntp) | ||
| 70 | |||
| 71 | ;; Variables specific to nndb | ||
| 72 | |||
| 73 | ;;- currently not used but just in case... | ||
| 74 | (defvoo nndb-deliver-program "nndel" | ||
| 75 | "*The program used to put a message in an NNDB group.") | ||
| 76 | |||
| 77 | (defvoo nndb-server-side-expiry nil | ||
| 78 | "If t, expiry calculation will occur on the server side.") | ||
| 79 | |||
| 80 | (defvoo nndb-set-expire-date-on-mark nil | ||
| 81 | "If t, the expiry date for a given article will be set to the time | ||
| 82 | it was marked as expireable; otherwise the date will be the time the | ||
| 83 | article was posted to nndb") | ||
| 84 | |||
| 85 | ;; Variables copied from nntp | ||
| 86 | |||
| 87 | (defvoo nndb-server-opened-hook '(nntp-send-authinfo-from-file) | ||
| 88 | "Like nntp-server-opened-hook." | ||
| 89 | nntp-server-opened-hook) | ||
| 90 | |||
| 91 | (defvoo nndb-address "localhost" | ||
| 92 | "*The name of the NNDB server." | ||
| 93 | nntp-address) | ||
| 94 | |||
| 95 | (defvoo nndb-port-number 9000 | ||
| 96 | "*Port number to connect to." | ||
| 97 | nntp-port-number) | ||
| 98 | |||
| 99 | ;; change to 'news if you are actually using nndb for news | ||
| 100 | (defvoo nndb-article-type 'mail) | ||
| 101 | |||
| 102 | (defvoo nndb-status-string nil "" nntp-status-string) | ||
| 103 | |||
| 104 | |||
| 105 | |||
| 106 | (defconst nndb-version "nndb 0.7" | ||
| 107 | "Version numbers of this version of NNDB.") | ||
| 108 | |||
| 109 | |||
| 110 | ;;; Interface functions. | ||
| 111 | |||
| 112 | (nnoo-define-basics nndb) | ||
| 113 | |||
| 114 | ;;------------------------------------------------------------------ | ||
| 115 | |||
| 116 | ;; this function turns the lisp list into a string list. There is | ||
| 117 | ;; probably a more efficient way to do this. | ||
| 118 | (defun nndb-build-article-string (articles) | ||
| 119 | (let (art-string art) | ||
| 120 | (while articles | ||
| 121 | (setq art (pop articles)) | ||
| 122 | (setq art-string (concat art-string art " "))) | ||
| 123 | art-string)) | ||
| 124 | |||
| 125 | (defun nndb-build-expire-rest-list (total expire) | ||
| 126 | (let (art rest) | ||
| 127 | (while total | ||
| 128 | (setq art (pop total)) | ||
| 129 | (if (memq art expire) | ||
| 130 | () | ||
| 131 | (push art rest))) | ||
| 132 | rest)) | ||
| 133 | |||
| 134 | |||
| 135 | ;; | ||
| 136 | (deffoo nndb-request-type (group &optional article) | ||
| 137 | nndb-article-type) | ||
| 138 | |||
| 139 | ;; nndb-request-update-info does not exist and is not needed | ||
| 140 | |||
| 141 | ;; nndb-request-update-mark does not exist; it should be used to TOUCH | ||
| 142 | ;; articles as they are marked exipirable | ||
| 143 | (defun nndb-touch-article (group article) | ||
| 144 | (nntp-send-command nil "X-TOUCH" article)) | ||
| 145 | |||
| 146 | (deffoo nndb-request-update-mark | ||
| 147 | (group article mark) | ||
| 148 | "Sets the expiry date for ARTICLE in GROUP to now, if the mark is 'E'" | ||
| 149 | (if (and nndb-set-expire-date-on-mark (string-equal mark "E")) | ||
| 150 | (nndb-touch-article group article)) | ||
| 151 | mark) | ||
| 152 | |||
| 153 | ;; nndb-request-create-group -- currently this isn't necessary; nndb | ||
| 154 | ;; creates groups on demand. | ||
| 155 | |||
| 156 | ;; todo -- use some other time than the creation time of the article | ||
| 157 | ;; best is time since article has been marked as expirable | ||
| 158 | |||
| 159 | (defun nndb-request-expire-articles-local | ||
| 160 | (articles &optional group server force) | ||
| 161 | "Let gnus do the date check and issue the delete commands." | ||
| 162 | (let (msg art delete-list (num-delete 0) rest) | ||
| 163 | (nntp-possibly-change-group group server) | ||
| 164 | (while articles | ||
| 165 | (setq art (pop articles)) | ||
| 166 | (nntp-send-command "^\\([23]\\|^423\\).*\n" "X-DATE" art) | ||
| 167 | (setq msg (nndb-status-message)) | ||
| 168 | (if (string-match "^423" msg) | ||
| 169 | () | ||
| 170 | (or (string-match "'\\(.+\\)'" msg) | ||
| 171 | (error "Not a valid response for X-DATE command: %s" | ||
| 172 | msg)) | ||
| 173 | (if (nnmail-expired-article-p | ||
| 174 | group | ||
| 175 | (date-to-time (substring msg (match-beginning 1) (match-end 1))) | ||
| 176 | force) | ||
| 177 | (progn | ||
| 178 | (setq delete-list (concat delete-list " " (int-to-string art))) | ||
| 179 | (setq num-delete (1+ num-delete))) | ||
| 180 | (push art rest)))) | ||
| 181 | (if (> (length delete-list) 0) | ||
| 182 | (progn | ||
| 183 | (nnheader-message 5 "Deleting %s article(s) from %s" | ||
| 184 | (int-to-string num-delete) group) | ||
| 185 | (nntp-send-command "^[23].*\n" "X-DELETE" delete-list)) | ||
| 186 | ) | ||
| 187 | |||
| 188 | (nnheader-message 5 "") | ||
| 189 | (nconc rest articles))) | ||
| 190 | |||
| 191 | (defun nndb-get-remote-expire-response () | ||
| 192 | (let (list) | ||
| 193 | (set-buffer nntp-server-buffer) | ||
| 194 | (goto-char (point-min)) | ||
| 195 | (if (looking-at "^[34]") | ||
| 196 | ;; x-expire returned error--presume no articles were expirable) | ||
| 197 | (setq list nil) | ||
| 198 | ;; otherwise, pull all of the following numbers into the list | ||
| 199 | (re-search-forward "follows\r?\n?" nil t) | ||
| 200 | (while (re-search-forward "^[0-9]+$" nil t) | ||
| 201 | (push (string-to-number (match-string 0)) list))) | ||
| 202 | list)) | ||
| 203 | |||
| 204 | (defun nndb-request-expire-articles-remote | ||
| 205 | (articles &optional group server force) | ||
| 206 | "Let the nndb backend expire articles" | ||
| 207 | (let (days art-string delete-list (num-delete 0)) | ||
| 208 | (nntp-possibly-change-group group server) | ||
| 209 | |||
| 210 | ;; first calculate the wait period in days | ||
| 211 | (setq days (or (and nnmail-expiry-wait-function | ||
| 212 | (funcall nnmail-expiry-wait-function group)) | ||
| 213 | nnmail-expiry-wait)) | ||
| 214 | ;; now handle the special cases | ||
| 215 | (cond (force | ||
| 216 | (setq days 0)) | ||
| 217 | ((eq days 'never) | ||
| 218 | ;; This isn't an expirable group. | ||
| 219 | (setq days -1)) | ||
| 220 | ((eq days 'immediate) | ||
| 221 | (setq days 0))) | ||
| 222 | |||
| 223 | |||
| 224 | ;; build article string | ||
| 225 | (setq art-string (concat days " " (nndb-build-article-string articles))) | ||
| 226 | (nntp-send-command "^\.\r?\n\\|^[345].*\n" "X-EXPIRE" art-string) | ||
| 227 | |||
| 228 | (setq delete-list (nndb-get-remote-expire-response)) | ||
| 229 | (setq num-delete (length delete-list)) | ||
| 230 | (if (> num-delete 0) | ||
| 231 | (nnheader-message 5 "Deleting %s article(s) from %s" | ||
| 232 | (int-to-string num-delete) group)) | ||
| 233 | |||
| 234 | (nndb-build-expire-rest-list articles delete-list))) | ||
| 235 | |||
| 236 | (deffoo nndb-request-expire-articles | ||
| 237 | (articles &optional group server force) | ||
| 238 | "Expires ARTICLES from GROUP on SERVER. | ||
| 239 | If FORCE, delete regardless of exiration date, otherwise use normal | ||
| 240 | expiry mechanism." | ||
| 241 | (if nndb-server-side-expiry | ||
| 242 | (nndb-request-expire-articles-remote articles group server force) | ||
| 243 | (nndb-request-expire-articles-local articles group server force))) | ||
| 244 | |||
| 245 | ;; _Something_ defines it... | ||
| 246 | (declare-function nndb-request-article "nndb" t t) | ||
| 247 | |||
| 248 | (deffoo nndb-request-move-article | ||
| 249 | (article group server accept-form &optional last move-is-internal) | ||
| 250 | "Move ARTICLE (a number) from GROUP on SERVER. | ||
| 251 | Evals ACCEPT-FORM in current buffer, where the article is. | ||
| 252 | Optional LAST is ignored." | ||
| 253 | ;; we guess that the second arg in accept-form is the new group, | ||
| 254 | ;; which it will be for nndb, which is all that matters anyway | ||
| 255 | (let ((new-group (nth 1 accept-form)) result) | ||
| 256 | (nntp-possibly-change-group group server) | ||
| 257 | |||
| 258 | ;; use the move command for nndb-to-nndb moves | ||
| 259 | (if (string-match "^nndb" new-group) | ||
| 260 | (let ((new-group-name (gnus-group-real-name new-group))) | ||
| 261 | (nntp-send-command "^[23].*\n" "X-MOVE" article new-group-name) | ||
| 262 | (cons new-group article)) | ||
| 263 | ;; else move normally | ||
| 264 | (let ((artbuf (get-buffer-create " *nndb move*"))) | ||
| 265 | (and | ||
| 266 | (nndb-request-article article group server artbuf) | ||
| 267 | (save-excursion | ||
| 268 | (set-buffer artbuf) | ||
| 269 | (insert-buffer-substring nntp-server-buffer) | ||
| 270 | (setq result (eval accept-form)) | ||
| 271 | (kill-buffer (current-buffer)) | ||
| 272 | result) | ||
| 273 | (nndb-request-expire-articles (list article) | ||
| 274 | group | ||
| 275 | server | ||
| 276 | t)) | ||
| 277 | result) | ||
| 278 | ))) | ||
| 279 | |||
| 280 | (deffoo nndb-request-accept-article (group server &optional last) | ||
| 281 | "The article in the current buffer is put into GROUP." | ||
| 282 | (nntp-possibly-change-group group server) | ||
| 283 | (let (art msg) | ||
| 284 | (when (nntp-send-command "^[23].*\r?\n" "ACCEPT" group) | ||
| 285 | (nnheader-insert "") | ||
| 286 | (nntp-send-buffer "^[23].*\n")) | ||
| 287 | |||
| 288 | (set-buffer nntp-server-buffer) | ||
| 289 | (setq msg (buffer-string)) | ||
| 290 | (or (string-match "^\\([0-9]+\\)" msg) | ||
| 291 | (error "nndb: %s" msg)) | ||
| 292 | (setq art (substring msg (match-beginning 1) (match-end 1))) | ||
| 293 | (nnheader-message 5 "nndb: accepted %s" art) | ||
| 294 | (list art))) | ||
| 295 | |||
| 296 | (deffoo nndb-request-replace-article (article group buffer) | ||
| 297 | "ARTICLE is the number of the article in GROUP to be replaced with the contents of the BUFFER." | ||
| 298 | (set-buffer buffer) | ||
| 299 | (when (nntp-send-command "^[23].*\r?\n" "X-REPLACE" (int-to-string article)) | ||
| 300 | (nnheader-insert "") | ||
| 301 | (nntp-send-buffer "^[23.*\n") | ||
| 302 | (list (int-to-string article)))) | ||
| 303 | |||
| 304 | ; nndb-request-delete-group does not exist | ||
| 305 | ; todo -- maybe later | ||
| 306 | |||
| 307 | ; nndb-request-rename-group does not exist | ||
| 308 | ; todo -- maybe later | ||
| 309 | |||
| 310 | ;; -- standard compatibility functions | ||
| 311 | |||
| 312 | (deffoo nndb-status-message (&optional server) | ||
| 313 | "Return server status as a string." | ||
| 314 | (set-buffer nntp-server-buffer) | ||
| 315 | (buffer-string)) | ||
| 316 | |||
| 317 | ;; Import stuff from nntp | ||
| 318 | |||
| 319 | (nnoo-import nndb | ||
| 320 | (nntp)) | ||
| 321 | |||
| 322 | (provide 'nndb) | ||
| 323 | |||
| 324 | ;; arch-tag: 83bd6fb4-58d9-4fed-a901-c6c625ad5f8a | ||
| 325 | ;;; nndb.el ends here | ||
diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index c14d9a1b6aa..f348a13795f 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el | |||
| @@ -263,10 +263,10 @@ | |||
| 263 | 263 | ||
| 264 | ;; I have tried to make the code expandable. Basically, it is divided | 264 | ;; I have tried to make the code expandable. Basically, it is divided |
| 265 | ;; into two layers. The upper layer is somewhat like the `nnvirtual' | 265 | ;; into two layers. The upper layer is somewhat like the `nnvirtual' |
| 266 | ;; or `nnkiboze' backends: given a specification of what articles to | 266 | ;; backend: given a specification of what articles to show from |
| 267 | ;; show from another backend, it creates a group containing exactly | 267 | ;; another backend, it creates a group containing exactly those |
| 268 | ;; those articles. The lower layer issues a query to a search engine | 268 | ;; articles. The lower layer issues a query to a search engine and |
| 269 | ;; and produces such a specification of what articles to show from the | 269 | ;; produces such a specification of what articles to show from the |
| 270 | ;; other backend. | 270 | ;; other backend. |
| 271 | 271 | ||
| 272 | ;; The interface between the two layers consists of the single | 272 | ;; The interface between the two layers consists of the single |
diff --git a/lisp/gnus/nnkiboze.el b/lisp/gnus/nnkiboze.el deleted file mode 100644 index 17a10e66191..00000000000 --- a/lisp/gnus/nnkiboze.el +++ /dev/null | |||
| @@ -1,391 +0,0 @@ | |||
| 1 | ;;; nnkiboze.el --- select virtual news access for Gnus | ||
| 2 | |||
| 3 | ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, | ||
| 4 | ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. | ||
| 5 | |||
| 6 | ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 7 | ;; Keywords: news | ||
| 8 | |||
| 9 | ;; This file is part of GNU Emacs. | ||
| 10 | |||
| 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 12 | ;; it under the terms of the GNU General Public License as published by | ||
| 13 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 14 | ;; (at your option) any later version. | ||
| 15 | |||
| 16 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 19 | ;; GNU General Public License for more details. | ||
| 20 | |||
| 21 | ;; You should have received a copy of the GNU General Public License | ||
| 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | ||
| 23 | |||
| 24 | ;;; Commentary: | ||
| 25 | |||
| 26 | ;; The other access methods (nntp, nnspool, etc) are general news | ||
| 27 | ;; access methods. This module relies on Gnus and can't be used | ||
| 28 | ;; separately. | ||
| 29 | |||
| 30 | ;;; Code: | ||
| 31 | |||
| 32 | (require 'nntp) | ||
| 33 | (require 'nnheader) | ||
| 34 | (require 'gnus) | ||
| 35 | (require 'gnus-score) | ||
| 36 | (require 'nnoo) | ||
| 37 | (require 'mm-util) | ||
| 38 | (eval-when-compile (require 'cl)) | ||
| 39 | |||
| 40 | (nnoo-declare nnkiboze) | ||
| 41 | (defvoo nnkiboze-directory (nnheader-concat gnus-directory "kiboze/") | ||
| 42 | "nnkiboze will put its files in this directory.") | ||
| 43 | |||
| 44 | (defvoo nnkiboze-level 9 | ||
| 45 | "The maximum level to be searched for articles.") | ||
| 46 | |||
| 47 | (defvoo nnkiboze-remove-read-articles t | ||
| 48 | "If non-nil, nnkiboze will remove read articles from the kiboze group.") | ||
| 49 | |||
| 50 | (defvoo nnkiboze-ephemeral nil | ||
| 51 | "If non-nil, don't store any data anywhere.") | ||
| 52 | |||
| 53 | (defvoo nnkiboze-scores nil | ||
| 54 | "Score rules for generating the nnkiboze group.") | ||
| 55 | |||
| 56 | (defvoo nnkiboze-regexp nil | ||
| 57 | "Regexp for matching component groups.") | ||
| 58 | |||
| 59 | (defvoo nnkiboze-file-coding-system mm-text-coding-system | ||
| 60 | "Coding system for nnkiboze files.") | ||
| 61 | |||
| 62 | |||
| 63 | |||
| 64 | (defconst nnkiboze-version "nnkiboze 1.0") | ||
| 65 | |||
| 66 | (defvoo nnkiboze-current-group nil) | ||
| 67 | (defvoo nnkiboze-status-string "") | ||
| 68 | |||
| 69 | (defvoo nnkiboze-headers nil) | ||
| 70 | |||
| 71 | |||
| 72 | |||
| 73 | ;;; Interface functions. | ||
| 74 | |||
| 75 | (nnoo-define-basics nnkiboze) | ||
| 76 | |||
| 77 | (deffoo nnkiboze-retrieve-headers (articles &optional group server fetch-old) | ||
| 78 | (nnkiboze-possibly-change-group group) | ||
| 79 | (unless gnus-nov-is-evil | ||
| 80 | (if (stringp (car articles)) | ||
| 81 | 'headers | ||
| 82 | (let ((nov (nnkiboze-nov-file-name))) | ||
| 83 | (when (file-exists-p nov) | ||
| 84 | (save-excursion | ||
| 85 | (set-buffer nntp-server-buffer) | ||
| 86 | (erase-buffer) | ||
| 87 | (let ((nnheader-file-coding-system nnkiboze-file-coding-system)) | ||
| 88 | (nnheader-insert-file-contents nov)) | ||
| 89 | (nnheader-nov-delete-outside-range | ||
| 90 | (car articles) (car (last articles))) | ||
| 91 | 'nov)))))) | ||
| 92 | |||
| 93 | (deffoo nnkiboze-request-article (article &optional newsgroup server buffer) | ||
| 94 | (nnkiboze-possibly-change-group newsgroup) | ||
| 95 | (if (not (numberp article)) | ||
| 96 | ;; This is a real kludge. It might not work at times, but it | ||
| 97 | ;; does no harm I think. The only alternative is to offer no | ||
| 98 | ;; article fetching by message-id at all. | ||
| 99 | (nntp-request-article article newsgroup gnus-nntp-server buffer) | ||
| 100 | (let* ((header (gnus-summary-article-header article)) | ||
| 101 | (xref (mail-header-xref header)) | ||
| 102 | num group) | ||
| 103 | (unless xref | ||
| 104 | (error "nnkiboze: No xref")) | ||
| 105 | (unless (string-match " \\([^ ]+\\):\\([0-9]+\\)" xref) | ||
| 106 | (error "nnkiboze: Malformed xref")) | ||
| 107 | (setq num (string-to-number (match-string 2 xref)) | ||
| 108 | group (match-string 1 xref)) | ||
| 109 | (or (with-current-buffer buffer | ||
| 110 | (or (and gnus-use-cache (gnus-cache-request-article num group)) | ||
| 111 | (gnus-agent-request-article num group))) | ||
| 112 | (gnus-request-article num group buffer))))) | ||
| 113 | |||
| 114 | (deffoo nnkiboze-request-scan (&optional group server) | ||
| 115 | (nnkiboze-possibly-change-group group) | ||
| 116 | (nnkiboze-generate-group (concat "nnkiboze:" group))) | ||
| 117 | |||
| 118 | (deffoo nnkiboze-request-group (group &optional server dont-check) | ||
| 119 | "Make GROUP the current newsgroup." | ||
| 120 | (nnkiboze-possibly-change-group group) | ||
| 121 | (if dont-check | ||
| 122 | t | ||
| 123 | (let ((nov-file (nnkiboze-nov-file-name)) | ||
| 124 | beg end total) | ||
| 125 | (save-excursion | ||
| 126 | (set-buffer nntp-server-buffer) | ||
| 127 | (erase-buffer) | ||
| 128 | (unless (file-exists-p nov-file) | ||
| 129 | (nnkiboze-request-scan group)) | ||
| 130 | (if (not (file-exists-p nov-file)) | ||
| 131 | (nnheader-report 'nnkiboze "Can't select group %s" group) | ||
| 132 | (let ((nnheader-file-coding-system nnkiboze-file-coding-system)) | ||
| 133 | (nnheader-insert-file-contents nov-file)) | ||
| 134 | (if (zerop (buffer-size)) | ||
| 135 | (nnheader-insert "211 0 0 0 %s\n" group) | ||
| 136 | (goto-char (point-min)) | ||
| 137 | (when (looking-at "[0-9]+") | ||
| 138 | (setq beg (read (current-buffer)))) | ||
| 139 | (goto-char (point-max)) | ||
| 140 | (when (re-search-backward "^[0-9]" nil t) | ||
| 141 | (setq end (read (current-buffer)))) | ||
| 142 | (setq total (count-lines (point-min) (point-max))) | ||
| 143 | (nnheader-insert "211 %d %d %d %s\n" total beg end group))))))) | ||
| 144 | |||
| 145 | (deffoo nnkiboze-close-group (group &optional server) | ||
| 146 | (nnkiboze-possibly-change-group group) | ||
| 147 | ;; Remove NOV lines of articles that are marked as read. | ||
| 148 | (when (and (file-exists-p (nnkiboze-nov-file-name)) | ||
| 149 | nnkiboze-remove-read-articles) | ||
| 150 | (let ((coding-system-for-write nnkiboze-file-coding-system)) | ||
| 151 | (with-temp-file (nnkiboze-nov-file-name) | ||
| 152 | (let ((cur (current-buffer)) | ||
| 153 | (nnheader-file-coding-system nnkiboze-file-coding-system)) | ||
| 154 | (nnheader-insert-file-contents (nnkiboze-nov-file-name)) | ||
| 155 | (goto-char (point-min)) | ||
| 156 | (while (not (eobp)) | ||
| 157 | (if (not (gnus-article-read-p (read cur))) | ||
| 158 | (forward-line 1) | ||
| 159 | (gnus-delete-line)))))) | ||
| 160 | (setq nnkiboze-current-group nil))) | ||
| 161 | |||
| 162 | (deffoo nnkiboze-open-server (server &optional defs) | ||
| 163 | (unless (assq 'nnkiboze-regexp defs) | ||
| 164 | (push `(nnkiboze-regexp ,server) | ||
| 165 | defs)) | ||
| 166 | (nnoo-change-server 'nnkiboze server defs)) | ||
| 167 | |||
| 168 | (deffoo nnkiboze-request-delete-group (group &optional force server) | ||
| 169 | (nnkiboze-possibly-change-group group) | ||
| 170 | (when force | ||
| 171 | (let ((files (nconc | ||
| 172 | (nnkiboze-score-file group) | ||
| 173 | (list (nnkiboze-nov-file-name) | ||
| 174 | (nnkiboze-nov-file-name ".newsrc"))))) | ||
| 175 | (while files | ||
| 176 | (and (file-exists-p (car files)) | ||
| 177 | (file-writable-p (car files)) | ||
| 178 | (delete-file (car files))) | ||
| 179 | (setq files (cdr files))))) | ||
| 180 | (setq nnkiboze-current-group nil) | ||
| 181 | t) | ||
| 182 | |||
| 183 | (nnoo-define-skeleton nnkiboze) | ||
| 184 | |||
| 185 | |||
| 186 | ;;; Internal functions. | ||
| 187 | |||
| 188 | (defun nnkiboze-possibly-change-group (group) | ||
| 189 | (setq nnkiboze-current-group group)) | ||
| 190 | |||
| 191 | (defun nnkiboze-prefixed-name (group) | ||
| 192 | (gnus-group-prefixed-name group '(nnkiboze ""))) | ||
| 193 | |||
| 194 | ;;;###autoload | ||
| 195 | (defun nnkiboze-generate-groups () | ||
| 196 | "\"Usage: emacs -batch -l nnkiboze -f nnkiboze-generate-groups\". | ||
| 197 | Finds out what articles are to be part of the nnkiboze groups." | ||
| 198 | (interactive) | ||
| 199 | (let ((mail-sources nil) | ||
| 200 | (gnus-use-dribble-file nil) | ||
| 201 | (gnus-read-active-file t) | ||
| 202 | (gnus-expert-user t)) | ||
| 203 | (gnus)) | ||
| 204 | (let* ((gnus-newsrc-alist (gnus-copy-sequence gnus-newsrc-alist)) | ||
| 205 | (newsrc (cdr gnus-newsrc-alist)) | ||
| 206 | gnus-newsrc-hashtb info) | ||
| 207 | (gnus-make-hashtable-from-newsrc-alist) | ||
| 208 | ;; We have copied all the newsrc alist info over to local copies | ||
| 209 | ;; so that we can mess all we want with these lists. | ||
| 210 | (while (setq info (pop newsrc)) | ||
| 211 | (when (string-match "nnkiboze" (gnus-info-group info)) | ||
| 212 | ;; For each kiboze group, we call this function to generate | ||
| 213 | ;; it. | ||
| 214 | (nnkiboze-generate-group (gnus-info-group info) t)))) | ||
| 215 | (save-excursion | ||
| 216 | (set-buffer gnus-group-buffer) | ||
| 217 | (gnus-group-list-groups))) | ||
| 218 | |||
| 219 | (defun nnkiboze-score-file (group) | ||
| 220 | (list (expand-file-name | ||
| 221 | (concat (file-name-as-directory gnus-kill-files-directory) | ||
| 222 | (nnheader-translate-file-chars | ||
| 223 | (concat (nnkiboze-prefixed-name nnkiboze-current-group) | ||
| 224 | "." gnus-score-file-suffix)))))) | ||
| 225 | |||
| 226 | (defun nnkiboze-generate-group (group &optional inhibit-list-groups) | ||
| 227 | (let* ((info (gnus-get-info group)) | ||
| 228 | (newsrc-file (concat nnkiboze-directory | ||
| 229 | (nnheader-translate-file-chars | ||
| 230 | (concat group ".newsrc")))) | ||
| 231 | (nov-file (concat nnkiboze-directory | ||
| 232 | (nnheader-translate-file-chars | ||
| 233 | (concat group ".nov")))) | ||
| 234 | method nnkiboze-newsrc gname newsrc active | ||
| 235 | ginfo lowest glevel orig-info nov-buffer | ||
| 236 | ;; Bind various things to nil to make group entry faster. | ||
| 237 | (gnus-expert-user t) | ||
| 238 | (gnus-large-newsgroup nil) | ||
| 239 | (gnus-score-find-score-files-function 'nnkiboze-score-file) | ||
| 240 | ;; Use only nnkiboze-score-file! | ||
| 241 | (gnus-score-use-all-scores nil) | ||
| 242 | (gnus-use-scoring t) | ||
| 243 | (gnus-verbose (min gnus-verbose 3)) | ||
| 244 | gnus-select-group-hook gnus-summary-prepare-hook | ||
| 245 | gnus-thread-sort-functions gnus-show-threads | ||
| 246 | gnus-visual gnus-suppress-duplicates num-unread) | ||
| 247 | (unless info | ||
| 248 | (error "No such group: %s" group)) | ||
| 249 | ;; Load the kiboze newsrc file for this group. | ||
| 250 | (when (file-exists-p newsrc-file) | ||
| 251 | (load newsrc-file)) | ||
| 252 | (let ((coding-system-for-write nnkiboze-file-coding-system)) | ||
| 253 | (gnus-make-directory (file-name-directory nov-file)) | ||
| 254 | (with-temp-file nov-file | ||
| 255 | (mm-disable-multibyte) | ||
| 256 | (when (file-exists-p nov-file) | ||
| 257 | (insert-file-contents nov-file)) | ||
| 258 | (setq nov-buffer (current-buffer)) | ||
| 259 | ;; Go through the active hashtb and add new all groups that match the | ||
| 260 | ;; kiboze regexp. | ||
| 261 | (mapatoms | ||
| 262 | (lambda (group) | ||
| 263 | (and (string-match nnkiboze-regexp | ||
| 264 | (setq gname (symbol-name group))) ; Match | ||
| 265 | (not (assoc gname nnkiboze-newsrc)) ; It isn't registered | ||
| 266 | (numberp (car (symbol-value group))) ; It is active | ||
| 267 | (or (> nnkiboze-level 7) | ||
| 268 | (and (setq glevel | ||
| 269 | (gnus-info-level (gnus-get-info gname))) | ||
| 270 | (>= nnkiboze-level glevel))) | ||
| 271 | (not (string-match "^nnkiboze:" gname)) ; Exclude kibozes | ||
| 272 | (push (cons gname (1- (car (symbol-value group)))) | ||
| 273 | nnkiboze-newsrc))) | ||
| 274 | gnus-active-hashtb) | ||
| 275 | ;; `newsrc' is set to the list of groups that possibly are | ||
| 276 | ;; component groups to this kiboze group. This list has elements | ||
| 277 | ;; on the form `(GROUP . NUMBER)', where NUMBER is the highest | ||
| 278 | ;; number that has been kibozed in GROUP in this kiboze group. | ||
| 279 | (setq newsrc nnkiboze-newsrc) | ||
| 280 | (while newsrc | ||
| 281 | (if (not (setq active (gnus-active (caar newsrc)))) | ||
| 282 | ;; This group isn't active after all, so we remove it from | ||
| 283 | ;; the list of component groups. | ||
| 284 | (setq nnkiboze-newsrc (delq (car newsrc) nnkiboze-newsrc)) | ||
| 285 | (setq lowest (cdar newsrc)) | ||
| 286 | ;; Ok, we have a valid component group, so we jump to it. | ||
| 287 | (switch-to-buffer gnus-group-buffer) | ||
| 288 | (gnus-group-jump-to-group (caar newsrc)) | ||
| 289 | (gnus-message 3 "nnkiboze: Checking %s..." (caar newsrc)) | ||
| 290 | (setq ginfo (gnus-get-info (gnus-group-group-name)) | ||
| 291 | orig-info (gnus-copy-sequence ginfo) | ||
| 292 | num-unread (gnus-group-unread (caar newsrc))) | ||
| 293 | (unwind-protect | ||
| 294 | (progn | ||
| 295 | ;; We set all list of article marks to nil. Since we operate | ||
| 296 | ;; on copies of the real lists, we can destroy anything we | ||
| 297 | ;; want here. | ||
| 298 | (when (nth 3 ginfo) | ||
| 299 | (setcar (nthcdr 3 ginfo) nil)) | ||
| 300 | ;; We set the list of read articles to be what we expect for | ||
| 301 | ;; this kiboze group -- either nil or `(1 . LOWEST)'. | ||
| 302 | (when ginfo | ||
| 303 | (setcar (nthcdr 2 ginfo) | ||
| 304 | (and (not (= lowest 1)) (cons 1 lowest)))) | ||
| 305 | (when (and (or (not ginfo) | ||
| 306 | (> (length (gnus-list-of-unread-articles | ||
| 307 | (car ginfo))) | ||
| 308 | 0)) | ||
| 309 | (progn | ||
| 310 | (ignore-errors | ||
| 311 | (gnus-group-select-group nil)) | ||
| 312 | (eq major-mode 'gnus-summary-mode))) | ||
| 313 | ;; We are now in the group where we want to be. | ||
| 314 | (setq method (gnus-find-method-for-group | ||
| 315 | gnus-newsgroup-name)) | ||
| 316 | (when (eq method gnus-select-method) | ||
| 317 | (setq method nil)) | ||
| 318 | ;; We go through the list of scored articles. | ||
| 319 | (while gnus-newsgroup-scored | ||
| 320 | (when (> (caar gnus-newsgroup-scored) lowest) | ||
| 321 | ;; If it has a good score, then we enter this article | ||
| 322 | ;; into the kiboze group. | ||
| 323 | (nnkiboze-enter-nov | ||
| 324 | nov-buffer | ||
| 325 | (gnus-summary-article-header | ||
| 326 | (caar gnus-newsgroup-scored)) | ||
| 327 | gnus-newsgroup-name)) | ||
| 328 | (setq gnus-newsgroup-scored (cdr gnus-newsgroup-scored))) | ||
| 329 | ;; That's it. We exit this group. | ||
| 330 | (when (eq major-mode 'gnus-summary-mode) | ||
| 331 | (kill-buffer (current-buffer))))) | ||
| 332 | ;; Restore the proper info. | ||
| 333 | (when ginfo | ||
| 334 | (setcdr ginfo (cdr orig-info))) | ||
| 335 | (setcar (gnus-group-entry (caar newsrc)) num-unread))) | ||
| 336 | (setcdr (car newsrc) (cdr active)) | ||
| 337 | (gnus-message 3 "nnkiboze: Checking %s...done" (caar newsrc)) | ||
| 338 | (setq newsrc (cdr newsrc))))) | ||
| 339 | ;; We save the kiboze newsrc for this group. | ||
| 340 | (gnus-make-directory (file-name-directory newsrc-file)) | ||
| 341 | (with-temp-file newsrc-file | ||
| 342 | (mm-disable-multibyte) | ||
| 343 | (insert "(setq nnkiboze-newsrc '") | ||
| 344 | (gnus-prin1 nnkiboze-newsrc) | ||
| 345 | (insert ")\n")) | ||
| 346 | (unless inhibit-list-groups | ||
| 347 | (save-excursion | ||
| 348 | (set-buffer gnus-group-buffer) | ||
| 349 | (gnus-group-list-groups))) | ||
| 350 | t)) | ||
| 351 | |||
| 352 | (defun nnkiboze-enter-nov (buffer header group) | ||
| 353 | (save-excursion | ||
| 354 | (set-buffer buffer) | ||
| 355 | (goto-char (point-max)) | ||
| 356 | (let ((prefix (gnus-group-real-prefix group)) | ||
| 357 | (oheader (copy-sequence header)) | ||
| 358 | article) | ||
| 359 | (if (zerop (forward-line -1)) | ||
| 360 | (progn | ||
| 361 | (setq article (1+ (read (current-buffer)))) | ||
| 362 | (forward-line 1)) | ||
| 363 | (setq article 1)) | ||
| 364 | (mail-header-set-number oheader article) | ||
| 365 | (with-temp-buffer | ||
| 366 | (insert (or (mail-header-xref oheader) "")) | ||
| 367 | (goto-char (point-min)) | ||
| 368 | (if (re-search-forward " [^ ]+:[0-9]+" nil t) | ||
| 369 | (goto-char (match-beginning 0)) | ||
| 370 | (or (eobp) (forward-char 1))) | ||
| 371 | ;; The first Xref has to be the group this article | ||
| 372 | ;; really came for - this is the article nnkiboze | ||
| 373 | ;; will request when it is asked for the article. | ||
| 374 | (insert " " group ":" | ||
| 375 | (int-to-string (mail-header-number header)) " ") | ||
| 376 | (while (re-search-forward " [^ ]+:[0-9]+" nil t) | ||
| 377 | (goto-char (1+ (match-beginning 0))) | ||
| 378 | (insert prefix)) | ||
| 379 | (mail-header-set-xref oheader (buffer-string))) | ||
| 380 | (nnheader-insert-nov oheader)))) | ||
| 381 | |||
| 382 | (defun nnkiboze-nov-file-name (&optional suffix) | ||
| 383 | (concat (file-name-as-directory nnkiboze-directory) | ||
| 384 | (nnheader-translate-file-chars | ||
| 385 | (concat (nnkiboze-prefixed-name nnkiboze-current-group) | ||
| 386 | (or suffix ".nov"))))) | ||
| 387 | |||
| 388 | (provide 'nnkiboze) | ||
| 389 | |||
| 390 | ;; arch-tag: 66068271-bdc9-4801-bcde-779702e73a05 | ||
| 391 | ;;; nnkiboze.el ends here | ||
diff --git a/lisp/gnus/nnlistserv.el b/lisp/gnus/nnlistserv.el deleted file mode 100644 index 3e53001cec0..00000000000 --- a/lisp/gnus/nnlistserv.el +++ /dev/null | |||
| @@ -1,152 +0,0 @@ | |||
| 1 | ;;; nnlistserv.el --- retrieving articles via web mailing list archives | ||
| 2 | |||
| 3 | ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, | ||
| 4 | ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. | ||
| 5 | |||
| 6 | ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 7 | ;; Keywords: news, mail | ||
| 8 | |||
| 9 | ;; This file is part of GNU Emacs. | ||
| 10 | |||
| 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 12 | ;; it under the terms of the GNU General Public License as published by | ||
| 13 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 14 | ;; (at your option) any later version. | ||
| 15 | |||
| 16 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 19 | ;; GNU General Public License for more details. | ||
| 20 | |||
| 21 | ;; You should have received a copy of the GNU General Public License | ||
| 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | ||
| 23 | |||
| 24 | ;;; Commentary: | ||
| 25 | |||
| 26 | ;;; Code: | ||
| 27 | |||
| 28 | (eval-when-compile (require 'cl)) | ||
| 29 | |||
| 30 | (require 'nnoo) | ||
| 31 | (require 'mm-url) | ||
| 32 | (require 'nnweb) | ||
| 33 | |||
| 34 | (nnoo-declare nnlistserv | ||
| 35 | nnweb) | ||
| 36 | |||
| 37 | (defvoo nnlistserv-directory (nnheader-concat gnus-directory "nnlistserv/") | ||
| 38 | "Where nnlistserv will save its files." | ||
| 39 | nnweb-directory) | ||
| 40 | |||
| 41 | (defvoo nnlistserv-name 'kk | ||
| 42 | "What search engine type is being used." | ||
| 43 | nnweb-type) | ||
| 44 | |||
| 45 | (defvoo nnlistserv-type-definition | ||
| 46 | '((kk | ||
| 47 | (article . nnlistserv-kk-wash-article) | ||
| 48 | (map . nnlistserv-kk-create-mapping) | ||
| 49 | (search . nnlistserv-kk-search) | ||
| 50 | (address . "http://www.itk.ntnu.no/ansatte/Andresen_Trond/kk-f/%s/") | ||
| 51 | (pages "fra160396" "fra160796" "fra061196" "fra160197" | ||
| 52 | "fra090997" "fra040797" "fra130397" "nye") | ||
| 53 | (index . "date.html") | ||
| 54 | (identifier . nnlistserv-kk-identity))) | ||
| 55 | "Type-definition alist." | ||
| 56 | nnweb-type-definition) | ||
| 57 | |||
| 58 | (defvoo nnlistserv-search nil | ||
| 59 | "Search string to feed to DejaNews." | ||
| 60 | nnweb-search) | ||
| 61 | |||
| 62 | (defvoo nnlistserv-ephemeral-p nil | ||
| 63 | "Whether this nnlistserv server is ephemeral." | ||
| 64 | nnweb-ephemeral-p) | ||
| 65 | |||
| 66 | ;;; Internal variables | ||
| 67 | |||
| 68 | ;;; Interface functions | ||
| 69 | |||
| 70 | (nnoo-define-basics nnlistserv) | ||
| 71 | |||
| 72 | (nnoo-import nnlistserv | ||
| 73 | (nnweb)) | ||
| 74 | |||
| 75 | ;;; Internal functions | ||
| 76 | |||
| 77 | ;;; | ||
| 78 | ;;; KK functions. | ||
| 79 | ;;; | ||
| 80 | |||
| 81 | (defun nnlistserv-kk-create-mapping () | ||
| 82 | "Perform the search and create a number-to-url alist." | ||
| 83 | (save-excursion | ||
| 84 | (set-buffer nnweb-buffer) | ||
| 85 | (let ((case-fold-search t) | ||
| 86 | (active (or (cadr (assoc nnweb-group nnweb-group-alist)) | ||
| 87 | (cons 1 0))) | ||
| 88 | (pages (nnweb-definition 'pages)) | ||
| 89 | map url page subject from ) | ||
| 90 | (while (setq page (pop pages)) | ||
| 91 | (erase-buffer) | ||
| 92 | (when (funcall (nnweb-definition 'search) page) | ||
| 93 | ;; Go through all the article hits on this page. | ||
| 94 | (goto-char (point-min)) | ||
| 95 | (mm-url-decode-entities) | ||
| 96 | (goto-char (point-min)) | ||
| 97 | (while (re-search-forward "^<li> *<a href=\"\\([^\"]+\\)\"><b>\\([^\\>]+\\)</b></a> *<[^>]+><i>\\([^>]+\\)<" nil t) | ||
| 98 | (setq url (match-string 1) | ||
| 99 | subject (match-string 2) | ||
| 100 | from (match-string 3)) | ||
| 101 | (setq url (concat (format (nnweb-definition 'address) page) url)) | ||
| 102 | (unless (nnweb-get-hashtb url) | ||
| 103 | (push | ||
| 104 | (list | ||
| 105 | (incf (cdr active)) | ||
| 106 | (make-full-mail-header | ||
| 107 | (cdr active) subject from "" | ||
| 108 | (concat "<" (nnweb-identifier url) "@kk>") | ||
| 109 | nil 0 0 url)) | ||
| 110 | map) | ||
| 111 | (nnweb-set-hashtb (cadar map) (car map)) | ||
| 112 | (nnheader-message 5 "%s %s %s" (cdr active) (point) pages))))) | ||
| 113 | ;; Return the articles in the right order. | ||
| 114 | (setq nnweb-articles | ||
| 115 | (sort (nconc nnweb-articles map) 'car-less-than-car))))) | ||
| 116 | |||
| 117 | (defun nnlistserv-kk-wash-article () | ||
| 118 | (let ((case-fold-search t) | ||
| 119 | (headers '(sent name email subject id)) | ||
| 120 | sent name email subject id) | ||
| 121 | (mm-url-decode-entities) | ||
| 122 | (while headers | ||
| 123 | (goto-char (point-min)) | ||
| 124 | (re-search-forward (format "<!-- %s=\"\\([^\"]+\\)" (car headers)) nil t) | ||
| 125 | (set (pop headers) (match-string 1))) | ||
| 126 | (goto-char (point-min)) | ||
| 127 | (search-forward "<!-- body" nil t) | ||
| 128 | (delete-region (point-min) (progn (forward-line 1) (point))) | ||
| 129 | (goto-char (point-max)) | ||
| 130 | (search-backward "<!-- body" nil t) | ||
| 131 | (delete-region (point-max) (progn (beginning-of-line) (point))) | ||
| 132 | (mm-url-remove-markup) | ||
| 133 | (goto-char (point-min)) | ||
| 134 | (insert (format "From: %s <%s>\n" name email) | ||
| 135 | (format "Subject: %s\n" subject) | ||
| 136 | (format "Message-ID: %s\n" id) | ||
| 137 | (format "Date: %s\n\n" sent)))) | ||
| 138 | |||
| 139 | (defun nnlistserv-kk-search (search) | ||
| 140 | (mm-url-insert | ||
| 141 | (concat (format (nnweb-definition 'address) search) | ||
| 142 | (nnweb-definition 'index))) | ||
| 143 | t) | ||
| 144 | |||
| 145 | (defun nnlistserv-kk-identity (url) | ||
| 146 | "Return an unique identifier based on URL." | ||
| 147 | url) | ||
| 148 | |||
| 149 | (provide 'nnlistserv) | ||
| 150 | |||
| 151 | ;; arch-tag: 7705176f-d332-4a5e-a520-d0d319445617 | ||
| 152 | ;;; nnlistserv.el ends here | ||
diff --git a/lisp/gnus/nnwfm.el b/lisp/gnus/nnwfm.el deleted file mode 100644 index fceb3ccd6ad..00000000000 --- a/lisp/gnus/nnwfm.el +++ /dev/null | |||
| @@ -1,432 +0,0 @@ | |||
| 1 | ;;; nnwfm.el --- interfacing with a web forum | ||
| 2 | |||
| 3 | ;; Copyright (C) 2000, 2002, 2003, 2004, 2005, | ||
| 4 | ;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. | ||
| 5 | |||
| 6 | ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 7 | ;; Keywords: news | ||
| 8 | |||
| 9 | ;; This file is part of GNU Emacs. | ||
| 10 | |||
| 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 12 | ;; it under the terms of the GNU General Public License as published by | ||
| 13 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 14 | ;; (at your option) any later version. | ||
| 15 | |||
| 16 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 19 | ;; GNU General Public License for more details. | ||
| 20 | |||
| 21 | ;; You should have received a copy of the GNU General Public License | ||
| 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | ||
| 23 | |||
| 24 | ;;; Commentary: | ||
| 25 | |||
| 26 | ;; Note: You need to have `url' and `w3' installed for this | ||
| 27 | ;; backend to work. | ||
| 28 | |||
| 29 | ;;; Code: | ||
| 30 | |||
| 31 | (eval-when-compile (require 'cl)) | ||
| 32 | |||
| 33 | (require 'nnoo) | ||
| 34 | (require 'message) | ||
| 35 | (require 'gnus-util) | ||
| 36 | (require 'gnus) | ||
| 37 | (require 'nnmail) | ||
| 38 | (require 'mm-util) | ||
| 39 | (require 'mm-url) | ||
| 40 | (require 'nnweb) | ||
| 41 | (autoload 'w3-parse-buffer "w3-parse") | ||
| 42 | |||
| 43 | (nnoo-declare nnwfm) | ||
| 44 | |||
| 45 | (defvoo nnwfm-directory (nnheader-concat gnus-directory "wfm/") | ||
| 46 | "Where nnwfm will save its files.") | ||
| 47 | |||
| 48 | (defvoo nnwfm-address "" | ||
| 49 | "The address of the Ultimate bulletin board.") | ||
| 50 | |||
| 51 | ;;; Internal variables | ||
| 52 | |||
| 53 | (defvar nnwfm-groups-alist nil) | ||
| 54 | (defvoo nnwfm-groups nil) | ||
| 55 | (defvoo nnwfm-headers nil) | ||
| 56 | (defvoo nnwfm-articles nil) | ||
| 57 | (defvar nnwfm-table-regexp | ||
| 58 | "postings.*editpost\\|forumdisplay\\|Forum[0-9]+/HTML\\|getbio") | ||
| 59 | |||
| 60 | ;;; Interface functions | ||
| 61 | |||
| 62 | (nnoo-define-basics nnwfm) | ||
| 63 | |||
| 64 | (deffoo nnwfm-retrieve-headers (articles &optional group server fetch-old) | ||
| 65 | (nnwfm-possibly-change-server group server) | ||
| 66 | (unless gnus-nov-is-evil | ||
| 67 | (let* ((last (car (last articles))) | ||
| 68 | (did nil) | ||
| 69 | (start 1) | ||
| 70 | (entry (assoc group nnwfm-groups)) | ||
| 71 | (sid (nth 2 entry)) | ||
| 72 | (topics (nth 4 entry)) | ||
| 73 | (mapping (nth 5 entry)) | ||
| 74 | (old-total (or (nth 6 entry) 1)) | ||
| 75 | (nnwfm-table-regexp "Thread.asp") | ||
| 76 | headers article subject score from date lines parent point | ||
| 77 | contents tinfo fetchers map elem a href garticles topic old-max | ||
| 78 | inc datel table string current-page total-contents pages | ||
| 79 | farticles forum-contents parse furl-fetched mmap farticle | ||
| 80 | thread-id tables hstuff bstuff time) | ||
| 81 | (setq map mapping) | ||
| 82 | (while (and (setq article (car articles)) | ||
| 83 | map) | ||
| 84 | (while (and map | ||
| 85 | (or (> article (caar map)) | ||
| 86 | (< (cadar map) (caar map)))) | ||
| 87 | (pop map)) | ||
| 88 | (when (setq mmap (car map)) | ||
| 89 | (setq farticle -1) | ||
| 90 | (while (and article | ||
| 91 | (<= article (nth 1 mmap))) | ||
| 92 | ;; Do we already have a fetcher for this topic? | ||
| 93 | (if (setq elem (assq (nth 2 mmap) fetchers)) | ||
| 94 | ;; Yes, so we just add the spec to the end. | ||
| 95 | (nconc elem (list (cons article | ||
| 96 | (+ (nth 3 mmap) (incf farticle))))) | ||
| 97 | ;; No, so we add a new one. | ||
| 98 | (push (list (nth 2 mmap) | ||
| 99 | (cons article | ||
| 100 | (+ (nth 3 mmap) (incf farticle)))) | ||
| 101 | fetchers)) | ||
| 102 | (pop articles) | ||
| 103 | (setq article (car articles))))) | ||
| 104 | ;; Now we have the mapping from/to Gnus/nnwfm article numbers, | ||
| 105 | ;; so we start fetching the topics that we need to satisfy the | ||
| 106 | ;; request. | ||
| 107 | (if (not fetchers) | ||
| 108 | (save-excursion | ||
| 109 | (set-buffer nntp-server-buffer) | ||
| 110 | (erase-buffer)) | ||
| 111 | (setq nnwfm-articles nil) | ||
| 112 | (mm-with-unibyte-buffer | ||
| 113 | (dolist (elem fetchers) | ||
| 114 | (erase-buffer) | ||
| 115 | (setq subject (nth 2 (assq (car elem) topics)) | ||
| 116 | thread-id (nth 0 (assq (car elem) topics))) | ||
| 117 | (mm-url-insert | ||
| 118 | (concat nnwfm-address | ||
| 119 | (format "Item.asp?GroupID=%d&ThreadID=%d" sid | ||
| 120 | thread-id))) | ||
| 121 | (goto-char (point-min)) | ||
| 122 | (setq tables (caddar | ||
| 123 | (caddar | ||
| 124 | (cdr (caddar | ||
| 125 | (caddar | ||
| 126 | (ignore-errors | ||
| 127 | (w3-parse-buffer (current-buffer))))))))) | ||
| 128 | (setq tables (cdr (caddar (memq (assq 'div tables) tables)))) | ||
| 129 | (setq contents nil) | ||
| 130 | (dolist (table tables) | ||
| 131 | (when (eq (car table) 'table) | ||
| 132 | (setq table (caddar (caddar (caddr table))) | ||
| 133 | hstuff (delete ":link" (nnweb-text (car table))) | ||
| 134 | bstuff (car (caddar (cdr table))) | ||
| 135 | from (car hstuff)) | ||
| 136 | (when (nth 2 hstuff) | ||
| 137 | (setq time (nnwfm-date-to-time (nth 2 hstuff))) | ||
| 138 | (push (list from time bstuff) contents)))) | ||
| 139 | (setq contents (nreverse contents)) | ||
| 140 | (dolist (art (cdr elem)) | ||
| 141 | (push (list (car art) | ||
| 142 | (nth (1- (cdr art)) contents) | ||
| 143 | subject) | ||
| 144 | nnwfm-articles)))) | ||
| 145 | (setq nnwfm-articles | ||
| 146 | (sort nnwfm-articles 'car-less-than-car)) | ||
| 147 | ;; Now we have all the articles, conveniently in an alist | ||
| 148 | ;; where the key is the Gnus article number. | ||
| 149 | (dolist (articlef nnwfm-articles) | ||
| 150 | (setq article (nth 0 articlef) | ||
| 151 | contents (nth 1 articlef) | ||
| 152 | subject (nth 2 articlef)) | ||
| 153 | (setq from (nth 0 contents) | ||
| 154 | date (message-make-date (nth 1 contents))) | ||
| 155 | (push | ||
| 156 | (cons | ||
| 157 | article | ||
| 158 | (make-full-mail-header | ||
| 159 | article subject | ||
| 160 | from (or date "") | ||
| 161 | (concat "<" (number-to-string sid) "%" | ||
| 162 | (number-to-string article) | ||
| 163 | "@wfm>") | ||
| 164 | "" 0 | ||
| 165 | (/ (length (mapconcat 'identity (nnweb-text (nth 2 contents)) "")) | ||
| 166 | 70) | ||
| 167 | nil nil)) | ||
| 168 | headers)) | ||
| 169 | (setq nnwfm-headers (sort headers 'car-less-than-car)) | ||
| 170 | (save-excursion | ||
| 171 | (set-buffer nntp-server-buffer) | ||
| 172 | (mm-with-unibyte-current-buffer | ||
| 173 | (erase-buffer) | ||
| 174 | (dolist (header nnwfm-headers) | ||
| 175 | (nnheader-insert-nov (cdr header)))))) | ||
| 176 | 'nov))) | ||
| 177 | |||
| 178 | (deffoo nnwfm-request-group (group &optional server dont-check) | ||
| 179 | (nnwfm-possibly-change-server nil server) | ||
| 180 | (when (not nnwfm-groups) | ||
| 181 | (nnwfm-request-list)) | ||
| 182 | (unless dont-check | ||
| 183 | (nnwfm-create-mapping group)) | ||
| 184 | (let ((elem (assoc group nnwfm-groups))) | ||
| 185 | (cond | ||
| 186 | ((not elem) | ||
| 187 | (nnheader-report 'nnwfm "Group does not exist")) | ||
| 188 | (t | ||
| 189 | (nnheader-report 'nnwfm "Opened group %s" group) | ||
| 190 | (nnheader-insert | ||
| 191 | "211 %d %d %d %s\n" (cadr elem) 1 (cadr elem) | ||
| 192 | (prin1-to-string group)))))) | ||
| 193 | |||
| 194 | (deffoo nnwfm-request-close () | ||
| 195 | (setq nnwfm-groups-alist nil | ||
| 196 | nnwfm-groups nil)) | ||
| 197 | |||
| 198 | (deffoo nnwfm-request-article (article &optional group server buffer) | ||
| 199 | (nnwfm-possibly-change-server group server) | ||
| 200 | (let ((contents (cdr (assq article nnwfm-articles)))) | ||
| 201 | (when (setq contents (nth 2 (car contents))) | ||
| 202 | (save-excursion | ||
| 203 | (set-buffer (or buffer nntp-server-buffer)) | ||
| 204 | (erase-buffer) | ||
| 205 | (nnweb-insert-html contents) | ||
| 206 | (goto-char (point-min)) | ||
| 207 | (insert "Content-Type: text/html\nMIME-Version: 1.0\n") | ||
| 208 | (let ((header (cdr (assq article nnwfm-headers)))) | ||
| 209 | (mm-with-unibyte-current-buffer | ||
| 210 | (nnheader-insert-header header))) | ||
| 211 | (nnheader-report 'nnwfm "Fetched article %s" article) | ||
| 212 | (cons group article))))) | ||
| 213 | |||
| 214 | (deffoo nnwfm-request-list (&optional server) | ||
| 215 | (nnwfm-possibly-change-server nil server) | ||
| 216 | (mm-with-unibyte-buffer | ||
| 217 | (mm-url-insert | ||
| 218 | (if (string-match "/$" nnwfm-address) | ||
| 219 | (concat nnwfm-address "Group.asp") | ||
| 220 | nnwfm-address)) | ||
| 221 | (let* ((nnwfm-table-regexp "Thread.asp") | ||
| 222 | (contents (w3-parse-buffer (current-buffer))) | ||
| 223 | sid elem description articles a href group forum | ||
| 224 | a1 a2) | ||
| 225 | (dolist (row (cdr (nth 2 (car (nth 2 (nnwfm-find-forum-table | ||
| 226 | contents)))))) | ||
| 227 | (setq row (nth 2 row)) | ||
| 228 | (when (setq a (nnweb-parse-find 'a row)) | ||
| 229 | (setq group (car (last (nnweb-text a))) | ||
| 230 | href (cdr (assq 'href (nth 1 a)))) | ||
| 231 | (setq description (car (last (nnweb-text (nth 1 row))))) | ||
| 232 | (setq articles | ||
| 233 | (string-to-number | ||
| 234 | (gnus-replace-in-string | ||
| 235 | (car (last (nnweb-text (nth 3 row)))) "," ""))) | ||
| 236 | (when (and href | ||
| 237 | (string-match "GroupId=\\([0-9]+\\)" href)) | ||
| 238 | (setq forum (string-to-number (match-string 1 href))) | ||
| 239 | (if (setq elem (assoc group nnwfm-groups)) | ||
| 240 | (setcar (cdr elem) articles) | ||
| 241 | (push (list group articles forum description nil nil nil nil) | ||
| 242 | nnwfm-groups)))))) | ||
| 243 | (nnwfm-write-groups) | ||
| 244 | (nnwfm-generate-active) | ||
| 245 | t)) | ||
| 246 | |||
| 247 | (deffoo nnwfm-request-newgroups (date &optional server) | ||
| 248 | (nnwfm-possibly-change-server nil server) | ||
| 249 | (nnwfm-generate-active) | ||
| 250 | t) | ||
| 251 | |||
| 252 | (nnoo-define-skeleton nnwfm) | ||
| 253 | |||
| 254 | ;;; Internal functions | ||
| 255 | |||
| 256 | (defun nnwfm-new-threads-p (group time) | ||
| 257 | "See whether we want to fetch the threads for GROUP written before TIME." | ||
| 258 | (let ((old-time (nth 7 (assoc group nnwfm-groups)))) | ||
| 259 | (or (null old-time) | ||
| 260 | (time-less-p old-time time)))) | ||
| 261 | |||
| 262 | (defun nnwfm-create-mapping (group) | ||
| 263 | (let* ((entry (assoc group nnwfm-groups)) | ||
| 264 | (sid (nth 2 entry)) | ||
| 265 | (topics (nth 4 entry)) | ||
| 266 | (mapping (nth 5 entry)) | ||
| 267 | (old-total (or (nth 6 entry) 1)) | ||
| 268 | (current-time (current-time)) | ||
| 269 | (nnwfm-table-regexp "Thread.asp") | ||
| 270 | (furls (list (concat nnwfm-address | ||
| 271 | (format "Thread.asp?GroupId=%d" sid)))) | ||
| 272 | fetched-urls | ||
| 273 | contents forum-contents a subject href | ||
| 274 | garticles topic tinfo old-max inc parse elem date | ||
| 275 | url time) | ||
| 276 | (mm-with-unibyte-buffer | ||
| 277 | (while furls | ||
| 278 | (erase-buffer) | ||
| 279 | (push (car furls) fetched-urls) | ||
| 280 | (mm-url-insert (pop furls)) | ||
| 281 | (goto-char (point-min)) | ||
| 282 | (while (re-search-forward " wr(" nil t) | ||
| 283 | (forward-char -1) | ||
| 284 | (setq elem (message-tokenize-header | ||
| 285 | (gnus-replace-in-string | ||
| 286 | (buffer-substring | ||
| 287 | (1+ (point)) | ||
| 288 | (progn | ||
| 289 | (forward-sexp 1) | ||
| 290 | (1- (point)))) | ||
| 291 | "\\\\[\"\\\\]" ""))) | ||
| 292 | (push (list | ||
| 293 | (string-to-number (nth 1 elem)) | ||
| 294 | (gnus-replace-in-string (nth 2 elem) "\"" "") | ||
| 295 | (string-to-number (nth 5 elem))) | ||
| 296 | forum-contents)) | ||
| 297 | (when (re-search-forward "href=\"\\(Thread.*DateLast=\\([^\"]+\\)\\)" | ||
| 298 | nil t) | ||
| 299 | (setq url (match-string 1) | ||
| 300 | time (nnwfm-date-to-time (gnus-url-unhex-string | ||
| 301 | (match-string 2)))) | ||
| 302 | (when (and (nnwfm-new-threads-p group time) | ||
| 303 | (not (member | ||
| 304 | (setq url (concat | ||
| 305 | nnwfm-address | ||
| 306 | (mm-url-decode-entities-string url))) | ||
| 307 | fetched-urls))) | ||
| 308 | (push url furls)))) | ||
| 309 | ;; The main idea here is to map Gnus article numbers to | ||
| 310 | ;; nnwfm article numbers. Say there are three topics in | ||
| 311 | ;; this forum, the first with 4 articles, the seconds with 2, | ||
| 312 | ;; and the third with 1. Then this will translate into 7 Gnus | ||
| 313 | ;; article numbers, where 1-4 comes from the first topic, 5-6 | ||
| 314 | ;; from the second and 7 from the third. Now, then next time | ||
| 315 | ;; the group is entered, there's 2 new articles in topic one | ||
| 316 | ;; and 1 in topic three. Then Gnus article number 8-9 be 5-6 | ||
| 317 | ;; in topic one and 10 will be the 2 in topic three. | ||
| 318 | (dolist (elem (nreverse forum-contents)) | ||
| 319 | (setq subject (nth 1 elem) | ||
| 320 | topic (nth 0 elem) | ||
| 321 | garticles (nth 2 elem)) | ||
| 322 | (if (setq tinfo (assq topic topics)) | ||
| 323 | (progn | ||
| 324 | (setq old-max (cadr tinfo)) | ||
| 325 | (setcar (cdr tinfo) garticles)) | ||
| 326 | (setq old-max 0) | ||
| 327 | (push (list topic garticles subject) topics) | ||
| 328 | (setcar (nthcdr 4 entry) topics)) | ||
| 329 | (when (not (= old-max garticles)) | ||
| 330 | (setq inc (- garticles old-max)) | ||
| 331 | (setq mapping (nconc mapping | ||
| 332 | (list | ||
| 333 | (list | ||
| 334 | old-total (1- (incf old-total inc)) | ||
| 335 | topic (1+ old-max))))) | ||
| 336 | (incf old-max inc) | ||
| 337 | (setcar (nthcdr 5 entry) mapping) | ||
| 338 | (setcar (nthcdr 6 entry) old-total)))) | ||
| 339 | (setcar (nthcdr 7 entry) current-time) | ||
| 340 | (setcar (nthcdr 1 entry) (1- old-total)) | ||
| 341 | (nnwfm-write-groups) | ||
| 342 | mapping)) | ||
| 343 | |||
| 344 | (defun nnwfm-possibly-change-server (&optional group server) | ||
| 345 | (nnwfm-init server) | ||
| 346 | (when (and server | ||
| 347 | (not (nnwfm-server-opened server))) | ||
| 348 | (nnwfm-open-server server)) | ||
| 349 | (unless nnwfm-groups-alist | ||
| 350 | (nnwfm-read-groups) | ||
| 351 | (setq nnwfm-groups (cdr (assoc nnwfm-address | ||
| 352 | nnwfm-groups-alist))))) | ||
| 353 | |||
| 354 | (deffoo nnwfm-open-server (server &optional defs connectionless) | ||
| 355 | (nnheader-init-server-buffer) | ||
| 356 | (if (nnwfm-server-opened server) | ||
| 357 | t | ||
| 358 | (unless (assq 'nnwfm-address defs) | ||
| 359 | (setq defs (append defs (list (list 'nnwfm-address server))))) | ||
| 360 | (nnoo-change-server 'nnwfm server defs))) | ||
| 361 | |||
| 362 | (defun nnwfm-read-groups () | ||
| 363 | (setq nnwfm-groups-alist nil) | ||
| 364 | (let ((file (expand-file-name "groups" nnwfm-directory))) | ||
| 365 | (when (file-exists-p file) | ||
| 366 | (mm-with-unibyte-buffer | ||
| 367 | (insert-file-contents file) | ||
| 368 | (goto-char (point-min)) | ||
| 369 | (setq nnwfm-groups-alist (read (current-buffer))))))) | ||
| 370 | |||
| 371 | (defun nnwfm-write-groups () | ||
| 372 | (setq nnwfm-groups-alist | ||
| 373 | (delq (assoc nnwfm-address nnwfm-groups-alist) | ||
| 374 | nnwfm-groups-alist)) | ||
| 375 | (push (cons nnwfm-address nnwfm-groups) | ||
| 376 | nnwfm-groups-alist) | ||
| 377 | (with-temp-file (expand-file-name "groups" nnwfm-directory) | ||
| 378 | (prin1 nnwfm-groups-alist (current-buffer)))) | ||
| 379 | |||
| 380 | (defun nnwfm-init (server) | ||
| 381 | "Initialize buffers and such." | ||
| 382 | (unless (file-exists-p nnwfm-directory) | ||
| 383 | (gnus-make-directory nnwfm-directory))) | ||
| 384 | |||
| 385 | (defun nnwfm-generate-active () | ||
| 386 | (save-excursion | ||
| 387 | (set-buffer nntp-server-buffer) | ||
| 388 | (erase-buffer) | ||
| 389 | (dolist (elem nnwfm-groups) | ||
| 390 | (insert (prin1-to-string (car elem)) | ||
| 391 | " " (number-to-string (cadr elem)) " 1 y\n")))) | ||
| 392 | |||
| 393 | (defun nnwfm-find-forum-table (contents) | ||
| 394 | (catch 'found | ||
| 395 | (nnwfm-find-forum-table-1 contents))) | ||
| 396 | |||
| 397 | (defun nnwfm-find-forum-table-1 (contents) | ||
| 398 | (dolist (element contents) | ||
| 399 | (unless (stringp element) | ||
| 400 | (when (and (eq (car element) 'table) | ||
| 401 | (nnwfm-forum-table-p element)) | ||
| 402 | (throw 'found element)) | ||
| 403 | (when (nth 2 element) | ||
| 404 | (nnwfm-find-forum-table-1 (nth 2 element)))))) | ||
| 405 | |||
| 406 | (defun nnwfm-forum-table-p (parse) | ||
| 407 | (when (not (apply 'gnus-or | ||
| 408 | (mapcar | ||
| 409 | (lambda (p) | ||
| 410 | (nnweb-parse-find 'table p)) | ||
| 411 | (nth 2 parse)))) | ||
| 412 | (let ((href (cdr (assq 'href (nth 1 (nnweb-parse-find 'a parse 20))))) | ||
| 413 | case-fold-search) | ||
| 414 | (when (and href (string-match nnwfm-table-regexp href)) | ||
| 415 | t)))) | ||
| 416 | |||
| 417 | (defun nnwfm-date-to-time (date) | ||
| 418 | (let ((time (mapcar #'string-to-number (split-string date "[\\.\\+ :]")))) | ||
| 419 | (encode-time 0 (nth 4 time) (nth 3 time) | ||
| 420 | (nth 0 time) (nth 1 time) | ||
| 421 | (if (< (nth 2 time) 70) | ||
| 422 | (+ 2000 (nth 2 time)) | ||
| 423 | (+ 1900 (nth 2 time)))))) | ||
| 424 | |||
| 425 | (provide 'nnwfm) | ||
| 426 | |||
| 427 | ;; Local Variables: | ||
| 428 | ;; coding: iso-8859-1 | ||
| 429 | ;; End: | ||
| 430 | |||
| 431 | ;; arch-tag: d813966a-4211-4557-ad11-d1ac2bc86536 | ||
| 432 | ;;; nnwfm.el ends here | ||
diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el index 5c491b0c371..bfa81595085 100644 --- a/lisp/htmlfontify.el +++ b/lisp/htmlfontify.el | |||
| @@ -2349,7 +2349,7 @@ You may also want to set `hfy-page-header' and `hfy-page-footer'." | |||
| 2349 | 2349 | ||
| 2350 | 2350 | ||
| 2351 | ;;;### (autoloads (hfy-fallback-colour-values htmlfontify-load-rgb-file) | 2351 | ;;;### (autoloads (hfy-fallback-colour-values htmlfontify-load-rgb-file) |
| 2352 | ;;;;;; "hfy-cmap" "hfy-cmap.el" "3de2db2d213813bb3afe170ffd66cdde") | 2352 | ;;;;;; "hfy-cmap" "hfy-cmap.el" "7e622e4b131ea5efbe9d258f719822d6") |
| 2353 | ;;; Generated autoloads from hfy-cmap.el | 2353 | ;;; Generated autoloads from hfy-cmap.el |
| 2354 | 2354 | ||
| 2355 | (autoload 'htmlfontify-load-rgb-file "hfy-cmap" "\ | 2355 | (autoload 'htmlfontify-load-rgb-file "hfy-cmap" "\ |
diff --git a/lisp/simple.el b/lisp/simple.el index a029ef74f44..3cdac1e19f0 100644 --- a/lisp/simple.el +++ b/lisp/simple.el | |||
| @@ -5609,7 +5609,23 @@ it skips the contents of comments that end before point." | |||
| 5609 | (message "Matches %s" | 5609 | (message "Matches %s" |
| 5610 | (substring-no-properties open-paren-line-string))))))))) | 5610 | (substring-no-properties open-paren-line-string))))))))) |
| 5611 | 5611 | ||
| 5612 | (setq blink-paren-function 'blink-matching-open) | 5612 | (defvar blink-paren-function 'blink-matching-open |
| 5613 | "Function called, if non-nil, whenever a close parenthesis is inserted. | ||
| 5614 | More precisely, a char with closeparen syntax is self-inserted.") | ||
| 5615 | |||
| 5616 | (defun blink-paren-post-self-insert-function () | ||
| 5617 | (when (and (eq (char-before) last-command-event) ; Sanity check. | ||
| 5618 | (memq (char-syntax last-command-event) '(?\) ?\$)) | ||
| 5619 | blink-paren-function | ||
| 5620 | (not executing-kbd-macro) | ||
| 5621 | (not noninteractive)) | ||
| 5622 | (funcall blink-paren-function))) | ||
| 5623 | |||
| 5624 | (add-hook 'post-self-insert-hook #'blink-paren-post-self-insert-function | ||
| 5625 | ;; Most likely, this hook is nil, so this arg doesn't matter, | ||
| 5626 | ;; but I use it as a reminder that this function usually | ||
| 5627 | ;; likes to be run after others since it does `sit-for'. | ||
| 5628 | 'append) | ||
| 5613 | 5629 | ||
| 5614 | ;; This executes C-g typed while Emacs is waiting for a command. | 5630 | ;; This executes C-g typed while Emacs is waiting for a command. |
| 5615 | ;; Quitting out of a program does not go through here; | 5631 | ;; Quitting out of a program does not go through here; |
diff --git a/src/ChangeLog b/src/ChangeLog index d1f789f5dcb..8e656b525ef 100644 --- a/src/ChangeLog +++ b/src/ChangeLog | |||
| @@ -1,3 +1,11 @@ | |||
| 1 | 2010-09-01 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * cmds.c (Vblink_paren_function): Remove. | ||
| 4 | (internal_self_insert): Make it insert N chars at a time. | ||
| 5 | Don't call blink-paren-function. | ||
| 6 | (Fself_insert_command): Adjust accordingly. | ||
| 7 | (syms_of_cmds): Don't declare blink-paren-function. | ||
| 8 | |||
| 1 | 2010-08-31 Kenichi Handa <handa@m17n.org> | 9 | 2010-08-31 Kenichi Handa <handa@m17n.org> |
| 2 | 10 | ||
| 3 | * dispextern.h (FACE_FOR_CHAR): Use an ASCII face for 8-bit | 11 | * dispextern.h (FACE_FOR_CHAR): Use an ASCII face for 8-bit |
diff --git a/src/cmds.c b/src/cmds.c index f306ede7ca5..f12e759b7a6 100644 --- a/src/cmds.c +++ b/src/cmds.c | |||
| @@ -32,7 +32,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 32 | #include "dispextern.h" | 32 | #include "dispextern.h" |
| 33 | #include "frame.h" | 33 | #include "frame.h" |
| 34 | 34 | ||
| 35 | Lisp_Object Qkill_forward_chars, Qkill_backward_chars, Vblink_paren_function; | 35 | Lisp_Object Qkill_forward_chars, Qkill_backward_chars; |
| 36 | 36 | ||
| 37 | /* A possible value for a buffer's overwrite-mode variable. */ | 37 | /* A possible value for a buffer's overwrite-mode variable. */ |
| 38 | Lisp_Object Qoverwrite_mode_binary; | 38 | Lisp_Object Qoverwrite_mode_binary; |
| @@ -304,36 +304,16 @@ After insertion, the value of `auto-fill-function' is called if the | |||
| 304 | { | 304 | { |
| 305 | int character = translate_char (Vtranslation_table_for_input, | 305 | int character = translate_char (Vtranslation_table_for_input, |
| 306 | XINT (last_command_event)); | 306 | XINT (last_command_event)); |
| 307 | if (XINT (n) >= 2 && NILP (current_buffer->overwrite_mode)) | 307 | int val = internal_self_insert (character, XFASTINT (n)); |
| 308 | { | 308 | if (val == 2) |
| 309 | XSETFASTINT (n, XFASTINT (n) - 2); | 309 | nonundocount = 0; |
| 310 | /* The first one might want to expand an abbrev. */ | 310 | frame_make_pointer_invisible (); |
| 311 | internal_self_insert (character, 1); | ||
| 312 | /* The bulk of the copies of this char can be inserted simply. | ||
| 313 | We don't have to handle a user-specified face specially | ||
| 314 | because it will get inherited from the first char inserted. */ | ||
| 315 | Finsert_char (make_number (character), n, Qt); | ||
| 316 | /* The last one might want to auto-fill. */ | ||
| 317 | internal_self_insert (character, 0); | ||
| 318 | } | ||
| 319 | else | ||
| 320 | while (XINT (n) > 0) | ||
| 321 | { | ||
| 322 | int val; | ||
| 323 | /* Ok since old and new vals both nonneg */ | ||
| 324 | XSETFASTINT (n, XFASTINT (n) - 1); | ||
| 325 | val = internal_self_insert (character, XFASTINT (n) != 0); | ||
| 326 | if (val == 2) | ||
| 327 | nonundocount = 0; | ||
| 328 | frame_make_pointer_invisible (); | ||
| 329 | } | ||
| 330 | } | 311 | } |
| 331 | 312 | ||
| 332 | return Qnil; | 313 | return Qnil; |
| 333 | } | 314 | } |
| 334 | 315 | ||
| 335 | /* Insert character C. If NOAUTOFILL is nonzero, don't do autofill | 316 | /* Insert N times character C |
| 336 | even if it is enabled. | ||
| 337 | 317 | ||
| 338 | If this insertion is suitable for direct output (completely simple), | 318 | If this insertion is suitable for direct output (completely simple), |
| 339 | return 0. A value of 1 indicates this *might* not have been simple. | 319 | return 0. A value of 1 indicates this *might* not have been simple. |
| @@ -343,12 +323,12 @@ static Lisp_Object Qexpand_abbrev; | |||
| 343 | static Lisp_Object Qpost_self_insert_hook, Vpost_self_insert_hook; | 323 | static Lisp_Object Qpost_self_insert_hook, Vpost_self_insert_hook; |
| 344 | 324 | ||
| 345 | static int | 325 | static int |
| 346 | internal_self_insert (int c, int noautofill) | 326 | internal_self_insert (int c, int n) |
| 347 | { | 327 | { |
| 348 | int hairy = 0; | 328 | int hairy = 0; |
| 349 | Lisp_Object tem; | 329 | Lisp_Object tem; |
| 350 | register enum syntaxcode synt; | 330 | register enum syntaxcode synt; |
| 351 | Lisp_Object overwrite, string; | 331 | Lisp_Object overwrite; |
| 352 | /* Length of multi-byte form of C. */ | 332 | /* Length of multi-byte form of C. */ |
| 353 | int len; | 333 | int len; |
| 354 | /* Working buffer and pointer for multi-byte form of C. */ | 334 | /* Working buffer and pointer for multi-byte form of C. */ |
| @@ -391,32 +371,22 @@ internal_self_insert (int c, int noautofill) | |||
| 391 | /* This is the character after point. */ | 371 | /* This is the character after point. */ |
| 392 | int c2 = FETCH_CHAR (PT_BYTE); | 372 | int c2 = FETCH_CHAR (PT_BYTE); |
| 393 | 373 | ||
| 394 | /* Column the cursor should be placed at after this insertion. | ||
| 395 | The correct value should be calculated only when necessary. */ | ||
| 396 | int target_clm = 0; | ||
| 397 | |||
| 398 | /* Overwriting in binary-mode always replaces C2 by C. | 374 | /* Overwriting in binary-mode always replaces C2 by C. |
| 399 | Overwriting in textual-mode doesn't always do that. | 375 | Overwriting in textual-mode doesn't always do that. |
| 400 | It inserts newlines in the usual way, | 376 | It inserts newlines in the usual way, |
| 401 | and inserts any character at end of line | 377 | and inserts any character at end of line |
| 402 | or before a tab if it doesn't use the whole width of the tab. */ | 378 | or before a tab if it doesn't use the whole width of the tab. */ |
| 403 | if (EQ (overwrite, Qoverwrite_mode_binary) | 379 | if (EQ (overwrite, Qoverwrite_mode_binary)) |
| 404 | || (c != '\n' | 380 | chars_to_delete = n; |
| 405 | && c2 != '\n' | 381 | else if (c != '\n' && c2 != '\n') |
| 406 | && ! (c2 == '\t' | ||
| 407 | && XINT (current_buffer->tab_width) > 0 | ||
| 408 | && XFASTINT (current_buffer->tab_width) < 20 | ||
| 409 | && (target_clm = ((int) current_column () /* iftc */ | ||
| 410 | + XINT (Fchar_width (make_number (c)))), | ||
| 411 | target_clm % XFASTINT (current_buffer->tab_width))))) | ||
| 412 | { | 382 | { |
| 413 | int pos = PT; | 383 | int pos = PT; |
| 414 | int pos_byte = PT_BYTE; | 384 | int pos_byte = PT_BYTE; |
| 385 | /* Column the cursor should be placed at after this insertion. | ||
| 386 | The correct value should be calculated only when necessary. */ | ||
| 387 | int target_clm = ((int) current_column () /* iftc */ | ||
| 388 | + n * XINT (Fchar_width (make_number (c)))); | ||
| 415 | 389 | ||
| 416 | if (target_clm == 0) | ||
| 417 | chars_to_delete = 1; | ||
| 418 | else | ||
| 419 | { | ||
| 420 | /* The actual cursor position after the trial of moving | 390 | /* The actual cursor position after the trial of moving |
| 421 | to column TARGET_CLM. It is greater than TARGET_CLM | 391 | to column TARGET_CLM. It is greater than TARGET_CLM |
| 422 | if the TARGET_CLM is middle of multi-column | 392 | if the TARGET_CLM is middle of multi-column |
| @@ -428,14 +398,18 @@ internal_self_insert (int c, int noautofill) | |||
| 428 | chars_to_delete = PT - pos; | 398 | chars_to_delete = PT - pos; |
| 429 | 399 | ||
| 430 | if (actual_clm > target_clm) | 400 | if (actual_clm > target_clm) |
| 431 | { | 401 | { /* We will delete too many columns. Let's fill columns |
| 432 | /* We will delete too many columns. Let's fill columns | ||
| 433 | by spaces so that the remaining text won't move. */ | 402 | by spaces so that the remaining text won't move. */ |
| 403 | EMACS_INT actual = PT_BYTE; | ||
| 404 | DEC_POS (actual); | ||
| 405 | if (FETCH_CHAR (actual) == '\t') | ||
| 406 | /* Rather than add spaces, let's just keep the tab. */ | ||
| 407 | chars_to_delete--; | ||
| 408 | else | ||
| 434 | spaces_to_insert = actual_clm - target_clm; | 409 | spaces_to_insert = actual_clm - target_clm; |
| 435 | } | 410 | } |
| 436 | } | 411 | |
| 437 | SET_PT_BOTH (pos, pos_byte); | 412 | SET_PT_BOTH (pos, pos_byte); |
| 438 | hairy = 2; | ||
| 439 | } | 413 | } |
| 440 | hairy = 2; | 414 | hairy = 2; |
| 441 | } | 415 | } |
| @@ -474,16 +448,30 @@ internal_self_insert (int c, int noautofill) | |||
| 474 | 448 | ||
| 475 | if (chars_to_delete) | 449 | if (chars_to_delete) |
| 476 | { | 450 | { |
| 477 | string = make_string_from_bytes (str, 1, len); | 451 | int mc = ((NILP (current_buffer->enable_multibyte_characters) |
| 452 | && SINGLE_BYTE_CHAR_P (c)) | ||
| 453 | ? UNIBYTE_TO_CHAR (c) : c); | ||
| 454 | Lisp_Object string = Fmake_string (make_number (n), make_number (mc)); | ||
| 455 | |||
| 478 | if (spaces_to_insert) | 456 | if (spaces_to_insert) |
| 479 | { | 457 | { |
| 480 | tem = Fmake_string (make_number (spaces_to_insert), | 458 | tem = Fmake_string (make_number (spaces_to_insert), |
| 481 | make_number (' ')); | 459 | make_number (' ')); |
| 482 | string = concat2 (tem, string); | 460 | string = concat2 (string, tem); |
| 483 | } | 461 | } |
| 484 | 462 | ||
| 485 | replace_range (PT, PT + chars_to_delete, string, 1, 1, 1); | 463 | replace_range (PT, PT + chars_to_delete, string, 1, 1, 1); |
| 486 | Fforward_char (make_number (1 + spaces_to_insert)); | 464 | Fforward_char (make_number (n + spaces_to_insert)); |
| 465 | } | ||
| 466 | else if (n > 1) | ||
| 467 | { | ||
| 468 | USE_SAFE_ALLOCA; | ||
| 469 | unsigned char *strn, *p; | ||
| 470 | SAFE_ALLOCA (strn, unsigned char*, n * len); | ||
| 471 | for (p = strn; n > 0; n--, p += len) | ||
| 472 | memcpy (p, str, len); | ||
| 473 | insert_and_inherit (strn, p - strn); | ||
| 474 | SAFE_FREE (); | ||
| 487 | } | 475 | } |
| 488 | else | 476 | else |
| 489 | insert_and_inherit (str, len); | 477 | insert_and_inherit (str, len); |
| @@ -491,7 +479,6 @@ internal_self_insert (int c, int noautofill) | |||
| 491 | if ((CHAR_TABLE_P (Vauto_fill_chars) | 479 | if ((CHAR_TABLE_P (Vauto_fill_chars) |
| 492 | ? !NILP (CHAR_TABLE_REF (Vauto_fill_chars, c)) | 480 | ? !NILP (CHAR_TABLE_REF (Vauto_fill_chars, c)) |
| 493 | : (c == ' ' || c == '\n')) | 481 | : (c == ' ' || c == '\n')) |
| 494 | && !noautofill | ||
| 495 | && !NILP (current_buffer->auto_fill_function)) | 482 | && !NILP (current_buffer->auto_fill_function)) |
| 496 | { | 483 | { |
| 497 | Lisp_Object tem; | 484 | Lisp_Object tem; |
| @@ -509,13 +496,6 @@ internal_self_insert (int c, int noautofill) | |||
| 509 | hairy = 2; | 496 | hairy = 2; |
| 510 | } | 497 | } |
| 511 | 498 | ||
| 512 | if ((synt == Sclose || synt == Smath) | ||
| 513 | && !NILP (Vblink_paren_function) && INTERACTIVE | ||
| 514 | && !noautofill) | ||
| 515 | { | ||
| 516 | call0 (Vblink_paren_function); | ||
| 517 | hairy = 2; | ||
| 518 | } | ||
| 519 | /* Run hooks for electric keys. */ | 499 | /* Run hooks for electric keys. */ |
| 520 | call1 (Vrun_hooks, Qpost_self_insert_hook); | 500 | call1 (Vrun_hooks, Qpost_self_insert_hook); |
| 521 | 501 | ||
| @@ -547,11 +527,6 @@ syms_of_cmds (void) | |||
| 547 | This run is run after inserting the charater. */); | 527 | This run is run after inserting the charater. */); |
| 548 | Vpost_self_insert_hook = Qnil; | 528 | Vpost_self_insert_hook = Qnil; |
| 549 | 529 | ||
| 550 | DEFVAR_LISP ("blink-paren-function", &Vblink_paren_function, | ||
| 551 | doc: /* Function called, if non-nil, whenever a close parenthesis is inserted. | ||
| 552 | More precisely, a char with closeparen syntax is self-inserted. */); | ||
| 553 | Vblink_paren_function = Qnil; | ||
| 554 | |||
| 555 | defsubr (&Sforward_point); | 530 | defsubr (&Sforward_point); |
| 556 | defsubr (&Sforward_char); | 531 | defsubr (&Sforward_char); |
| 557 | defsubr (&Sbackward_char); | 532 | defsubr (&Sbackward_char); |