diff options
| author | Miles Bader | 2004-10-22 10:13:52 +0000 |
|---|---|---|
| committer | Miles Bader | 2004-10-22 10:13:52 +0000 |
| commit | 5ea24f9468ea9fb01253a98343a67fdb74d1817e (patch) | |
| tree | 434ee6dc5f051d6deaf0c357b97b656d16e4ed12 /lisp | |
| parent | 56c68b971d6f7665dd035df1ff302d794c0f294a (diff) | |
| parent | d5ddd795bdab373fe62ccfd099c270fd97da0964 (diff) | |
| download | emacs-5ea24f9468ea9fb01253a98343a67fdb74d1817e.tar.gz emacs-5ea24f9468ea9fb01253a98343a67fdb74d1817e.zip | |
Revision: miles@gnu.org--gnu-2004/emacs--unicode--0--patch-62
Merge from emacs--cvs-trunk--0
Patches applied:
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-616
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-620
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-621
Merge from gnus--rel--5.10
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-622
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-625
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-626
Merge from gnus--rel--5.10
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-627
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-628
Merge from gnus--rel--5.10
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-629
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-630
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-631
Merge from gnus--rel--5.10
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-632
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-633
Merge from gnus--rel--5.10
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-51
- miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-52
Update from CVS
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-53
Merge from emacs--cvs-trunk--0
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-54
- miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-55
Update from CVS
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-56
Update from CVS: Add lisp/legacy-gnus-agent.el
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-57
- miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-58
Update from CVS
Diffstat (limited to 'lisp')
88 files changed, 4034 insertions, 1807 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 41606eb7e93..556f9ad2a94 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,10 +1,255 @@ | |||
| 1 | 2004-10-21 Jay Belanger <belanger@truman.edu> | ||
| 2 | |||
| 3 | * calc/calc-aent.el (calc-alg-ent-map, calc-alg-ent-esc-map): | ||
| 4 | Declared these variables with defvar. | ||
| 5 | |||
| 6 | * calc/calc-aent.el (calc-do-alg-entry): Since `calc-alg-ent-map' | ||
| 7 | is bound, only check to see if it is bound. | ||
| 8 | |||
| 9 | 2004-10-21 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 10 | |||
| 11 | * calc/calc-help.el (calc-describe-bindings): Fix last change. | ||
| 12 | |||
| 13 | 2004-10-21 John Paul Wallington <jpw@gnu.org> | ||
| 14 | |||
| 15 | * calc/calc-graph.el (calc-graph-init): | ||
| 16 | Use `set-process-query-on-exit-flag'. | ||
| 17 | |||
| 18 | 2004-10-21 Daniel Pfeiffer <occitan@esperanto.org> | ||
| 19 | |||
| 20 | * progmodes/compile.el (compilation-start): Rely on `cd' to get | ||
| 21 | dir right and also allow argumentless cd. | ||
| 22 | |||
| 23 | 2004-10-19 Richard M. Stallman <rms@gnu.org> | ||
| 24 | |||
| 25 | * textmodes/flyspell.el (flyspell-mode): Doc fix. | ||
| 26 | |||
| 27 | * eshell/em-unix.el (eshell-grep): | ||
| 28 | Don't bind compilation-process-setup-function. | ||
| 29 | |||
| 30 | * comint.el (comint-insert-input): Use @ in `interactive'. | ||
| 31 | (comint-input-filter-functions): Doc fix. | ||
| 32 | (comint-kill-whole-line, comint-get-source): Doc fix. | ||
| 33 | |||
| 34 | * progmodes/compile.el (compilation-setup): | ||
| 35 | Don't set buffer-read-only if MINOR is non-nil. | ||
| 36 | |||
| 37 | 2004-10-19 Jay Belanger <belanger@truman.edu> | ||
| 38 | |||
| 39 | * calc/calc.el (calc-emacs-type-19, calc-emacs-type-epoch) | ||
| 40 | (calc-emacs-type-gnu19): Remove. | ||
| 41 | (calc-digit-map, calc-read-key-sequence, calc-read-key): | ||
| 42 | Remove check for old emacs versions. | ||
| 43 | |||
| 44 | * calc/calc-ext.el (calc-fancy-prefix): Remove emacs version check. | ||
| 45 | (calc-init-extensions): Define `calc-alg-map' and `calc-alg-esc-map' | ||
| 46 | for current Emacs. | ||
| 47 | |||
| 48 | * calc/calc-aent.el (calcAlg-previous): Check to see if looking at | ||
| 49 | the end of the minibuffer. | ||
| 50 | (calc-do-alg-entry): Remove Emacs version check. Use `copy-keymap' to | ||
| 51 | copy `esc-map'. | ||
| 52 | |||
| 53 | * calc/calc-graph.el (calc-graph-plot): Remove emacs version check. | ||
| 54 | |||
| 55 | * calc/calc-mode.el (calc-total-algebraic-mode): Remove error | ||
| 56 | call that would be given when the current emacs was used. | ||
| 57 | |||
| 58 | 2004-10-19 Ulf Jasper <ulf.jasper@web.de> | ||
| 59 | |||
| 60 | * calendar/icalendar.el: Set coding to utf-8. | ||
| 61 | (icalendar-version): Increase to 0.07. | ||
| 62 | (icalendar-monthnumber-table): Change March pattern. | ||
| 63 | (icalendar-get-all-event-properties) | ||
| 64 | (icalendar-set-event-property): Delete. | ||
| 65 | (icalendar-all-events): No longer interactive. | ||
| 66 | (icalendar-convert-diary-to-ical) | ||
| 67 | (icalendar-extract-ical-from-buffer): Make obsolete, and alias to | ||
| 68 | their replacements. | ||
| 69 | (icalendar-export-file, icalendar-export-region): New functions; | ||
| 70 | essentially old `icalendar-convert-diary-to-ical' but appending to | ||
| 71 | target rather than overwriting. | ||
| 72 | (icalendar-import-file): Append to target file rather than | ||
| 73 | overwriting. Fourth arg deleted. | ||
| 74 | (icalendar-import-buffer): New name for old | ||
| 75 | `icalendar-extract-ical-from-buffer'. | ||
| 76 | (icalendar--convert-string-for-import): New name for | ||
| 77 | old `icalendar-convert-for-import'. | ||
| 78 | (include-icalendar-files): Delete. | ||
| 79 | Prefix for all internal functions changed from `icalendar-' | ||
| 80 | to `icalendar--'. | ||
| 81 | |||
| 82 | 2004-10-19 Richard M. Stallman <rms@gnu.org> | ||
| 83 | |||
| 84 | * paths.el (news-path): Fix previous change. | ||
| 85 | |||
| 86 | 2004-10-18 Jay Belanger <belanger@truman.edu> | ||
| 87 | |||
| 88 | * calc/calc-help.el (calc-describe-bindings): | ||
| 89 | Set `buffer-read-only' to nil while working in the keybindings buffer; | ||
| 90 | remove some extra information from the keybindings buffer. | ||
| 91 | |||
| 92 | 2004-10-18 David Ponce <david@dponce.com> | ||
| 93 | |||
| 94 | * mouse.el (mouse-drag-move-window-top): New function. | ||
| 95 | (mouse-drag-mode-line-1): Use it. | ||
| 96 | |||
| 97 | 2004-10-18 Thien-Thi Nguyen <ttn@gnu.org> | ||
| 98 | |||
| 99 | * info.el (Info-fontify-node): For multiline refs, | ||
| 100 | arrange to unfontify newline and surrounding whitespace. | ||
| 101 | |||
| 102 | 2004-10-17 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 103 | |||
| 104 | * vc-arch.el (vc-arch-workfile-version): Don't burp if the patch-log | ||
| 105 | directory is missing. | ||
| 106 | |||
| 107 | 2004-10-17 John Paul Wallington <jpw@gnu.org> | ||
| 108 | |||
| 109 | * ibuffer.el (ibuffer-default-display-maybe-show-predicates): | ||
| 110 | New customizable variable; whether to display buffers that match | ||
| 111 | `ibuffer-maybe-show-predicates' by default. | ||
| 112 | (ibuffer-maybe-show-predicates): Mention it in docstring. | ||
| 113 | (ibuffer-display-maybe-show-predicates): New variable. | ||
| 114 | (ibuffer-update): Prefix arg now toggles whether buffers that | ||
| 115 | match `ibuffer-maybe-show-predicates' should be displayed. | ||
| 116 | (ibuffer-mode): Set `ibuffer-display-maybe-show-predicates' | ||
| 117 | locally to heed `ibuffer-default-display-maybe-show-predicates'. | ||
| 118 | (ibuffer-redisplay-engine): Rename optional second arg to `ignore'. | ||
| 119 | |||
| 120 | 2004-10-17 Michael Albinus <michael.albinus@gmx.de> | ||
| 121 | |||
| 122 | * net/tramp.el: Redo sync with Tramp 2.0.45. Last commit did not | ||
| 123 | work correctly. | ||
| 124 | |||
| 125 | 2004-10-17 Daniel Pfeiffer <occitan@esperanto.org> | ||
| 126 | |||
| 127 | * buff-menu.el (Buffer-menu-revert-function): Emulate save-excursion. | ||
| 128 | (Buffer-menu-beginning): New helper function. | ||
| 129 | (Buffer-menu-execute): Use it. | ||
| 130 | (Buffer-menu-select): Use it. | ||
| 131 | (Buffer-menu-sort): Use it and also keep markers. | ||
| 132 | |||
| 133 | 2004-10-17 Richard M. Stallman <rms@gnu.org> | ||
| 134 | |||
| 135 | * paths.el (news-directory): Rename from news-path. Old name alias. | ||
| 136 | (rmail-spool-directory): Use defvar. | ||
| 137 | (sendmail-program): Use defcustom. | ||
| 138 | (remote-shell-program): Use defcustom. | ||
| 139 | (term-file-prefix): Use defvar. | ||
| 140 | (abbrev-file-name): Use defvar. | ||
| 141 | |||
| 142 | * term.el: Add maintainer. | ||
| 143 | |||
| 144 | * subr.el (with-local-quit): Return nil if there's a quit. | ||
| 145 | (read-passwd): Use with-local-quit. Doc fix. | ||
| 146 | |||
| 147 | * strokes.el (strokes-list-strokes): Don't try to delete char at eob. | ||
| 148 | (strokes-unload-hook): Set as a variable with add-hook. | ||
| 149 | |||
| 150 | * startup.el (fancy-splash-tail, normal-splash-screen): | ||
| 151 | Update copyright year. | ||
| 152 | |||
| 153 | * shadowfile.el (shadowfile-unload-hook): Set as variable w/ add-hook. | ||
| 154 | |||
| 155 | * server.el (server-unload-hook): Set as a variable with add-hook. | ||
| 156 | |||
| 157 | * help-at-pt.el (help-at-pt-unload-hook): Use add-hook; no defvar. | ||
| 158 | |||
| 159 | * frame.el (special-display-popup-frame): | ||
| 160 | Make the buffer current as its frame is created. | ||
| 161 | |||
| 162 | * delsel.el (delsel-unload-hook): Set as a variable. | ||
| 163 | |||
| 164 | * comint.el (comint-output-filter-functions): | ||
| 165 | Add comint-watch-for-password-prompt. | ||
| 166 | (comint-read-noecho): Function deleted. | ||
| 167 | (send-invisible): Use read-passwd. | ||
| 168 | |||
| 169 | * fringe.el (fringe-mode-initialize): New function. | ||
| 170 | (fringe-mode): Use fringe-mode-initialize as :initialize. | ||
| 171 | |||
| 172 | 2004-10-17 Kim F. Storm <storm@cua.dk> | ||
| 173 | |||
| 174 | * language/indian.el (indian-script-language-alist): Swap value and doc. | ||
| 175 | (indian-font-char-index-table): Doc fix. | ||
| 176 | |||
| 177 | 2004-10-16 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 178 | |||
| 179 | * vc-hooks.el (vc-find-file-hook): Call vc-backend with absolute name. | ||
| 180 | |||
| 181 | 2004-10-16 Juri Linkov <juri@jurta.org> | ||
| 182 | |||
| 183 | * progmodes/compile.el (compilation-start): Move let-binding of | ||
| 184 | `process-environment' into `with-current-buffer' body. | ||
| 185 | Reported by Matt Hodges <MPHodges@member.fsf.org>. | ||
| 186 | |||
| 187 | 2004-10-16 Richard M. Stallman <rms@gnu.org> | ||
| 188 | |||
| 189 | * pcvs-util.el (cvs-bury-buffer): | ||
| 190 | Don't call get-buffer-window for effect. | ||
| 191 | |||
| 192 | * outline.el (hide-other): Call outline-up-heading with INVISIBLE-OK=t. | ||
| 193 | |||
| 194 | * newcomment.el (comment-auto-fill-only-comments): Add autoload. | ||
| 195 | |||
| 196 | * msb.el (msb-unload-hook): Set the variable. | ||
| 197 | |||
| 198 | * mouse.el (mouse-yank-at-click, mouse-yank-secondary): | ||
| 199 | Use * to err if buffer is readonly. | ||
| 200 | |||
| 201 | * subr.el (looking-back): Return only t or nil. | ||
| 202 | |||
| 203 | * whitespace.el (whitespace-unload-hook): Set the variable. | ||
| 204 | |||
| 205 | * view.el (view-mode-enable): Set view-page-size and | ||
| 206 | view-half-page-size to nil. | ||
| 207 | (view-set-half-page-size-default): view-half-page-size = nil | ||
| 208 | means the default. | ||
| 209 | (View-scroll-page-forward): Use view-page-size-default. | ||
| 210 | (View-scroll-page-backward): Likewise. | ||
| 211 | (view-page-size, view-half-page-size): Doc fixes. | ||
| 212 | |||
| 213 | * emacs-lisp/elp.el (elp-unload-hook): Set the variable. | ||
| 214 | |||
| 215 | * emacs-lisp/cl.el (cl-unload-hook): Don't defvar it, just set it. | ||
| 216 | |||
| 217 | * emacs-lisp/bytecomp.el (byte-compile-eval): Don't process | ||
| 218 | "cl" like other files. Instead, call byte-compile-find-cl-functions. | ||
| 219 | (byte-compile-log-1): Bind inhibit-read-only. | ||
| 220 | (byte-compile-warning-prefix, byte-compile-log-file): Likewise. | ||
| 221 | (byte-compile-log-warning): Likewise. | ||
| 222 | (byte-compile-file-form-require): Detect "cl" from the arg value. | ||
| 223 | |||
| 224 | * progmodes/compile.el (compilation-start): Assume compilation-mode | ||
| 225 | will make the buffer read-only. | ||
| 226 | (compilation-mode): Take arg name-of-mode. | ||
| 227 | (compilation-setup): Make buffer read-only. | ||
| 228 | (compilation-handle-exit): Bind inhibit-read-only. | ||
| 229 | |||
| 230 | * textmodes/ispell.el (ispell-command-loop): Use with-no-warnings. | ||
| 231 | (ispell-message): Likewise. | ||
| 232 | (ispell-show-choices): Don't call get-buffer-window uselessly. | ||
| 233 | (ispell-init-process): Use set-process-query-on-exit-flag. | ||
| 234 | |||
| 235 | 2004-10-16 Kim F. Storm <storm@cua.dk> | ||
| 236 | |||
| 237 | * fringe.el (fringe-bitmaps): Only initialize when defined. | ||
| 238 | |||
| 239 | * pcvs.el (cvs-mode-view-file, cvs-mode-view-file-other-window): Add. | ||
| 240 | (cvs-mode-find-file): Add optional `view' arg to enter view mode. | ||
| 241 | |||
| 242 | * pcvs-defs.el (cvs-mode-map): Bind v to cvs-mode-view-file. | ||
| 243 | |||
| 244 | 2004-10-15 Simon Josefsson <jas@extundo.com> | ||
| 245 | |||
| 246 | * net/password.el: Add. | ||
| 247 | |||
| 1 | 2004-10-13 Daniel Pfeiffer <occitan@esperanto.org> | 248 | 2004-10-13 Daniel Pfeiffer <occitan@esperanto.org> |
| 2 | 249 | ||
| 3 | * button.el (button-activate): Allow a marker to display as an | 250 | * button.el (button-activate): Allow a marker to display as an action. |
| 4 | action. | ||
| 5 | 251 | ||
| 6 | * help-fns.el (describe-variable): Use it to make "below" a | 252 | * help-fns.el (describe-variable): Use it to make "below" a hyperlink. |
| 7 | hyperlink. | ||
| 8 | 253 | ||
| 9 | * help.el (describe-mode): Use it to make minor mode list into | 254 | * help.el (describe-mode): Use it to make minor mode list into |
| 10 | hyperlinks. | 255 | hyperlinks. |
| @@ -25,6 +270,25 @@ | |||
| 25 | (event-modifiers): Use push. | 270 | (event-modifiers): Use push. |
| 26 | (mouse-movement-p, with-temp-buffer): Simplify. | 271 | (mouse-movement-p, with-temp-buffer): Simplify. |
| 27 | 272 | ||
| 273 | 2004-10-12 Jay Belanger <belanger@truman.edu> | ||
| 274 | |||
| 275 | * calc/calc-help.el (calc-help-function-list, calc-help-variable-list): | ||
| 276 | New variables. | ||
| 277 | (calc-help-index-entries): New function. | ||
| 278 | (calc-describe-function): Use `calc-help-function-list' instead of | ||
| 279 | obarray for completion. | ||
| 280 | (calc-describe-variable): Use `calc-help-variable-list' instead | ||
| 281 | of obarray for completion. | ||
| 282 | |||
| 283 | 2004-10-12 Richard M. Stallman <rms@gnu.org> | ||
| 284 | |||
| 285 | * info-look.el (info-lookup-file): Add info-file property. | ||
| 286 | (info-lookup-symbol): Likewise. | ||
| 287 | |||
| 288 | * info.el (info-xref): Add underlining. | ||
| 289 | (info): Add info-file property. | ||
| 290 | (Info-find-emacs-command-nodes): Specify case-sensitive search. | ||
| 291 | |||
| 28 | 2004-10-12 Michael Albinus <michael.albinus@gmx.de> | 292 | 2004-10-12 Michael Albinus <michael.albinus@gmx.de> |
| 29 | 293 | ||
| 30 | Sync with Tramp 2.0.45. | 294 | Sync with Tramp 2.0.45. |
| @@ -78,6 +342,15 @@ | |||
| 78 | * subr.el (substitute-key-definition): Mention command remapping | 342 | * subr.el (substitute-key-definition): Mention command remapping |
| 79 | in doc string. | 343 | in doc string. |
| 80 | 344 | ||
| 345 | 2004-10-11 Jay Belanger <belanger@truman.edu> | ||
| 346 | |||
| 347 | * calc/calc-misc.el (calc-info-goto-node): New function. | ||
| 348 | (calc-tutorial, calc-info-summary): Go to appropriate Calc info | ||
| 349 | node in one step. | ||
| 350 | (calc-describe-copying, calc-describe-distribution) | ||
| 351 | (calc-describe-thing, calc-describe-no-warranty, calc-describe-key): | ||
| 352 | Go to appropriate info node in one step. | ||
| 353 | |||
| 81 | 2004-10-11 Stefan Monnier <monnier@iro.umontreal.ca> | 354 | 2004-10-11 Stefan Monnier <monnier@iro.umontreal.ca> |
| 82 | 355 | ||
| 83 | * pcvs-defs.el (pcl-cvs-load-hook): Remove unused var. | 356 | * pcvs-defs.el (pcl-cvs-load-hook): Remove unused var. |
| @@ -201,7 +474,7 @@ | |||
| 201 | 2004-10-05 Juri Linkov <juri@jurta.org> | 474 | 2004-10-05 Juri Linkov <juri@jurta.org> |
| 202 | 475 | ||
| 203 | * isearch.el (isearch-done): Set mark after running hook. | 476 | * isearch.el (isearch-done): Set mark after running hook. |
| 204 | Suggested by Drew Adams <drew.adams@oracle.com>. | 477 | Reported by Drew Adams <drew.adams@oracle.com>. |
| 205 | 478 | ||
| 206 | * info.el (Info-history, Info-toc): Fix Info headers. | 479 | * info.el (Info-history, Info-toc): Fix Info headers. |
| 207 | (Info-toc): Narrow buffer before Info-fontify-node. | 480 | (Info-toc): Narrow buffer before Info-fontify-node. |
| @@ -443,6 +716,12 @@ | |||
| 443 | 716 | ||
| 444 | * progmodes/tcl.el (inferior-tcl): Use pop-to-buffer. | 717 | * progmodes/tcl.el (inferior-tcl): Use pop-to-buffer. |
| 445 | 718 | ||
| 719 | 2004-09-21 Jay Belanger <belanger@truman.edu> | ||
| 720 | |||
| 721 | * calc/calc-graph.el (calc-graph-add-curve): Moved the call to | ||
| 722 | `calc-graph-set-styles' so the gnuplot buffer will appear in a | ||
| 723 | separate window. | ||
| 724 | |||
| 446 | 2004-09-21 Luc Teirlinck <teirllm@auburn.edu> | 725 | 2004-09-21 Luc Teirlinck <teirllm@auburn.edu> |
| 447 | 726 | ||
| 448 | * subr.el (after-change-major-mode-hook): Doc fix. | 727 | * subr.el (after-change-major-mode-hook): Doc fix. |
| @@ -457,6 +736,10 @@ | |||
| 457 | * descr-text.el (describe-char): Checking of quail activation | 736 | * descr-text.el (describe-char): Checking of quail activation |
| 458 | fixed. | 737 | fixed. |
| 459 | 738 | ||
| 739 | 2004-09-21 Jay Belanger <belanger@truman.edu> | ||
| 740 | |||
| 741 | * calc/calc.el (calc-mode-var-list): Removed unnecessary quotes. | ||
| 742 | |||
| 460 | 2004-09-20 Luc Teirlinck <teirllm@auburn.edu> | 743 | 2004-09-20 Luc Teirlinck <teirllm@auburn.edu> |
| 461 | 744 | ||
| 462 | * subr.el (run-mode-hooks): Run `after-change-major-mode-hook' | 745 | * subr.el (run-mode-hooks): Run `after-change-major-mode-hook' |
| @@ -542,6 +825,11 @@ | |||
| 542 | * calc/calc-units.el (calc-quick-units): Fix overzealous | 825 | * calc/calc-units.el (calc-quick-units): Fix overzealous |
| 543 | s/or/unless/. | 826 | s/or/unless/. |
| 544 | 827 | ||
| 828 | 2004-09-17 Jay Belanger <belanger@truman.edu> | ||
| 829 | |||
| 830 | * calc/calc.el (calc-mode-var-list): Fixed the value of | ||
| 831 | `calc-matrix-brackets'. | ||
| 832 | |||
| 545 | 2004-09-17 Romain Francoise <romain@orebokech.com> | 833 | 2004-09-17 Romain Francoise <romain@orebokech.com> |
| 546 | 834 | ||
| 547 | * ibuf-ext.el (define-ibuffer-filter filename): | 835 | * ibuf-ext.el (define-ibuffer-filter filename): |
| @@ -573,6 +861,44 @@ | |||
| 573 | (term-protocol-version): Increment. | 861 | (term-protocol-version): Increment. |
| 574 | (term-current-face): Set to default. | 862 | (term-current-face): Set to default. |
| 575 | 863 | ||
| 864 | 2004-09-15 Jay Belanger <belanger@truman.edu> | ||
| 865 | |||
| 866 | * calc/calc.el (calc-mode-var-list): Define this variable. | ||
| 867 | (calc-always-load-extensions, calc-line-numbering) | ||
| 868 | (calc-line-breaking, calc-display-just, calc-display-origin) | ||
| 869 | (calc-number-radix, calc-leading-zeros, calc-group-digits) | ||
| 870 | (calc-group-char, calc-point-char, calc-frac-format) | ||
| 871 | (calc-prefer-frac, calc-hms-format, calc-date-format) | ||
| 872 | (calc-float-format, calc-full-float-format, calc-complex-format) | ||
| 873 | (calc-complex-mode, calc-infinite-mode, calc-display-strings) | ||
| 874 | (calc-matrix-just, calc-break-vectors, calc-full-vectors) | ||
| 875 | (calc-full-trail-vectors, calc-vector-commas, calc-vector-brackets) | ||
| 876 | (calc-matrix-brackets, calc-language, calc-language-option) | ||
| 877 | (calc-left-label, calc-right-label, calc-word-size) | ||
| 878 | (calc-previous-modulo, calc-simplify-mode, calc-auto-recompute) | ||
| 879 | (calc-display-raw, calc-internal-prec, calc-angle-mode) | ||
| 880 | (calc-algebraic-mode, calc-incomplete-algebraic-mode) | ||
| 881 | (calc-symbolic-mode, calc-matrix-mode, calc-shift-prefix) | ||
| 882 | (calc-window-height, calc-display-trail, calc-show-selections) | ||
| 883 | (calc-use-selections, calc-assoc-selections) | ||
| 884 | (calc-display-working-message, calc-auto-why, calc-timing) | ||
| 885 | (calc-mode-save-mode, calc-standard-date-formats) | ||
| 886 | (calc-autorange-units, calc-was-keypad-mode, calc-full-mode) | ||
| 887 | (calc-user-parse-tables, calc-gnuplot-default-device) | ||
| 888 | (calc-gnuplot-default-output, calc-gnuplot-print-device) | ||
| 889 | (calc-gnuplot-print-output, calc-gnuplot-geometry) | ||
| 890 | (calc-graph-default-resolution, calc-graph-default-resolution-3d) | ||
| 891 | (calc-invocation-macro, calc-show-banner): Give these values as | ||
| 892 | part of `calc-mode-var-list's initialization after the variables | ||
| 893 | are declared with defvar. | ||
| 894 | (calc-bug-address): Changed email address to send bug | ||
| 895 | reports to. Also changed the maintainer address at the top. | ||
| 896 | (calc-mode): Compare `calc-settings-file' to `user-init-file' rather | ||
| 897 | than "\\.emacs" to determine if it is the user-init-file. | ||
| 898 | |||
| 899 | * calc/calc-embed.el (calc-embedded-set-modes): Use | ||
| 900 | `calc-mode-var-list' correctly. | ||
| 901 | |||
| 576 | 2004-09-15 Thien-Thi Nguyen <ttn@gnu.org> | 902 | 2004-09-15 Thien-Thi Nguyen <ttn@gnu.org> |
| 577 | 903 | ||
| 578 | * vc.el (annotate-time): Document point handling. | 904 | * vc.el (annotate-time): Document point handling. |
diff --git a/lisp/autorevert.el b/lisp/autorevert.el index ecf768c5732..5f6d26bfabb 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el | |||
| @@ -421,6 +421,9 @@ This is an internal function used by Auto-Revert Mode." | |||
| 421 | 'no-mini t)) | 421 | 'no-mini t)) |
| 422 | (if auto-revert-tail-mode | 422 | (if auto-revert-tail-mode |
| 423 | (auto-revert-tail-handler) | 423 | (auto-revert-tail-handler) |
| 424 | ;; Bind buffer-read-only in case user has done C-x C-q, | ||
| 425 | ;; so as not to forget that. This gives undesirable results | ||
| 426 | ;; when the file's mode changes, but that is less common. | ||
| 424 | (let ((buffer-read-only buffer-read-only)) | 427 | (let ((buffer-read-only buffer-read-only)) |
| 425 | (revert-buffer 'ignore-auto 'dont-ask 'preserve-modes))) | 428 | (revert-buffer 'ignore-auto 'dont-ask 'preserve-modes))) |
| 426 | (when buffer-file-name | 429 | (when buffer-file-name |
diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 33a8c3ec3f5..da21f5336d8 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el | |||
| @@ -197,9 +197,15 @@ Letters do not insert themselves; instead, they are commands. | |||
| 197 | 197 | ||
| 198 | (defun Buffer-menu-revert-function (ignore1 ignore2) | 198 | (defun Buffer-menu-revert-function (ignore1 ignore2) |
| 199 | ;; We can not use save-excursion here. The buffer gets erased. | 199 | ;; We can not use save-excursion here. The buffer gets erased. |
| 200 | (let ((old-point (point))) | 200 | (let ((ocol (current-column)) |
| 201 | (oline (progn (move-to-column 4) | ||
| 202 | (get-text-property (point) 'buffer))) | ||
| 203 | (prop (point-min))) | ||
| 201 | (list-buffers-noselect Buffer-menu-files-only) | 204 | (list-buffers-noselect Buffer-menu-files-only) |
| 202 | (goto-char old-point))) | 205 | (while (setq prop (next-single-property-change prop 'buffer)) |
| 206 | (when (eq (get-text-property prop 'buffer) oline) | ||
| 207 | (goto-char prop) | ||
| 208 | (move-to-column ocol))))) | ||
| 203 | 209 | ||
| 204 | (defun Buffer-menu-toggle-files-only (arg) | 210 | (defun Buffer-menu-toggle-files-only (arg) |
| 205 | "Toggle whether the current buffer-menu displays only file buffers. | 211 | "Toggle whether the current buffer-menu displays only file buffers. |
| @@ -354,13 +360,16 @@ and then move up one line. Prefix arg means move that many lines." | |||
| 354 | (delete-char 1) | 360 | (delete-char 1) |
| 355 | (insert (if arg ?* ? )))))) | 361 | (insert (if arg ?* ? )))))) |
| 356 | 362 | ||
| 363 | (defun Buffer-menu-beginning () | ||
| 364 | (goto-char (point-min)) | ||
| 365 | (unless Buffer-menu-use-header-line | ||
| 366 | (forward-line))) | ||
| 367 | |||
| 357 | (defun Buffer-menu-execute () | 368 | (defun Buffer-menu-execute () |
| 358 | "Save and/or delete buffers marked with \\<Buffer-menu-mode-map>\\[Buffer-menu-save] or \\<Buffer-menu-mode-map>\\[Buffer-menu-delete] commands." | 369 | "Save and/or delete buffers marked with \\<Buffer-menu-mode-map>\\[Buffer-menu-save] or \\<Buffer-menu-mode-map>\\[Buffer-menu-delete] commands." |
| 359 | (interactive) | 370 | (interactive) |
| 360 | (save-excursion | 371 | (save-excursion |
| 361 | (goto-char (point-min)) | 372 | (Buffer-menu-beginning) |
| 362 | (unless Buffer-menu-use-header-line | ||
| 363 | (forward-line 1)) | ||
| 364 | (while (re-search-forward "^..S" nil t) | 373 | (while (re-search-forward "^..S" nil t) |
| 365 | (let ((modp nil)) | 374 | (let ((modp nil)) |
| 366 | (save-excursion | 375 | (save-excursion |
| @@ -371,9 +380,7 @@ and then move up one line. Prefix arg means move that many lines." | |||
| 371 | (delete-char -1) | 380 | (delete-char -1) |
| 372 | (insert (if modp ?* ? )))))) | 381 | (insert (if modp ?* ? )))))) |
| 373 | (save-excursion | 382 | (save-excursion |
| 374 | (goto-char (point-min)) | 383 | (Buffer-menu-beginning) |
| 375 | (unless Buffer-menu-use-header-line | ||
| 376 | (forward-line 1)) | ||
| 377 | (let ((buff-menu-buffer (current-buffer)) | 384 | (let ((buff-menu-buffer (current-buffer)) |
| 378 | (buffer-read-only nil)) | 385 | (buffer-read-only nil)) |
| 379 | (while (re-search-forward "^D" nil t) | 386 | (while (re-search-forward "^D" nil t) |
| @@ -399,9 +406,7 @@ in the selected frame." | |||
| 399 | (menu (current-buffer)) | 406 | (menu (current-buffer)) |
| 400 | (others ()) | 407 | (others ()) |
| 401 | tem) | 408 | tem) |
| 402 | (goto-char (point-min)) | 409 | (Buffer-menu-beginning) |
| 403 | (unless Buffer-menu-use-header-line | ||
| 404 | (forward-line 1)) | ||
| 405 | (while (re-search-forward "^>" nil t) | 410 | (while (re-search-forward "^>" nil t) |
| 406 | (setq tem (Buffer-menu-buffer t)) | 411 | (setq tem (Buffer-menu-buffer t)) |
| 407 | (let ((buffer-read-only nil)) | 412 | (let ((buffer-read-only nil)) |
| @@ -581,7 +586,35 @@ For more information, see the function `buffer-menu'." | |||
| 581 | (if (< column 2) (setq column 2)) | 586 | (if (< column 2) (setq column 2)) |
| 582 | (if (> column 5) (setq column 5))) | 587 | (if (> column 5) (setq column 5))) |
| 583 | (setq Buffer-menu-sort-column column) | 588 | (setq Buffer-menu-sort-column column) |
| 584 | (Buffer-menu-revert)) | 589 | (let (buffer-read-only l buf m1 m2) |
| 590 | (save-excursion | ||
| 591 | (Buffer-menu-beginning) | ||
| 592 | (while (not (eobp)) | ||
| 593 | (when (buffer-live-p (setq buf (get-text-property (+ (point) 4) 'buffer))) | ||
| 594 | (setq m1 (char-after) | ||
| 595 | m1 (if (memq m1 '(?> ?D)) m1) | ||
| 596 | m2 (char-after (+ (point) 2)) | ||
| 597 | m2 (if (eq m2 ?S) m2)) | ||
| 598 | (if (or m1 m2) | ||
| 599 | (push (list buf m1 m2) l))) | ||
| 600 | (forward-line))) | ||
| 601 | (Buffer-menu-revert) | ||
| 602 | (setq buffer-read-only) | ||
| 603 | (save-excursion | ||
| 604 | (Buffer-menu-beginning) | ||
| 605 | (while (not (eobp)) | ||
| 606 | (when (setq buf (assq (get-text-property (+ (point) 4) 'buffer) l)) | ||
| 607 | (setq m1 (cadr buf) | ||
| 608 | m2 (cadr (cdr buf))) | ||
| 609 | (when m1 | ||
| 610 | (delete-char 1) | ||
| 611 | (insert m1) | ||
| 612 | (backward-char 1)) | ||
| 613 | (when m2 | ||
| 614 | (forward-char 2) | ||
| 615 | (delete-char 1) | ||
| 616 | (insert m2))) | ||
| 617 | (forward-line))))) | ||
| 585 | 618 | ||
| 586 | (defun Buffer-menu-make-sort-button (name column) | 619 | (defun Buffer-menu-make-sort-button (name column) |
| 587 | (if (equal column Buffer-menu-sort-column) (setq column nil)) | 620 | (if (equal column Buffer-menu-sort-column) (setq column nil)) |
| @@ -592,7 +625,9 @@ For more information, see the function `buffer-menu'." | |||
| 592 | 'mouse-face 'highlight | 625 | 'mouse-face 'highlight |
| 593 | 'keymap (let ((map (make-sparse-keymap))) | 626 | 'keymap (let ((map (make-sparse-keymap))) |
| 594 | (define-key map [header-line mouse-2] | 627 | (define-key map [header-line mouse-2] |
| 595 | `(lambda () (interactive) | 628 | `(lambda (e) |
| 629 | (interactive "e") | ||
| 630 | (if e (set-buffer (window-buffer (posn-window (event-end e))))) | ||
| 596 | (Buffer-menu-sort ,column))) | 631 | (Buffer-menu-sort ,column))) |
| 597 | map))) | 632 | map))) |
| 598 | 633 | ||
diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el index bc2f8f3b15f..2db722ccb2d 100644 --- a/lisp/calc/calc-aent.el +++ b/lisp/calc/calc-aent.el | |||
| @@ -295,24 +295,28 @@ | |||
| 295 | calc-dollar-used 0))) | 295 | calc-dollar-used 0))) |
| 296 | (calc-handle-whys)))) | 296 | (calc-handle-whys)))) |
| 297 | 297 | ||
| 298 | (defvar calc-alg-ent-map nil | ||
| 299 | "The keymap used for algebraic entry.") | ||
| 300 | |||
| 301 | (defvar calc-alg-ent-esc-map nil | ||
| 302 | "The keymap used for escapes in algebraic entry.") | ||
| 303 | |||
| 298 | (defun calc-do-alg-entry (&optional initial prompt no-normalize) | 304 | (defun calc-do-alg-entry (&optional initial prompt no-normalize) |
| 299 | (let* ((calc-buffer (current-buffer)) | 305 | (let* ((calc-buffer (current-buffer)) |
| 300 | (blink-paren-function 'calcAlg-blink-matching-open) | 306 | (blink-paren-function 'calcAlg-blink-matching-open) |
| 301 | (alg-exp 'error)) | 307 | (alg-exp 'error)) |
| 302 | (unless (boundp 'calc-alg-ent-map) | 308 | (unless calc-alg-ent-map |
| 303 | (setq calc-alg-ent-map (copy-keymap minibuffer-local-map)) | 309 | (setq calc-alg-ent-map (copy-keymap minibuffer-local-map)) |
| 304 | (define-key calc-alg-ent-map "'" 'calcAlg-previous) | 310 | (define-key calc-alg-ent-map "'" 'calcAlg-previous) |
| 305 | (define-key calc-alg-ent-map "`" 'calcAlg-edit) | 311 | (define-key calc-alg-ent-map "`" 'calcAlg-edit) |
| 306 | (define-key calc-alg-ent-map "\C-m" 'calcAlg-enter) | 312 | (define-key calc-alg-ent-map "\C-m" 'calcAlg-enter) |
| 307 | (define-key calc-alg-ent-map "\C-j" 'calcAlg-enter) | 313 | (define-key calc-alg-ent-map "\C-j" 'calcAlg-enter) |
| 308 | (or calc-emacs-type-19 | 314 | (let ((i 33)) |
| 309 | (let ((i 33)) | 315 | (setq calc-alg-ent-esc-map (copy-keymap esc-map)) |
| 310 | (setq calc-alg-ent-esc-map (copy-sequence esc-map)) | 316 | (while (< i 127) |
| 311 | (while (< i 127) | 317 | (aset (nth 1 calc-alg-ent-esc-map) i 'calcAlg-escape) |
| 312 | (aset calc-alg-ent-esc-map i 'calcAlg-escape) | 318 | (setq i (1+ i))))) |
| 313 | (setq i (1+ i)))))) | 319 | (define-key calc-alg-ent-map "\e" nil) |
| 314 | (unless calc-emacs-type-19 | ||
| 315 | (define-key calc-alg-ent-map "\e" nil)) | ||
| 316 | (if (eq calc-algebraic-mode 'total) | 320 | (if (eq calc-algebraic-mode 'total) |
| 317 | (define-key calc-alg-ent-map "\e" calc-alg-ent-esc-map) | 321 | (define-key calc-alg-ent-map "\e" calc-alg-ent-esc-map) |
| 318 | (define-key calc-alg-ent-map "\ep" 'calcAlg-plus-minus) | 322 | (define-key calc-alg-ent-map "\ep" 'calcAlg-plus-minus) |
| @@ -350,7 +354,7 @@ | |||
| 350 | 354 | ||
| 351 | (defun calcAlg-previous () | 355 | (defun calcAlg-previous () |
| 352 | (interactive) | 356 | (interactive) |
| 353 | (if (calc-minibuffer-contains "\\`\\'") | 357 | (if (calc-minibuffer-contains "\\'") |
| 354 | (if calc-previous-alg-entry | 358 | (if calc-previous-alg-entry |
| 355 | (insert calc-previous-alg-entry) | 359 | (insert calc-previous-alg-entry) |
| 356 | (beep)) | 360 | (beep)) |
diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el index 47c02bc285c..4679cf8abaa 100644 --- a/lisp/calc/calc-ext.el +++ b/lisp/calc/calc-ext.el | |||
| @@ -640,29 +640,27 @@ | |||
| 640 | (define-key calc-mode-map (format "u%c" x) 'calc-quick-units))) | 640 | (define-key calc-mode-map (format "u%c" x) 'calc-quick-units))) |
| 641 | "0123456789") | 641 | "0123456789") |
| 642 | 642 | ||
| 643 | (or calc-emacs-type-19 (progn | ||
| 644 | (let ((i ?A)) | 643 | (let ((i ?A)) |
| 645 | (while (and (<= i ?z) (vectorp calc-mode-map)) | 644 | (while (<= i ?z) |
| 646 | (if (eq (car-safe (aref calc-mode-map i)) 'keymap) | 645 | (if (eq (car-safe (aref (nth 1 calc-mode-map) i)) 'keymap) |
| 647 | (aset calc-mode-map i | 646 | (aset (nth 1 calc-mode-map) i |
| 648 | (cons 'keymap (cons (cons ?\e (aref calc-mode-map i)) | 647 | (cons 'keymap (cons (cons ?\e (aref (nth 1 calc-mode-map) i)) |
| 649 | (cdr (aref calc-mode-map i)))))) | 648 | (cdr (aref (nth 1 calc-mode-map) i)))))) |
| 650 | (setq i (1+ i)))) | 649 | (setq i (1+ i)))) |
| 651 | 650 | ||
| 652 | (setq calc-alg-map (copy-sequence calc-mode-map) | 651 | (setq calc-alg-map (copy-keymap calc-mode-map) |
| 653 | calc-alg-esc-map (copy-sequence esc-map)) | 652 | calc-alg-esc-map (copy-keymap esc-map)) |
| 654 | (let ((i 32)) | 653 | (let ((i 32)) |
| 655 | (while (< i 127) | 654 | (while (< i 127) |
| 656 | (or (memq i '(?' ?` ?= ??)) | 655 | (or (memq i '(?' ?` ?= ??)) |
| 657 | (aset calc-alg-map i 'calc-auto-algebraic-entry)) | 656 | (aset (nth 1 calc-alg-map) i 'calc-auto-algebraic-entry)) |
| 658 | (or (memq i '(?# ?x ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)) | 657 | (or (memq i '(?# ?x ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)) |
| 659 | (aset calc-alg-esc-map i (aref calc-mode-map i))) | 658 | (aset (nth 1 calc-alg-esc-map) i (aref (nth 1 calc-mode-map) i))) |
| 660 | (setq i (1+ i)))) | 659 | (setq i (1+ i)))) |
| 661 | (define-key calc-alg-map "\e" calc-alg-esc-map) | 660 | (define-key calc-alg-map "\e" calc-alg-esc-map) |
| 662 | (define-key calc-alg-map "\e\t" 'calc-roll-up) | 661 | (define-key calc-alg-map "\e\t" 'calc-roll-up) |
| 663 | (define-key calc-alg-map "\e\C-m" 'calc-last-args-stub) | 662 | (define-key calc-alg-map "\e\C-m" 'calc-last-args-stub) |
| 664 | (define-key calc-alg-map "\e\177" 'calc-pop-above) | 663 | (define-key calc-alg-map "\e\177" 'calc-pop-above) |
| 665 | )) | ||
| 666 | 664 | ||
| 667 | ;; The following is a relic for backward compatability only. | 665 | ;; The following is a relic for backward compatability only. |
| 668 | ;; The calc-define property list is now the recommended method. | 666 | ;; The calc-define property list is now the recommended method. |
| @@ -1395,8 +1393,7 @@ calc-kill calc-kill-region calc-yank)))) | |||
| 1395 | (and (>= last-command-char 0) (< last-command-char ? ) | 1393 | (and (>= last-command-char 0) (< last-command-char ? ) |
| 1396 | (not (memq last-command-char '(?\e))))) | 1394 | (not (memq last-command-char '(?\e))))) |
| 1397 | (calc-wrapper)) ; clear flags if not a Calc command. | 1395 | (calc-wrapper)) ; clear flags if not a Calc command. |
| 1398 | (if calc-emacs-type-19 | 1396 | (setq last-command-event (cdr event)) |
| 1399 | (setq last-command-event (cdr event))) | ||
| 1400 | (if (or (not (integerp last-command-char)) | 1397 | (if (or (not (integerp last-command-char)) |
| 1401 | (eq last-command-char ?-)) | 1398 | (eq last-command-char ?-)) |
| 1402 | (calc-unread-command) | 1399 | (calc-unread-command) |
diff --git a/lisp/calc/calc-graph.el b/lisp/calc/calc-graph.el index 70d044c202e..cec7a5d2136 100644 --- a/lisp/calc/calc-graph.el +++ b/lisp/calc/calc-graph.el | |||
| @@ -289,12 +289,8 @@ | |||
| 289 | (tty-output nil) | 289 | (tty-output nil) |
| 290 | cache-env is-splot device output resolution precision samples-pos) | 290 | cache-env is-splot device output resolution precision samples-pos) |
| 291 | (or (boundp 'calc-graph-prev-kill-hook) | 291 | (or (boundp 'calc-graph-prev-kill-hook) |
| 292 | (if calc-emacs-type-19 | 292 | (setq calc-graph-prev-kill-hook nil) |
| 293 | (progn | 293 | (add-hook 'kill-emacs-hook 'calc-graph-kill-hook)) |
| 294 | (setq calc-graph-prev-kill-hook nil) | ||
| 295 | (add-hook 'kill-emacs-hook 'calc-graph-kill-hook)) | ||
| 296 | (setq calc-graph-prev-kill-hook kill-emacs-hook) | ||
| 297 | (setq kill-emacs-hook 'calc-graph-kill-hook))) | ||
| 298 | (save-excursion | 294 | (save-excursion |
| 299 | (calc-graph-init) | 295 | (calc-graph-init) |
| 300 | (set-buffer tempbuf) | 296 | (set-buffer tempbuf) |
| @@ -1405,7 +1401,7 @@ This \"dumb\" driver will be present in Gnuplot 3.0." | |||
| 1405 | calc-gnuplot-buffer | 1401 | calc-gnuplot-buffer |
| 1406 | calc-gnuplot-name | 1402 | calc-gnuplot-name |
| 1407 | args)) | 1403 | args)) |
| 1408 | (process-kill-without-query calc-gnuplot-process)) | 1404 | (set-process-query-on-exit-flag calc-gnuplot-process nil)) |
| 1409 | (file-error | 1405 | (file-error |
| 1410 | (error "Sorry, can't find \"%s\" on your system" | 1406 | (error "Sorry, can't find \"%s\" on your system" |
| 1411 | calc-gnuplot-name))) | 1407 | calc-gnuplot-name))) |
diff --git a/lisp/calc/calc-help.el b/lisp/calc/calc-help.el index c24a13b91d7..99df2292f25 100644 --- a/lisp/calc/calc-help.el +++ b/lisp/calc/calc-help.el | |||
| @@ -1,6 +1,7 @@ | |||
| 1 | ;;; calc-help.el --- help display functions for Calc, | 1 | ;;; calc-help.el --- help display functions for Calc, |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2004 |
| 4 | ;; Free Software Foundation, Inc. | ||
| 4 | 5 | ||
| 5 | ;; Author: David Gillespie <daveg@synaptics.com> | 6 | ;; Author: David Gillespie <daveg@synaptics.com> |
| 6 | ;; Maintainers: D. Goel <deego@gnufans.org> | 7 | ;; Maintainers: D. Goel <deego@gnufans.org> |
| @@ -112,34 +113,27 @@ C-w Describe how there is no warranty for Calc." | |||
| 112 | (describe-bindings) | 113 | (describe-bindings) |
| 113 | (save-excursion | 114 | (save-excursion |
| 114 | (set-buffer "*Help*") | 115 | (set-buffer "*Help*") |
| 115 | (goto-char (point-min)) | 116 | (let ((inhibit-read-only t)) |
| 116 | (if (search-forward "Global bindings:" nil t) | 117 | (goto-char (point-min)) |
| 117 | (delete-region (match-beginning 0) (point-max))) | 118 | (when (search-forward "Major Mode Bindings:" nil t) |
| 118 | (goto-char (point-min)) | 119 | (delete-region (point-min) (point)) |
| 119 | (while (re-search-forward "\n[a-z] ESC" nil t) | 120 | (insert "Calc Mode Bindings:")) |
| 120 | (end-of-line) | 121 | (when (search-forward "Global bindings:" nil t) |
| 121 | (delete-region (match-beginning 0) (point))) | 122 | (forward-line -1) |
| 122 | (goto-char (point-min)) | 123 | (delete-region (point) (point-max))) |
| 123 | (while (re-search-forward "\nESC m" nil t) | 124 | (goto-char (point-min)) |
| 124 | (end-of-line) | 125 | (while |
| 125 | (delete-region (match-beginning 0) (point))) | 126 | (re-search-forward |
| 126 | (goto-char (point-min)) | 127 | "\n[a-z] [0-9]\\( .*\n\\)\\([a-z] [0-9]\\1\\)*[a-z] \\([0-9]\\)\\1" |
| 127 | (while (search-forward "\n\n\n" nil t) | 128 | nil t) |
| 128 | (backward-delete-char 1) | 129 | (let ((dig1 (char-after (1- (match-beginning 1)))) |
| 129 | (backward-char 2)) | 130 | (dig2 (char-after (match-beginning 3)))) |
| 130 | (goto-char (point-min)) | 131 | (delete-region (match-end 1) (match-end 0)) |
| 131 | (while | 132 | (goto-char (match-beginning 1)) |
| 132 | (re-search-forward | 133 | (delete-backward-char 1) |
| 133 | "\n[a-z] [0-9]\\(\t\t.*\n\\)\\([a-z] [0-9]\\1\\)*[a-z] \\([0-9]\\)\\1" | 134 | (delete-char 5) |
| 134 | nil t) | 135 | (insert (format "%c .. %c" (min dig1 dig2) (max dig1 dig2))))) |
| 135 | (let ((dig1 (char-after (1- (match-beginning 1)))) | 136 | (goto-char (point-min))))) |
| 136 | (dig2 (char-after (match-beginning 3)))) | ||
| 137 | (delete-region (match-end 1) (match-end 0)) | ||
| 138 | (goto-char (match-beginning 1)) | ||
| 139 | (delete-backward-char 1) | ||
| 140 | (delete-char 1) | ||
| 141 | (insert (format "%c .. %c" (min dig1 dig2) (max dig1 dig2))))) | ||
| 142 | (goto-char (point-min)))) | ||
| 143 | 137 | ||
| 144 | (defun calc-describe-key-briefly (key) | 138 | (defun calc-describe-key-briefly (key) |
| 145 | (interactive "kDescribe key briefly: ") | 139 | (interactive "kDescribe key briefly: ") |
| @@ -680,5 +674,5 @@ C-w Describe how there is no warranty for Calc." | |||
| 680 | "} (matrix brackets); . (abbreviate); / (multi-lines)") | 674 | "} (matrix brackets); . (abbreviate); / (multi-lines)") |
| 681 | "vec/mat" ?v)) | 675 | "vec/mat" ?v)) |
| 682 | 676 | ||
| 683 | ;;; arch-tag: 2d347593-7591-449e-a64a-93dab5f2f686 | 677 | ;; arch-tag: 2d347593-7591-449e-a64a-93dab5f2f686 |
| 684 | ;;; calc-help.el ends here | 678 | ;;; calc-help.el ends here |
diff --git a/lisp/calc/calc-mode.el b/lisp/calc/calc-mode.el index 00f5658022f..ff4445450f1 100644 --- a/lisp/calc/calc-mode.el +++ b/lisp/calc/calc-mode.el | |||
| @@ -429,8 +429,6 @@ | |||
| 429 | 429 | ||
| 430 | (defun calc-total-algebraic-mode (flag) | 430 | (defun calc-total-algebraic-mode (flag) |
| 431 | (interactive "P") | 431 | (interactive "P") |
| 432 | (if calc-emacs-type-19 | ||
| 433 | (error "Total algebraic mode not yet supported for Emacs 19")) | ||
| 434 | (calc-wrapper | 432 | (calc-wrapper |
| 435 | (if (eq calc-algebraic-mode 'total) | 433 | (if (eq calc-algebraic-mode 'total) |
| 436 | (calc-algebraic-mode nil) | 434 | (calc-algebraic-mode nil) |
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index c17449a8450..c1669f78f08 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el | |||
| @@ -656,12 +656,7 @@ If nil, selections displayed but ignored.") | |||
| 656 | 656 | ||
| 657 | 657 | ||
| 658 | ;; Verify that Calc is running on the right kind of system. | 658 | ;; Verify that Calc is running on the right kind of system. |
| 659 | (defconst calc-emacs-type-epoch (and (fboundp 'epoch::version) epoch::version)) | ||
| 660 | (defvar calc-emacs-type-19 (not (or calc-emacs-type-epoch | ||
| 661 | (string-lessp emacs-version "19")))) | ||
| 662 | (defvar calc-emacs-type-lucid (not (not (string-match "Lucid" emacs-version)))) | 659 | (defvar calc-emacs-type-lucid (not (not (string-match "Lucid" emacs-version)))) |
| 663 | (defvar calc-emacs-type-gnu19 (and calc-emacs-type-19 | ||
| 664 | (not calc-emacs-type-lucid))) | ||
| 665 | 660 | ||
| 666 | ;; Set up the standard keystroke (M-#) to run the Calculator, if that key | 661 | ;; Set up the standard keystroke (M-#) to run the Calculator, if that key |
| 667 | ;; has not yet been bound to anything. For best results, the user should | 662 | ;; has not yet been bound to anything. For best results, the user should |
| @@ -827,8 +822,8 @@ If nil, selections displayed but ignored.") | |||
| 827 | (if (eq bind 'undefined) | 822 | (if (eq bind 'undefined) |
| 828 | 'undefined 'calcDigit-nondigit)))) | 823 | 'undefined 'calcDigit-nondigit)))) |
| 829 | calc-mode-map) | 824 | calc-mode-map) |
| 830 | (let ((cmap (if calc-emacs-type-19 (nth 1 calc-mode-map) calc-mode-map)) | 825 | (let ((cmap (nth 1 calc-mode-map)) |
| 831 | (dmap (if calc-emacs-type-19 (nth 1 map) map)) | 826 | (dmap (nth 1 map)) |
| 832 | (i 0)) | 827 | (i 0)) |
| 833 | (while (< i 128) | 828 | (while (< i 128) |
| 834 | (aset dmap i | 829 | (aset dmap i |
| @@ -998,9 +993,7 @@ If nil, selections displayed but ignored.") | |||
| 998 | (use-global-map map) | 993 | (use-global-map map) |
| 999 | (use-local-map nil) | 994 | (use-local-map nil) |
| 1000 | (read-key-sequence | 995 | (read-key-sequence |
| 1001 | (if (commandp (key-binding (if calc-emacs-type-19 | 996 | (if (commandp (key-binding (vector (cdr key)))) |
| 1002 | (vector (cdr key)) | ||
| 1003 | (char-to-string (cdr key))))) | ||
| 1004 | "" prompt2))) | 997 | "" prompt2))) |
| 1005 | (use-global-map glob) | 998 | (use-global-map glob) |
| 1006 | (use-local-map loc))))) | 999 | (use-local-map loc))))) |
| @@ -3425,11 +3418,8 @@ Also looks for the equivalent TeX words, \\gets and \\evalto." | |||
| 3425 | (let ((key (event-to-character event t t))) | 3418 | (let ((key (event-to-character event t t))) |
| 3426 | (or key optkey (error "Expected a plain keystroke")) | 3419 | (or key optkey (error "Expected a plain keystroke")) |
| 3427 | (cons key event)))) | 3420 | (cons key event)))) |
| 3428 | (calc-emacs-type-gnu19 | ||
| 3429 | (let ((key (read-event))) | ||
| 3430 | (cons key key))) | ||
| 3431 | (t | 3421 | (t |
| 3432 | (let ((key (read-char))) | 3422 | (let ((key (read-event))) |
| 3433 | (cons key key))))) | 3423 | (cons key key))))) |
| 3434 | 3424 | ||
| 3435 | (defun calc-unread-command (&optional input) | 3425 | (defun calc-unread-command (&optional input) |
diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el index e83e8e980b6..9e5f2b93c22 100644 --- a/lisp/calendar/icalendar.el +++ b/lisp/calendar/icalendar.el | |||
| @@ -1,10 +1,10 @@ | |||
| 1 | ;;; icalendar.el --- iCalendar implementation | 1 | ;;; icalendar.el --- iCalendar implementation -*-coding: utf-8 -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Ulf Jasper <ulf.jasper@web.de> | 5 | ;; Author: Ulf Jasper <ulf.jasper@web.de> |
| 6 | ;; Created: August 2002 | 6 | ;; Created: August 2002 |
| 7 | ;; Keywords: calendar | 7 | ;; Keywords: calendar |
| 8 | ;; Human-Keywords: calendar, diary, iCalendar, vCalendar | 8 | ;; Human-Keywords: calendar, diary, iCalendar, vCalendar |
| 9 | 9 | ||
| 10 | ;; This file is part of GNU Emacs. | 10 | ;; This file is part of GNU Emacs. |
| @@ -31,8 +31,18 @@ | |||
| 31 | 31 | ||
| 32 | ;;; History: | 32 | ;;; History: |
| 33 | 33 | ||
| 34 | ;; 0.06 Bugfixes regarding icalendar-import-format-*. | 34 | ;; 0.07: Renamed commands! |
| 35 | ;; Fix in icalendar-convert-diary-to-ical -- thanks to Philipp Grau. | 35 | ;; icalendar-extract-ical-from-buffer -> icalendar-import-buffer |
| 36 | ;; icalendar-convert-diary-to-ical -> icalendar-export-file | ||
| 37 | ;; Naming scheme: icalendar-.* = user command; icalendar--.* = | ||
| 38 | ;; internal. | ||
| 39 | ;; Added icalendar-export-region. | ||
| 40 | ;; The import and export commands do not clear their target file, | ||
| 41 | ;; but append their results to the target file. | ||
| 42 | |||
| 43 | ;; 0.06: Bugfixes regarding icalendar-import-format-*. | ||
| 44 | ;; Fix in icalendar-convert-diary-to-ical -- thanks to Philipp | ||
| 45 | ;; Grau. | ||
| 36 | 46 | ||
| 37 | ;; 0.05: New import format scheme: Replaced icalendar-import-prefix-*, | 47 | ;; 0.05: New import format scheme: Replaced icalendar-import-prefix-*, |
| 38 | ;; icalendar-import-ignored-properties, and | 48 | ;; icalendar-import-ignored-properties, and |
| @@ -61,7 +71,7 @@ | |||
| 61 | ;; ====================================================================== | 71 | ;; ====================================================================== |
| 62 | ;; To Do: | 72 | ;; To Do: |
| 63 | 73 | ||
| 64 | ;; * Import from ical: | 74 | ;; * Import from ical to diary: |
| 65 | ;; + Need more properties for icalendar-import-format | 75 | ;; + Need more properties for icalendar-import-format |
| 66 | ;; + check vcalendar version | 76 | ;; + check vcalendar version |
| 67 | ;; + check (unknown) elements | 77 | ;; + check (unknown) elements |
| @@ -73,24 +83,21 @@ | |||
| 73 | ;; + error log is incomplete | 83 | ;; + error log is incomplete |
| 74 | ;; + nice to have: #include "webcal://foo.com/some-calendar.ics" | 84 | ;; + nice to have: #include "webcal://foo.com/some-calendar.ics" |
| 75 | 85 | ||
| 76 | ;; * Export into ical | 86 | ;; * Export from diary to ical |
| 77 | ;; + diary-date, diary-float, and self-made sexp entries are not | 87 | ;; + diary-date, diary-float, and self-made sexp entries are not |
| 78 | ;; understood | 88 | ;; understood |
| 79 | ;; + timezones, currently all times are local! | 89 | ;; + timezones, currently all times are local! |
| 80 | 90 | ||
| 81 | ;; * Other things | 91 | ;; * Other things |
| 82 | ;; + defcustom icalendar-import-ignored-properties does not work with | ||
| 83 | ;; XEmacs. | ||
| 84 | ;; + clean up all those date/time parsing functions | 92 | ;; + clean up all those date/time parsing functions |
| 85 | ;; + Handle todo items? | 93 | ;; + Handle todo items? |
| 86 | ;; + Check iso 8601 for datetime and period | 94 | ;; + Check iso 8601 for datetime and period |
| 87 | ;; + Which chars to (un)escape? | 95 | ;; + Which chars to (un)escape? |
| 88 | ;; + Time to find out how the profiler works? | ||
| 89 | 96 | ||
| 90 | 97 | ||
| 91 | ;;; Code: | 98 | ;;; Code: |
| 92 | 99 | ||
| 93 | (defconst icalendar-version 0.06 | 100 | (defconst icalendar-version 0.07 |
| 94 | "Version number of icalendar.el.") | 101 | "Version number of icalendar.el.") |
| 95 | 102 | ||
| 96 | ;; ====================================================================== | 103 | ;; ====================================================================== |
| @@ -173,7 +180,7 @@ longer than they are." | |||
| 173 | (defconst icalendar-monthnumber-table | 180 | (defconst icalendar-monthnumber-table |
| 174 | '(("^jan\\(uar\\)?y?$" . 1) | 181 | '(("^jan\\(uar\\)?y?$" . 1) |
| 175 | ("^feb\\(ruar\\)?y?$" . 2) | 182 | ("^feb\\(ruar\\)?y?$" . 2) |
| 176 | ("^mar\\(ch\\)?\\|märz?$" . 3) | 183 | ("^mar\\(ch\\)?\\|märz$" . 3) |
| 177 | ("^apr\\(il\\)?$" . 4) | 184 | ("^apr\\(il\\)?$" . 4) |
| 178 | ("^ma[iy]$" . 5) | 185 | ("^ma[iy]$" . 5) |
| 179 | ("^jun[ie]?$" . 6) | 186 | ("^jun[ie]?$" . 6) |
| @@ -195,11 +202,19 @@ Currently this matches only German and English.") | |||
| 195 | (require 'appt) | 202 | (require 'appt) |
| 196 | 203 | ||
| 197 | ;; ====================================================================== | 204 | ;; ====================================================================== |
| 205 | ;; misc | ||
| 206 | ;; ====================================================================== | ||
| 207 | (defun icalendar--dmsg (&rest args) | ||
| 208 | "Print message ARGS if `icalendar-debug' is non-nil." | ||
| 209 | (if icalendar-debug | ||
| 210 | (apply 'message args))) | ||
| 211 | |||
| 212 | ;; ====================================================================== | ||
| 198 | ;; Core functionality | 213 | ;; Core functionality |
| 199 | ;; Functions for parsing icalendars, importing and so on | 214 | ;; Functions for parsing icalendars, importing and so on |
| 200 | ;; ====================================================================== | 215 | ;; ====================================================================== |
| 201 | 216 | ||
| 202 | (defun icalendar-get-unfolded-buffer (folded-ical-buffer) | 217 | (defun icalendar--get-unfolded-buffer (folded-ical-buffer) |
| 203 | "Return a new buffer containing the unfolded contents of a buffer. | 218 | "Return a new buffer containing the unfolded contents of a buffer. |
| 204 | Folding is the iCalendar way of wrapping long lines. In the | 219 | Folding is the iCalendar way of wrapping long lines. In the |
| 205 | created buffer all occurrences of CR LF BLANK are replaced by the | 220 | created buffer all occurrences of CR LF BLANK are replaced by the |
| @@ -211,13 +226,12 @@ buffer." | |||
| 211 | (erase-buffer) | 226 | (erase-buffer) |
| 212 | (insert-buffer folded-ical-buffer) | 227 | (insert-buffer folded-ical-buffer) |
| 213 | (while (re-search-forward "\r?\n[ \t]" nil t) | 228 | (while (re-search-forward "\r?\n[ \t]" nil t) |
| 214 | (replace-match "" nil nil)) | 229 | (replace-match "" nil nil))) |
| 215 | ) | ||
| 216 | unfolded-buffer)) | 230 | unfolded-buffer)) |
| 217 | 231 | ||
| 218 | ;; Replace regexp RE with RP in string ST and return the new string. | 232 | (defsubst icalendar--rris (re rp st) |
| 219 | ;; This is here for compatibility with XEmacs. | 233 | "Replace regexp RE with RP in string ST and return the new string. |
| 220 | (defsubst icalendar-rris (re rp st) | 234 | This is here for compatibility with XEmacs." |
| 221 | ;; XEmacs: | 235 | ;; XEmacs: |
| 222 | (if (fboundp 'replace-in-string) | 236 | (if (fboundp 'replace-in-string) |
| 223 | (save-match-data ;; apparently XEmacs needs save-match-data | 237 | (save-match-data ;; apparently XEmacs needs save-match-data |
| @@ -225,7 +239,7 @@ buffer." | |||
| 225 | ;; Emacs: | 239 | ;; Emacs: |
| 226 | (replace-regexp-in-string re rp st))) | 240 | (replace-regexp-in-string re rp st))) |
| 227 | 241 | ||
| 228 | (defun icalendar-read-element (invalue inparams) | 242 | (defun icalendar--read-element (invalue inparams) |
| 229 | "Recursively read the next iCalendar element in the current buffer. | 243 | "Recursively read the next iCalendar element in the current buffer. |
| 230 | INVALUE gives the current iCalendar element we are reading. | 244 | INVALUE gives the current iCalendar element we are reading. |
| 231 | INPARAMS gives the current parameters..... | 245 | INPARAMS gives the current parameters..... |
| @@ -233,7 +247,7 @@ This function calls itself recursively for each nested calendar element | |||
| 233 | it finds" | 247 | it finds" |
| 234 | (let (element children line name params param param-name param-value | 248 | (let (element children line name params param param-name param-value |
| 235 | value | 249 | value |
| 236 | (continue t)) | 250 | (continue t)) |
| 237 | (setq children '()) | 251 | (setq children '()) |
| 238 | (while (and continue | 252 | (while (and continue |
| 239 | (re-search-forward "^\\([A-Za-z0-9-]+\\)[;:]" nil t)) | 253 | (re-search-forward "^\\([A-Za-z0-9-]+\\)[;:]" nil t)) |
| @@ -261,13 +275,13 @@ it finds" | |||
| 261 | (error "Oops")) | 275 | (error "Oops")) |
| 262 | (forward-char 1) | 276 | (forward-char 1) |
| 263 | (re-search-forward "\\(.*\\)\\(\r?\n[ \t].*\\)*" nil t) | 277 | (re-search-forward "\\(.*\\)\\(\r?\n[ \t].*\\)*" nil t) |
| 264 | (setq value (icalendar-rris "\r?\n[ \t]" "" (match-string 0))) | 278 | (setq value (icalendar--rris "\r?\n[ \t]" "" (match-string 0))) |
| 265 | (setq line (list name params value)) | 279 | (setq line (list name params value)) |
| 266 | (cond ((eq name 'BEGIN) | 280 | (cond ((eq name 'BEGIN) |
| 267 | (setq children | 281 | (setq children |
| 268 | (append children | 282 | (append children |
| 269 | (list (icalendar-read-element (intern value) | 283 | (list (icalendar--read-element (intern value) |
| 270 | params))))) | 284 | params))))) |
| 271 | ((eq name 'END) | 285 | ((eq name 'END) |
| 272 | (setq continue nil)) | 286 | (setq continue nil)) |
| 273 | (t | 287 | (t |
| @@ -280,11 +294,11 @@ it finds" | |||
| 280 | ;; helper functions for examining events | 294 | ;; helper functions for examining events |
| 281 | ;; ====================================================================== | 295 | ;; ====================================================================== |
| 282 | 296 | ||
| 283 | (defsubst icalendar-get-all-event-properties (event) | 297 | ;;(defsubst icalendar--get-all-event-properties (event) |
| 284 | "Return the list of properties in this EVENT." | 298 | ;; "Return the list of properties in this EVENT." |
| 285 | (car (cddr event))) | 299 | ;; (car (cddr event))) |
| 286 | 300 | ||
| 287 | (defun icalendar-get-event-property (event prop) | 301 | (defun icalendar--get-event-property (event prop) |
| 288 | "For the given EVENT return the value of the property PROP." | 302 | "For the given EVENT return the value of the property PROP." |
| 289 | (catch 'found | 303 | (catch 'found |
| 290 | (let ((props (car (cddr event))) pp) | 304 | (let ((props (car (cddr event))) pp) |
| @@ -295,21 +309,21 @@ it finds" | |||
| 295 | (setq props (cdr props)))) | 309 | (setq props (cdr props)))) |
| 296 | nil)) | 310 | nil)) |
| 297 | 311 | ||
| 298 | (defun icalendar-set-event-property (event prop new-value) | 312 | ;; (defun icalendar--set-event-property (event prop new-value) |
| 299 | "For the given EVENT set the property PROP to the value NEW-VALUE." | 313 | ;; "For the given EVENT set the property PROP to the value NEW-VALUE." |
| 300 | (catch 'found | 314 | ;; (catch 'found |
| 301 | (let ((props (car (cddr event))) pp) | 315 | ;; (let ((props (car (cddr event))) pp) |
| 302 | (while props | 316 | ;; (while props |
| 303 | (setq pp (car props)) | 317 | ;; (setq pp (car props)) |
| 304 | (when (eq (car pp) prop) | 318 | ;; (when (eq (car pp) prop) |
| 305 | (setcdr (cdr pp) new-value) | 319 | ;; (setcdr (cdr pp) new-value) |
| 306 | (throw 'found (car (cddr pp)))) | 320 | ;; (throw 'found (car (cddr pp)))) |
| 307 | (setq props (cdr props))) | 321 | ;; (setq props (cdr props))) |
| 308 | (setq props (car (cddr event))) | 322 | ;; (setq props (car (cddr event))) |
| 309 | (setcar (cddr event) | 323 | ;; (setcar (cddr event) |
| 310 | (append props (list (list prop nil new-value))))))) | 324 | ;; (append props (list (list prop nil new-value))))))) |
| 311 | 325 | ||
| 312 | (defun icalendar-get-children (node name) | 326 | (defun icalendar--get-children (node name) |
| 313 | "Return all children of the given NODE which have a name NAME. | 327 | "Return all children of the given NODE which have a name NAME. |
| 314 | For instance the VCALENDAR node can have VEVENT children as well as VTODO | 328 | For instance the VCALENDAR node can have VEVENT children as well as VTODO |
| 315 | children." | 329 | children." |
| @@ -321,22 +335,21 @@ children." | |||
| 321 | (when children | 335 | (when children |
| 322 | (let ((subresult | 336 | (let ((subresult |
| 323 | (delq nil | 337 | (delq nil |
| 324 | (mapcar (lambda (n) | 338 | (mapcar (lambda (n) |
| 325 | (icalendar-get-children n name)) | 339 | (icalendar--get-children n name)) |
| 326 | children)))) | 340 | children)))) |
| 327 | (if subresult | 341 | (if subresult |
| 328 | (if result | 342 | (if result |
| 329 | (setq result (append result subresult)) | 343 | (setq result (append result subresult)) |
| 330 | (setq result subresult))))) | 344 | (setq result subresult))))) |
| 331 | result)) | 345 | result)) |
| 332 | 346 | ||
| 333 | ; private | 347 | ; private |
| 334 | (defun icalendar-all-events (icalendar) | 348 | (defun icalendar--all-events (icalendar) |
| 335 | "Return the list of all existing events in the given ICALENDAR." | 349 | "Return the list of all existing events in the given ICALENDAR." |
| 336 | (interactive "") | 350 | (icalendar--get-children (car icalendar) 'VEVENT)) |
| 337 | (icalendar-get-children (car icalendar) 'VEVENT)) | ||
| 338 | 351 | ||
| 339 | (defun icalendar-split-value (value-string) | 352 | (defun icalendar--split-value (value-string) |
| 340 | "Splits VALUE-STRING at ';='." | 353 | "Splits VALUE-STRING at ';='." |
| 341 | (let ((result '()) | 354 | (let ((result '()) |
| 342 | param-name param-value) | 355 | param-name param-value) |
| @@ -348,22 +361,22 @@ children." | |||
| 348 | (insert value-string) | 361 | (insert value-string) |
| 349 | (goto-char (point-min)) | 362 | (goto-char (point-min)) |
| 350 | (while | 363 | (while |
| 351 | (re-search-forward | 364 | (re-search-forward |
| 352 | "\\([A-Za-z0-9-]+\\)=\\(\\([^;,:]+\\)\\|\"\\([^\"]+\\)\"\\);?" | 365 | "\\([A-Za-z0-9-]+\\)=\\(\\([^;,:]+\\)\\|\"\\([^\"]+\\)\"\\);?" |
| 353 | nil t) | 366 | nil t) |
| 354 | (setq param-name (intern (match-string 1))) | 367 | (setq param-name (intern (match-string 1))) |
| 355 | (setq param-value (match-string 2)) | 368 | (setq param-value (match-string 2)) |
| 356 | (setq result | 369 | (setq result |
| 357 | (append result (list (list param-name param-value))))))) | 370 | (append result (list (list param-name param-value))))))) |
| 358 | result)) | 371 | result)) |
| 359 | 372 | ||
| 360 | (defun icalendar-decode-isodatetime (isodatetimestring) | 373 | (defun icalendar--decode-isodatetime (isodatetimestring) |
| 361 | "Return ISODATETIMESTRING in format like `decode-time'. | 374 | "Return ISODATETIMESTRING in format like `decode-time'. |
| 362 | Converts from ISO-8601 to Emacs representation. If ISODATETIMESTRING | 375 | Converts from ISO-8601 to Emacs representation. If ISODATETIMESTRING |
| 363 | specifies UTC time (trailing letter Z) the decoded time is given in | 376 | specifies UTC time (trailing letter Z) the decoded time is given in |
| 364 | the local time zone! FIXME: TZID-attributes are ignored....! FIXME: | 377 | the local time zone! FIXME: TZID-attributes are ignored....! FIXME: |
| 365 | multiple comma-separated values should be allowed!" | 378 | multiple comma-separated values should be allowed!" |
| 366 | (icalendar-dmsg isodatetimestring) | 379 | (icalendar--dmsg isodatetimestring) |
| 367 | (if isodatetimestring | 380 | (if isodatetimestring |
| 368 | ;; day/month/year must be present | 381 | ;; day/month/year must be present |
| 369 | (let ((year (read (substring isodatetimestring 0 4))) | 382 | (let ((year (read (substring isodatetimestring 0 4))) |
| @@ -373,14 +386,14 @@ multiple comma-separated values should be allowed!" | |||
| 373 | (minute 0) | 386 | (minute 0) |
| 374 | (second 0)) | 387 | (second 0)) |
| 375 | (when (> (length isodatetimestring) 12) | 388 | (when (> (length isodatetimestring) 12) |
| 376 | ;; hour/minute present | 389 | ;; hour/minute present |
| 377 | (setq hour (read (substring isodatetimestring 9 11))) | 390 | (setq hour (read (substring isodatetimestring 9 11))) |
| 378 | (setq minute (read (substring isodatetimestring 11 13)))) | 391 | (setq minute (read (substring isodatetimestring 11 13)))) |
| 379 | (when (> (length isodatetimestring) 14) | 392 | (when (> (length isodatetimestring) 14) |
| 380 | ;; seconds present | 393 | ;; seconds present |
| 381 | (setq second (read (substring isodatetimestring 13 15)))) | 394 | (setq second (read (substring isodatetimestring 13 15)))) |
| 382 | (when (and (> (length isodatetimestring) 15) | 395 | (when (and (> (length isodatetimestring) 15) |
| 383 | ;; UTC specifier present | 396 | ;; UTC specifier present |
| 384 | (char-equal ?Z (aref isodatetimestring 15))) | 397 | (char-equal ?Z (aref isodatetimestring 15))) |
| 385 | ;; if not UTC add current-time-zone offset | 398 | ;; if not UTC add current-time-zone offset |
| 386 | (setq second (+ (car (current-time-zone)) second))) | 399 | (setq second (+ (car (current-time-zone)) second))) |
| @@ -395,7 +408,7 @@ multiple comma-separated values should be allowed!" | |||
| 395 | ;; isodatetimestring == nil | 408 | ;; isodatetimestring == nil |
| 396 | nil)) | 409 | nil)) |
| 397 | 410 | ||
| 398 | (defun icalendar-decode-isoduration (isodurationstring) | 411 | (defun icalendar--decode-isoduration (isodurationstring) |
| 399 | "Return ISODURATIONSTRING in format like `decode-time'. | 412 | "Return ISODURATIONSTRING in format like `decode-time'. |
| 400 | Converts from ISO-8601 to Emacs representation. If ISODURATIONSTRING | 413 | Converts from ISO-8601 to Emacs representation. If ISODURATIONSTRING |
| 401 | specifies UTC time (trailing letter Z) the decoded time is given in | 414 | specifies UTC time (trailing letter Z) the decoded time is given in |
| @@ -409,7 +422,7 @@ multiple comma-separated values should be allowed!" | |||
| 409 | "\\(\\([0-9]+\\)D\\)" ; days only | 422 | "\\(\\([0-9]+\\)D\\)" ; days only |
| 410 | "\\|" | 423 | "\\|" |
| 411 | "\\(\\(\\([0-9]+\\)D\\)?T\\(\\([0-9]+\\)H\\)?" ; opt days | 424 | "\\(\\(\\([0-9]+\\)D\\)?T\\(\\([0-9]+\\)H\\)?" ; opt days |
| 412 | "\\(\\([0-9]+\\)M\\)?\\(\\([0-9]+\\)S\\)?\\)" ; mand. time | 425 | "\\(\\([0-9]+\\)M\\)?\\(\\([0-9]+\\)S\\)?\\)" ; mand. time |
| 413 | "\\|" | 426 | "\\|" |
| 414 | "\\(\\([0-9]+\\)W\\)" ; weeks only | 427 | "\\(\\([0-9]+\\)W\\)" ; weeks only |
| 415 | "\\)$") isodurationstring) | 428 | "\\)$") isodurationstring) |
| @@ -419,41 +432,41 @@ multiple comma-separated values should be allowed!" | |||
| 419 | (days 0) | 432 | (days 0) |
| 420 | (months 0) | 433 | (months 0) |
| 421 | (years 0)) | 434 | (years 0)) |
| 422 | (cond | 435 | (cond |
| 423 | ((match-beginning 2) ;days only | 436 | ((match-beginning 2) ;days only |
| 424 | (setq days (read (substring isodurationstring | 437 | (setq days (read (substring isodurationstring |
| 425 | (match-beginning 3) | 438 | (match-beginning 3) |
| 426 | (match-end 3)))) | 439 | (match-end 3)))) |
| 427 | (when icalendar-duration-correction | 440 | (when icalendar-duration-correction |
| 428 | (setq days (1- days)))) | 441 | (setq days (1- days)))) |
| 429 | ((match-beginning 4) ;days and time | 442 | ((match-beginning 4) ;days and time |
| 430 | (if (match-beginning 5) | 443 | (if (match-beginning 5) |
| 431 | (setq days (* 7 (read (substring isodurationstring | 444 | (setq days (* 7 (read (substring isodurationstring |
| 432 | (match-beginning 6) | 445 | (match-beginning 6) |
| 433 | (match-end 6)))))) | 446 | (match-end 6)))))) |
| 434 | (if (match-beginning 7) | 447 | (if (match-beginning 7) |
| 435 | (setq hours (read (substring isodurationstring | 448 | (setq hours (read (substring isodurationstring |
| 436 | (match-beginning 8) | 449 | (match-beginning 8) |
| 437 | (match-end 8))))) | 450 | (match-end 8))))) |
| 438 | (if (match-beginning 9) | 451 | (if (match-beginning 9) |
| 439 | (setq minutes (read (substring isodurationstring | 452 | (setq minutes (read (substring isodurationstring |
| 440 | (match-beginning 10) | 453 | (match-beginning 10) |
| 441 | (match-end 10))))) | 454 | (match-end 10))))) |
| 442 | (if (match-beginning 11) | 455 | (if (match-beginning 11) |
| 443 | (setq seconds (read (substring isodurationstring | 456 | (setq seconds (read (substring isodurationstring |
| 444 | (match-beginning 12) | 457 | (match-beginning 12) |
| 445 | (match-end 12))))) | 458 | (match-end 12))))) |
| 446 | ) | 459 | ) |
| 447 | ((match-beginning 13) ;weeks only | 460 | ((match-beginning 13) ;weeks only |
| 448 | (setq days (* 7 (read (substring isodurationstring | 461 | (setq days (* 7 (read (substring isodurationstring |
| 449 | (match-beginning 14) | 462 | (match-beginning 14) |
| 450 | (match-end 14)))))) | 463 | (match-end 14)))))) |
| 451 | ) | 464 | ) |
| 452 | (list seconds minutes hours days months years))) | 465 | (list seconds minutes hours days months years))) |
| 453 | ;; isodatetimestring == nil | 466 | ;; isodatetimestring == nil |
| 454 | nil)) | 467 | nil)) |
| 455 | 468 | ||
| 456 | (defun icalendar-add-decoded-times (time1 time2) | 469 | (defun icalendar--add-decoded-times (time1 time2) |
| 457 | "Add TIME1 to TIME2. | 470 | "Add TIME1 to TIME2. |
| 458 | Both times must be given in decoded form. One of these times must be | 471 | Both times must be given in decoded form. One of these times must be |
| 459 | valid (year > 1900 or something)." | 472 | valid (year > 1900 or something)." |
| @@ -470,40 +483,40 @@ valid (year > 1900 or something)." | |||
| 470 | ;;(or (nth 6 time1) (nth 6 time2)) ;; FIXME? | 483 | ;;(or (nth 6 time1) (nth 6 time2)) ;; FIXME? |
| 471 | ))) | 484 | ))) |
| 472 | 485 | ||
| 473 | (defun icalendar-datetime-to-noneuropean-date (datetime) | 486 | (defun icalendar--datetime-to-noneuropean-date (datetime) |
| 474 | "Convert the decoded DATETIME to non-european-style format. | 487 | "Convert the decoded DATETIME to non-european-style format. |
| 475 | Non-European format: (month day year)." | 488 | Non-European format: (month day year)." |
| 476 | (if datetime | 489 | (if datetime |
| 477 | (list (nth 4 datetime) ;month | 490 | (list (nth 4 datetime) ;month |
| 478 | (nth 3 datetime) ;day | 491 | (nth 3 datetime) ;day |
| 479 | (nth 5 datetime));year | 492 | (nth 5 datetime)) ;year |
| 480 | ;; datetime == nil | 493 | ;; datetime == nil |
| 481 | nil)) | 494 | nil)) |
| 482 | 495 | ||
| 483 | (defun icalendar-datetime-to-european-date (datetime) | 496 | (defun icalendar--datetime-to-european-date (datetime) |
| 484 | "Convert the decoded DATETIME to European format. | 497 | "Convert the decoded DATETIME to European format. |
| 485 | European format: (day month year). | 498 | European format: (day month year). |
| 486 | FIXME" | 499 | FIXME" |
| 487 | (if datetime | 500 | (if datetime |
| 488 | (format "%d %d %d" (nth 3 datetime); day | 501 | (format "%d %d %d" (nth 3 datetime) ; day |
| 489 | (nth 4 datetime) ;month | 502 | (nth 4 datetime) ;month |
| 490 | (nth 5 datetime));year | 503 | (nth 5 datetime)) ;year |
| 491 | ;; datetime == nil | 504 | ;; datetime == nil |
| 492 | nil)) | 505 | nil)) |
| 493 | 506 | ||
| 494 | (defun icalendar-datetime-to-colontime (datetime) | 507 | (defun icalendar--datetime-to-colontime (datetime) |
| 495 | "Extract the time part of a decoded DATETIME into 24-hour format. | 508 | "Extract the time part of a decoded DATETIME into 24-hour format. |
| 496 | Note that this silently ignores seconds." | 509 | Note that this silently ignores seconds." |
| 497 | (format "%02d:%02d" (nth 2 datetime) (nth 1 datetime))) | 510 | (format "%02d:%02d" (nth 2 datetime) (nth 1 datetime))) |
| 498 | 511 | ||
| 499 | (defun icalendar-get-month-number (monthname) | 512 | (defun icalendar--get-month-number (monthname) |
| 500 | "Return the month number for the given MONTHNAME." | 513 | "Return the month number for the given MONTHNAME." |
| 501 | (save-match-data | 514 | (save-match-data |
| 502 | (let ((case-fold-search t)) | 515 | (let ((case-fold-search t)) |
| 503 | (assoc-default monthname icalendar-monthnumber-table | 516 | (assoc-default monthname icalendar-monthnumber-table |
| 504 | 'string-match)))) | 517 | 'string-match)))) |
| 505 | 518 | ||
| 506 | (defun icalendar-get-weekday-abbrev (weekday) | 519 | (defun icalendar--get-weekday-abbrev (weekday) |
| 507 | "Return the abbreviated WEEKDAY." | 520 | "Return the abbreviated WEEKDAY." |
| 508 | ;;FIXME: ISO-like(?). | 521 | ;;FIXME: ISO-like(?). |
| 509 | (save-match-data | 522 | (save-match-data |
| @@ -511,108 +524,118 @@ Note that this silently ignores seconds." | |||
| 511 | (assoc-default weekday icalendar-weekdayabbrev-table | 524 | (assoc-default weekday icalendar-weekdayabbrev-table |
| 512 | 'string-match)))) | 525 | 'string-match)))) |
| 513 | 526 | ||
| 514 | (defun icalendar-datestring-to-isodate (datestring &optional day-shift) | 527 | (defun icalendar--datestring-to-isodate (datestring &optional day-shift) |
| 515 | "Convert diary-style DATESTRING to iso-style date. | 528 | "Convert diary-style DATESTRING to iso-style date. |
| 516 | If DAY-SHIFT is non-nil, the result is shifted by DAY-SHIFT days | 529 | If DAY-SHIFT is non-nil, the result is shifted by DAY-SHIFT days |
| 517 | -- DAY-SHIFT must be either nil or an integer. This function | 530 | -- DAY-SHIFT must be either nil or an integer. This function |
| 518 | takes care of european-style." | 531 | takes care of european-style." |
| 519 | (let ((day -1) month year) | 532 | (let ((day -1) month year) |
| 520 | (save-match-data | 533 | (save-match-data |
| 521 | (cond (;; numeric date | 534 | (cond ( ;; numeric date |
| 522 | (string-match (concat "\\s-*" | 535 | (string-match (concat "\\s-*" |
| 523 | "0?\\([1-9][0-9]?\\)[ \t/]\\s-*" | 536 | "0?\\([1-9][0-9]?\\)[ \t/]\\s-*" |
| 524 | "0?\\([1-9][0-9]?\\),?[ \t/]\\s-*" | 537 | "0?\\([1-9][0-9]?\\),?[ \t/]\\s-*" |
| 525 | "\\([0-9]\\{4\\}\\)") | 538 | "\\([0-9]\\{4\\}\\)") |
| 526 | datestring) | 539 | datestring) |
| 527 | (setq day (read (substring datestring (match-beginning 1) | 540 | (setq day (read (substring datestring (match-beginning 1) |
| 528 | (match-end 1)))) | 541 | (match-end 1)))) |
| 529 | (setq month (read (substring datestring (match-beginning 2) | 542 | (setq month (read (substring datestring (match-beginning 2) |
| 530 | (match-end 2)))) | 543 | (match-end 2)))) |
| 531 | (setq year (read (substring datestring (match-beginning 3) | 544 | (setq year (read (substring datestring (match-beginning 3) |
| 532 | (match-end 3)))) | 545 | (match-end 3)))) |
| 533 | (unless european-calendar-style | 546 | (unless european-calendar-style |
| 534 | (let ((x month)) | 547 | (let ((x month)) |
| 535 | (setq month day) | 548 | (setq month day) |
| 536 | (setq day x)))) | 549 | (setq day x)))) |
| 537 | (;; date contains month names -- european-style | 550 | ( ;; date contains month names -- european-style |
| 538 | (and european-calendar-style | 551 | (and european-calendar-style |
| 539 | (string-match (concat "\\s-*" | 552 | (string-match (concat "\\s-*" |
| 540 | "0?\\([123]?[0-9]\\)[ \t/]\\s-*" | 553 | "0?\\([123]?[0-9]\\)[ \t/]\\s-*" |
| 541 | "\\([A-Za-z][^ ]+\\)[ \t/]\\s-*" | 554 | "\\([A-Za-z][^ ]+\\)[ \t/]\\s-*" |
| 542 | "\\([0-9]\\{4\\}\\)") | 555 | "\\([0-9]\\{4\\}\\)") |
| 543 | datestring)) | 556 | datestring)) |
| 544 | (setq day (read (substring datestring (match-beginning 1) | 557 | (setq day (read (substring datestring (match-beginning 1) |
| 545 | (match-end 1)))) | 558 | (match-end 1)))) |
| 546 | (setq month (icalendar-get-month-number | 559 | (setq month (icalendar--get-month-number |
| 547 | (substring datestring (match-beginning 2) | 560 | (substring datestring (match-beginning 2) |
| 548 | (match-end 2)))) | 561 | (match-end 2)))) |
| 549 | (setq year (read (substring datestring (match-beginning 3) | 562 | (setq year (read (substring datestring (match-beginning 3) |
| 550 | (match-end 3))))) | 563 | (match-end 3))))) |
| 551 | (;; date contains month names -- non-european-style | 564 | ( ;; date contains month names -- non-european-style |
| 552 | (and (not european-calendar-style) | 565 | (and (not european-calendar-style) |
| 553 | (string-match (concat "\\s-*" | 566 | (string-match (concat "\\s-*" |
| 554 | "\\([A-Za-z][^ ]+\\)[ \t/]\\s-*" | 567 | "\\([A-Za-z][^ ]+\\)[ \t/]\\s-*" |
| 555 | "0?\\([123]?[0-9]\\),?[ \t/]\\s-*" | 568 | "0?\\([123]?[0-9]\\),?[ \t/]\\s-*" |
| 556 | "\\([0-9]\\{4\\}\\)") | 569 | "\\([0-9]\\{4\\}\\)") |
| 557 | datestring)) | 570 | datestring)) |
| 558 | (setq day (read (substring datestring (match-beginning 2) | 571 | (setq day (read (substring datestring (match-beginning 2) |
| 559 | (match-end 2)))) | 572 | (match-end 2)))) |
| 560 | (setq month (icalendar-get-month-number | 573 | (setq month (icalendar--get-month-number |
| 561 | (substring datestring (match-beginning 1) | 574 | (substring datestring (match-beginning 1) |
| 562 | (match-end 1)))) | 575 | (match-end 1)))) |
| 563 | (setq year (read (substring datestring (match-beginning 3) | 576 | (setq year (read (substring datestring (match-beginning 3) |
| 564 | (match-end 3))))) | 577 | (match-end 3))))) |
| 565 | (t | 578 | (t |
| 566 | nil))) | 579 | nil))) |
| 567 | (if (> day 0) | 580 | (if (> day 0) |
| 568 | (let ((mdy (calendar-gregorian-from-absolute | 581 | (let ((mdy (calendar-gregorian-from-absolute |
| 569 | (+ (calendar-absolute-from-gregorian (list month day year)) | 582 | (+ (calendar-absolute-from-gregorian (list month day |
| 570 | (or day-shift 0))))) | 583 | year)) |
| 571 | (format "%04d%02d%02d" (nth 2 mdy) (nth 0 mdy) (nth 1 mdy))) | 584 | (or day-shift 0))))) |
| 585 | (format "%04d%02d%02d" (nth 2 mdy) (nth 0 mdy) (nth 1 mdy))) | ||
| 572 | nil))) | 586 | nil))) |
| 573 | 587 | ||
| 574 | (defun icalendar-dmsg (&rest args) | 588 | (defun icalendar--diarytime-to-isotime (timestring ampmstring) |
| 575 | "Print message ARGS if `icalendar-debug' is non-nil." | ||
| 576 | (if icalendar-debug | ||
| 577 | (apply 'message args))) | ||
| 578 | |||
| 579 | (defun icalendar-diarytime-to-isotime (timestring ampmstring) | ||
| 580 | "Convert a a time like 9:30pm to an iso-conform string like T213000. | 589 | "Convert a a time like 9:30pm to an iso-conform string like T213000. |
| 581 | In this example the TIMESTRING would be \"9:30\" and the AMPMSTRING | 590 | In this example the TIMESTRING would be \"9:30\" and the AMPMSTRING |
| 582 | would be \"pm\"." | 591 | would be \"pm\"." |
| 583 | (if timestring | 592 | (if timestring |
| 584 | (let ((starttimenum (read (icalendar-rris ":" "" timestring)))) | 593 | (let ((starttimenum (read (icalendar--rris ":" "" timestring)))) |
| 585 | ;; take care of am/pm style | 594 | ;; take care of am/pm style |
| 586 | (if (and ampmstring (string= "pm" ampmstring)) | 595 | (if (and ampmstring (string= "pm" ampmstring)) |
| 587 | (setq starttimenum (+ starttimenum 1200))) | 596 | (setq starttimenum (+ starttimenum 1200))) |
| 588 | (format "T%04d00" starttimenum)) | 597 | (format "T%04d00" starttimenum)) |
| 589 | nil)) | 598 | nil)) |
| 590 | 599 | ||
| 591 | (defun icalendar-convert-string-for-export (s) | 600 | (defun icalendar--convert-string-for-export (s) |
| 592 | "Escape comma and other critical characters in string S." | 601 | "Escape comma and other critical characters in string S." |
| 593 | (icalendar-rris "," "\\\\," s)) | 602 | (icalendar--rris "," "\\\\," s)) |
| 594 | 603 | ||
| 595 | (defun icalendar-convert-for-import (string) | 604 | (defun icalendar--convert-string-for-import (string) |
| 596 | "Remove escape chars for comma, semicolon etc. from STRING." | 605 | "Remove escape chars for comma, semicolon etc. from STRING." |
| 597 | (icalendar-rris | 606 | (icalendar--rris |
| 598 | "\\\\n" "\n " (icalendar-rris | 607 | "\\\\n" "\n " (icalendar--rris |
| 599 | "\\\\\"" "\"" (icalendar-rris | 608 | "\\\\\"" "\"" (icalendar--rris |
| 600 | "\\\\;" ";" (icalendar-rris | 609 | "\\\\;" ";" (icalendar--rris |
| 601 | "\\\\," "," string))))) | 610 | "\\\\," "," string))))) |
| 602 | 611 | ||
| 603 | ;; ====================================================================== | 612 | ;; ====================================================================== |
| 604 | ;; export -- convert emacs-diary to icalendar | 613 | ;; Export -- convert emacs-diary to icalendar |
| 605 | ;; ====================================================================== | 614 | ;; ====================================================================== |
| 606 | 615 | ||
| 607 | (defun icalendar-convert-diary-to-ical (diary-filename ical-filename | 616 | ;; User function |
| 608 | &optional do-not-clear-diary-file) | 617 | (defun icalendar-export-file (diary-filename ical-filename) |
| 609 | "Export diary file to iCalendar format -- erases ical-filename!!!. | 618 | "Export diary file to iCalendar format. |
| 610 | Argument DIARY-FILENAME is the input `diary-file'. | 619 | All diary entries in the file DIARY-FILENAME are converted to iCalendar |
| 611 | Argument ICAL-FILENAME is the output iCalendar file. | 620 | format. The result is appended to the file ICAL-FILENAME." |
| 612 | If DO-NOT-CLEAR-DIARY-FILE is not nil the target iCalendar file | ||
| 613 | is not erased." | ||
| 614 | (interactive "FExport diary data from file: | 621 | (interactive "FExport diary data from file: |
| 615 | Finto iCalendar file: ") | 622 | Finto iCalendar file: ") |
| 623 | (save-current-buffer | ||
| 624 | (set-buffer (find-file diary-filename)) | ||
| 625 | (icalendar-export-region (point-min) (point-max) ical-filename))) | ||
| 626 | |||
| 627 | (defalias 'icalendar-convert-diary-to-ical 'icalendar-export-file) | ||
| 628 | (make-obsolete 'icalendar-convert-diary-to-ical 'icalendar-export-file | ||
| 629 | "icalendar 0.07") | ||
| 630 | |||
| 631 | ;; User function | ||
| 632 | (defun icalendar-export-region (min max ical-filename) | ||
| 633 | "Export region in diary file to iCalendar format. | ||
| 634 | All diary entries in the region from MIN to MAX in the current buffer are | ||
| 635 | converted to iCalendar format. The result is appended to the file | ||
| 636 | ICAL-FILENAME." | ||
| 637 | (interactive "r | ||
| 638 | FExport diary data into iCalendar file: ") | ||
| 616 | (let ((result "") | 639 | (let ((result "") |
| 617 | (start 0) | 640 | (start 0) |
| 618 | (entry-main "") | 641 | (entry-main "") |
| @@ -621,12 +644,11 @@ Finto iCalendar file: ") | |||
| 621 | (contents) | 644 | (contents) |
| 622 | (oops nil) | 645 | (oops nil) |
| 623 | (nonmarker (concat "^" (regexp-quote diary-nonmarking-symbol) | 646 | (nonmarker (concat "^" (regexp-quote diary-nonmarking-symbol) |
| 624 | "?"))) | 647 | "?"))) |
| 625 | (save-current-buffer | 648 | (save-excursion |
| 626 | (set-buffer (find-file diary-filename)) | 649 | (goto-char min) |
| 627 | (goto-char (point-min)) | ||
| 628 | (while (re-search-forward | 650 | (while (re-search-forward |
| 629 | "^\\([^ \t\n].*\\)\\(\n[ \t].*\\)*" nil t) | 651 | "^\\([^ \t\n].*\\)\\(\n[ \t].*\\)*" max t) |
| 630 | (setq entry-main (match-string 1)) | 652 | (setq entry-main (match-string 1)) |
| 631 | (if (match-beginning 2) | 653 | (if (match-beginning 2) |
| 632 | (setq entry-rest (match-string 2)) | 654 | (setq entry-rest (match-string 2)) |
| @@ -642,16 +664,16 @@ Finto iCalendar file: ") | |||
| 642 | (concat nonmarker | 664 | (concat nonmarker |
| 643 | "%%(diary-anniversary \\([^)]+\\))\\s-*\\(.*\\)") | 665 | "%%(diary-anniversary \\([^)]+\\))\\s-*\\(.*\\)") |
| 644 | entry-main) | 666 | entry-main) |
| 645 | (icalendar-dmsg "diary-anniversary %s" entry-main) | 667 | (icalendar--dmsg "diary-anniversary %s" entry-main) |
| 646 | (let* ((datetime (substring entry-main (match-beginning 1) | 668 | (let* ((datetime (substring entry-main (match-beginning 1) |
| 647 | (match-end 1))) | 669 | (match-end 1))) |
| 648 | (summary (icalendar-convert-string-for-export | 670 | (summary (icalendar--convert-string-for-export |
| 649 | (substring entry-main (match-beginning 2) | 671 | (substring entry-main (match-beginning 2) |
| 650 | (match-end 2)))) | 672 | (match-end 2)))) |
| 651 | (startisostring (icalendar-datestring-to-isodate | 673 | (startisostring (icalendar--datestring-to-isodate |
| 652 | datetime)) | 674 | datetime)) |
| 653 | (endisostring (icalendar-datestring-to-isodate | 675 | (endisostring (icalendar--datestring-to-isodate |
| 654 | datetime 1))) | 676 | datetime 1))) |
| 655 | (setq contents | 677 | (setq contents |
| 656 | (concat "\nDTSTART;VALUE=DATE:" startisostring | 678 | (concat "\nDTSTART;VALUE=DATE:" startisostring |
| 657 | "\nDTEND;VALUE=DATE:" endisostring | 679 | "\nDTEND;VALUE=DATE:" endisostring |
| @@ -666,7 +688,7 @@ Finto iCalendar file: ") | |||
| 666 | ))) | 688 | ))) |
| 667 | (unless (string= entry-rest "") | 689 | (unless (string= entry-rest "") |
| 668 | (setq contents (concat contents "\nDESCRIPTION:" | 690 | (setq contents (concat contents "\nDESCRIPTION:" |
| 669 | (icalendar-convert-string-for-export | 691 | (icalendar--convert-string-for-export |
| 670 | entry-rest))))) | 692 | entry-rest))))) |
| 671 | ;; cyclic events | 693 | ;; cyclic events |
| 672 | ;; %%(diary-cyclic ) | 694 | ;; %%(diary-cyclic ) |
| @@ -675,18 +697,18 @@ Finto iCalendar file: ") | |||
| 675 | "%%(diary-cyclic \\([^ ]+\\) +" | 697 | "%%(diary-cyclic \\([^ ]+\\) +" |
| 676 | "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*\\(.*\\)") | 698 | "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*\\(.*\\)") |
| 677 | entry-main) | 699 | entry-main) |
| 678 | (icalendar-dmsg "diary-cyclic %s" entry-main) | 700 | (icalendar--dmsg "diary-cyclic %s" entry-main) |
| 679 | (let* ((frequency (substring entry-main (match-beginning 1) | 701 | (let* ((frequency (substring entry-main (match-beginning 1) |
| 680 | (match-end 1))) | 702 | (match-end 1))) |
| 681 | (datetime (substring entry-main (match-beginning 2) | 703 | (datetime (substring entry-main (match-beginning 2) |
| 682 | (match-end 2))) | 704 | (match-end 2))) |
| 683 | (summary (icalendar-convert-string-for-export | 705 | (summary (icalendar--convert-string-for-export |
| 684 | (substring entry-main (match-beginning 3) | 706 | (substring entry-main (match-beginning 3) |
| 685 | (match-end 3)))) | 707 | (match-end 3)))) |
| 686 | (startisostring (icalendar-datestring-to-isodate | 708 | (startisostring (icalendar--datestring-to-isodate |
| 687 | datetime)) | 709 | datetime)) |
| 688 | (endisostring (icalendar-datestring-to-isodate | 710 | (endisostring (icalendar--datestring-to-isodate |
| 689 | datetime 1))) | 711 | datetime 1))) |
| 690 | (setq contents | 712 | (setq contents |
| 691 | (concat "\nDTSTART;VALUE=DATE:" startisostring | 713 | (concat "\nDTSTART;VALUE=DATE:" startisostring |
| 692 | "\nDTEND;VALUE=DATE:" endisostring | 714 | "\nDTEND;VALUE=DATE:" endisostring |
| @@ -697,21 +719,21 @@ Finto iCalendar file: ") | |||
| 697 | ))) | 719 | ))) |
| 698 | (unless (string= entry-rest "") | 720 | (unless (string= entry-rest "") |
| 699 | (setq contents (concat contents "\nDESCRIPTION:" | 721 | (setq contents (concat contents "\nDESCRIPTION:" |
| 700 | (icalendar-convert-string-for-export | 722 | (icalendar--convert-string-for-export |
| 701 | entry-rest))))) | 723 | entry-rest))))) |
| 702 | ;; diary-date -- FIXME | 724 | ;; diary-date -- FIXME |
| 703 | ((string-match | 725 | ((string-match |
| 704 | (concat nonmarker | 726 | (concat nonmarker |
| 705 | "%%(diary-date \\([^)]+\\))\\s-*\\(.*\\)") | 727 | "%%(diary-date \\([^)]+\\))\\s-*\\(.*\\)") |
| 706 | entry-main) | 728 | entry-main) |
| 707 | (icalendar-dmsg "diary-date %s" entry-main) | 729 | (icalendar--dmsg "diary-date %s" entry-main) |
| 708 | (setq oops t)) | 730 | (setq oops t)) |
| 709 | ;; float events -- FIXME | 731 | ;; float events -- FIXME |
| 710 | ((string-match | 732 | ((string-match |
| 711 | (concat nonmarker | 733 | (concat nonmarker |
| 712 | "%%(diary-float \\([^)]+\\))\\s-*\\(.*\\)") | 734 | "%%(diary-float \\([^)]+\\))\\s-*\\(.*\\)") |
| 713 | entry-main) | 735 | entry-main) |
| 714 | (icalendar-dmsg "diary-float %s" entry-main) | 736 | (icalendar--dmsg "diary-float %s" entry-main) |
| 715 | (setq oops t)) | 737 | (setq oops t)) |
| 716 | ;; block events | 738 | ;; block events |
| 717 | ((string-match | 739 | ((string-match |
| @@ -719,18 +741,18 @@ Finto iCalendar file: ") | |||
| 719 | "%%(diary-block \\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\) +" | 741 | "%%(diary-block \\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\) +" |
| 720 | "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*\\(.*\\)") | 742 | "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*\\(.*\\)") |
| 721 | entry-main) | 743 | entry-main) |
| 722 | (icalendar-dmsg "diary-block %s" entry-main) | 744 | (icalendar--dmsg "diary-block %s" entry-main) |
| 723 | (let* ((startstring (substring entry-main (match-beginning 1) | 745 | (let* ((startstring (substring entry-main (match-beginning 1) |
| 724 | (match-end 1))) | 746 | (match-end 1))) |
| 725 | (endstring (substring entry-main (match-beginning 2) | 747 | (endstring (substring entry-main (match-beginning 2) |
| 726 | (match-end 2))) | 748 | (match-end 2))) |
| 727 | (summary (icalendar-convert-string-for-export | 749 | (summary (icalendar--convert-string-for-export |
| 728 | (substring entry-main (match-beginning 3) | 750 | (substring entry-main (match-beginning 3) |
| 729 | (match-end 3)))) | 751 | (match-end 3)))) |
| 730 | (startisostring (icalendar-datestring-to-isodate | 752 | (startisostring (icalendar--datestring-to-isodate |
| 731 | startstring)) | 753 | startstring)) |
| 732 | (endisostring (icalendar-datestring-to-isodate | 754 | (endisostring (icalendar--datestring-to-isodate |
| 733 | endstring 1))) | 755 | endstring 1))) |
| 734 | (setq contents | 756 | (setq contents |
| 735 | (concat "\nDTSTART;VALUE=DATE:" startisostring | 757 | (concat "\nDTSTART;VALUE=DATE:" startisostring |
| 736 | "\nDTEND;VALUE=DATE:" endisostring | 758 | "\nDTEND;VALUE=DATE:" endisostring |
| @@ -738,14 +760,14 @@ Finto iCalendar file: ") | |||
| 738 | )) | 760 | )) |
| 739 | (unless (string= entry-rest "") | 761 | (unless (string= entry-rest "") |
| 740 | (setq contents (concat contents "\nDESCRIPTION:" | 762 | (setq contents (concat contents "\nDESCRIPTION:" |
| 741 | (icalendar-convert-string-for-export | 763 | (icalendar--convert-string-for-export |
| 742 | entry-rest)))))) | 764 | entry-rest)))))) |
| 743 | ;; other sexp diary entries -- FIXME | 765 | ;; other sexp diary entries -- FIXME |
| 744 | ((string-match | 766 | ((string-match |
| 745 | (concat nonmarker | 767 | (concat nonmarker |
| 746 | "%%(\\([^)]+\\))\\s-*\\(.*\\)") | 768 | "%%(\\([^)]+\\))\\s-*\\(.*\\)") |
| 747 | entry-main) | 769 | entry-main) |
| 748 | (icalendar-dmsg "diary-sexp %s" entry-main) | 770 | (icalendar--dmsg "diary-sexp %s" entry-main) |
| 749 | (setq oops t)) | 771 | (setq oops t)) |
| 750 | ;; weekly by day | 772 | ;; weekly by day |
| 751 | ;; Monday 8:30 Team meeting | 773 | ;; Monday 8:30 Team meeting |
| @@ -758,13 +780,13 @@ Finto iCalendar file: ") | |||
| 758 | "\\)?" | 780 | "\\)?" |
| 759 | "\\s-*\\(.*\\)$") | 781 | "\\s-*\\(.*\\)$") |
| 760 | entry-main) | 782 | entry-main) |
| 761 | (icalendar-get-weekday-abbrev | 783 | (icalendar--get-weekday-abbrev |
| 762 | (substring entry-main (match-beginning 1) (match-end 1)))) | 784 | (substring entry-main (match-beginning 1) (match-end 1)))) |
| 763 | (icalendar-dmsg "weekly %s" entry-main) | 785 | (icalendar--dmsg "weekly %s" entry-main) |
| 764 | (let* ((day (icalendar-get-weekday-abbrev | 786 | (let* ((day (icalendar--get-weekday-abbrev |
| 765 | (substring entry-main (match-beginning 1) | 787 | (substring entry-main (match-beginning 1) |
| 766 | (match-end 1)))) | 788 | (match-end 1)))) |
| 767 | (starttimestring (icalendar-diarytime-to-isotime | 789 | (starttimestring (icalendar--diarytime-to-isotime |
| 768 | (if (match-beginning 3) | 790 | (if (match-beginning 3) |
| 769 | (substring entry-main | 791 | (substring entry-main |
| 770 | (match-beginning 3) | 792 | (match-beginning 3) |
| @@ -775,24 +797,24 @@ Finto iCalendar file: ") | |||
| 775 | (match-beginning 4) | 797 | (match-beginning 4) |
| 776 | (match-end 4)) | 798 | (match-end 4)) |
| 777 | nil))) | 799 | nil))) |
| 778 | (endtimestring (icalendar-diarytime-to-isotime | 800 | (endtimestring (icalendar--diarytime-to-isotime |
| 779 | (if (match-beginning 6) | 801 | (if (match-beginning 6) |
| 780 | (substring entry-main | 802 | (substring entry-main |
| 781 | (match-beginning 6) | 803 | (match-beginning 6) |
| 782 | (match-end 6)) | 804 | (match-end 6)) |
| 783 | nil) | 805 | nil) |
| 784 | (if (match-beginning 7) | 806 | (if (match-beginning 7) |
| 785 | (substring entry-main | 807 | (substring entry-main |
| 786 | (match-beginning 7) | 808 | (match-beginning 7) |
| 787 | (match-end 7)) | 809 | (match-end 7)) |
| 788 | nil))) | 810 | nil))) |
| 789 | (summary (icalendar-convert-string-for-export | 811 | (summary (icalendar--convert-string-for-export |
| 790 | (substring entry-main (match-beginning 8) | 812 | (substring entry-main (match-beginning 8) |
| 791 | (match-end 8))))) | 813 | (match-end 8))))) |
| 792 | (when starttimestring | 814 | (when starttimestring |
| 793 | (unless endtimestring | 815 | (unless endtimestring |
| 794 | (let ((time (read (icalendar-rris "^T0?" "" | 816 | (let ((time (read (icalendar--rris "^T0?" "" |
| 795 | starttimestring)))) | 817 | starttimestring)))) |
| 796 | (setq endtimestring (format "T%06d" (+ 10000 time)))))) | 818 | (setq endtimestring (format "T%06d" (+ 10000 time)))))) |
| 797 | (setq contents | 819 | (setq contents |
| 798 | (concat "\nDTSTART" | 820 | (concat "\nDTSTART" |
| @@ -809,7 +831,7 @@ Finto iCalendar file: ") | |||
| 809 | ))) | 831 | ))) |
| 810 | (unless (string= entry-rest "") | 832 | (unless (string= entry-rest "") |
| 811 | (setq contents (concat contents "\nDESCRIPTION:" | 833 | (setq contents (concat contents "\nDESCRIPTION:" |
| 812 | (icalendar-convert-string-for-export | 834 | (icalendar--convert-string-for-export |
| 813 | entry-rest))))) | 835 | entry-rest))))) |
| 814 | ;; yearly by day | 836 | ;; yearly by day |
| 815 | ;; 1 May Tag der Arbeit | 837 | ;; 1 May Tag der Arbeit |
| @@ -821,20 +843,20 @@ Finto iCalendar file: ") | |||
| 821 | "\\*?\\s-*" | 843 | "\\*?\\s-*" |
| 822 | "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?" | 844 | "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?" |
| 823 | "\\(" | 845 | "\\(" |
| 824 | "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?" | 846 | "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?" |
| 825 | "\\)?" | 847 | "\\)?" |
| 826 | "\\s-*\\([^0-9]+.*\\)$"; must not match years | 848 | "\\s-*\\([^0-9]+.*\\)$" ; must not match years |
| 827 | ) | 849 | ) |
| 828 | entry-main) | 850 | entry-main) |
| 829 | (icalendar-dmsg "yearly %s" entry-main) | 851 | (icalendar--dmsg "yearly %s" entry-main) |
| 830 | (let* ((daypos (if european-calendar-style 1 2)) | 852 | (let* ((daypos (if european-calendar-style 1 2)) |
| 831 | (monpos (if european-calendar-style 2 1)) | 853 | (monpos (if european-calendar-style 2 1)) |
| 832 | (day (read (substring entry-main (match-beginning daypos) | 854 | (day (read (substring entry-main (match-beginning daypos) |
| 833 | (match-end daypos)))) | 855 | (match-end daypos)))) |
| 834 | (month (icalendar-get-month-number | 856 | (month (icalendar--get-month-number |
| 835 | (substring entry-main (match-beginning monpos) | 857 | (substring entry-main (match-beginning monpos) |
| 836 | (match-end monpos)))) | 858 | (match-end monpos)))) |
| 837 | (starttimestring (icalendar-diarytime-to-isotime | 859 | (starttimestring (icalendar--diarytime-to-isotime |
| 838 | (if (match-beginning 4) | 860 | (if (match-beginning 4) |
| 839 | (substring entry-main | 861 | (substring entry-main |
| 840 | (match-beginning 4) | 862 | (match-beginning 4) |
| @@ -845,24 +867,24 @@ Finto iCalendar file: ") | |||
| 845 | (match-beginning 5) | 867 | (match-beginning 5) |
| 846 | (match-end 5)) | 868 | (match-end 5)) |
| 847 | nil))) | 869 | nil))) |
| 848 | (endtimestring (icalendar-diarytime-to-isotime | 870 | (endtimestring (icalendar--diarytime-to-isotime |
| 849 | (if (match-beginning 7) | 871 | (if (match-beginning 7) |
| 850 | (substring entry-main | 872 | (substring entry-main |
| 851 | (match-beginning 7) | 873 | (match-beginning 7) |
| 852 | (match-end 7)) | 874 | (match-end 7)) |
| 853 | nil) | 875 | nil) |
| 854 | (if (match-beginning 8) | 876 | (if (match-beginning 8) |
| 855 | (substring entry-main | 877 | (substring entry-main |
| 856 | (match-beginning 8) | 878 | (match-beginning 8) |
| 857 | (match-end 8)) | 879 | (match-end 8)) |
| 858 | nil))) | 880 | nil))) |
| 859 | (summary (icalendar-convert-string-for-export | 881 | (summary (icalendar--convert-string-for-export |
| 860 | (substring entry-main (match-beginning 9) | 882 | (substring entry-main (match-beginning 9) |
| 861 | (match-end 9))))) | 883 | (match-end 9))))) |
| 862 | (when starttimestring | 884 | (when starttimestring |
| 863 | (unless endtimestring | 885 | (unless endtimestring |
| 864 | (let ((time (read (icalendar-rris "^T0?" "" | 886 | (let ((time (read (icalendar--rris "^T0?" "" |
| 865 | starttimestring)))) | 887 | starttimestring)))) |
| 866 | (setq endtimestring (format "T%06d" (+ 10000 time)))))) | 888 | (setq endtimestring (format "T%06d" (+ 10000 time)))))) |
| 867 | (setq contents | 889 | (setq contents |
| 868 | (concat "\nDTSTART" | 890 | (concat "\nDTSTART" |
| @@ -881,7 +903,7 @@ Finto iCalendar file: ") | |||
| 881 | ))) | 903 | ))) |
| 882 | (unless (string= entry-rest "") | 904 | (unless (string= entry-rest "") |
| 883 | (setq contents (concat contents "\nDESCRIPTION:" | 905 | (setq contents (concat contents "\nDESCRIPTION:" |
| 884 | (icalendar-convert-string-for-export | 906 | (icalendar--convert-string-for-export |
| 885 | entry-rest))))) | 907 | entry-rest))))) |
| 886 | ;; "ordinary" events, start and end time given | 908 | ;; "ordinary" events, start and end time given |
| 887 | ;; 1 Feb 2003 Hs Hochzeitsfeier, Dreieich | 909 | ;; 1 Feb 2003 Hs Hochzeitsfeier, Dreieich |
| @@ -890,15 +912,15 @@ Finto iCalendar file: ") | |||
| 890 | "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\)\\s-+" | 912 | "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\)\\s-+" |
| 891 | "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?" | 913 | "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?" |
| 892 | "\\(" | 914 | "\\(" |
| 893 | "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?" | 915 | "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?" |
| 894 | "\\)?" | 916 | "\\)?" |
| 895 | "\\s-*\\(.*\\)") | 917 | "\\s-*\\(.*\\)") |
| 896 | entry-main) | 918 | entry-main) |
| 897 | (icalendar-dmsg "ordinary %s" entry-main) | 919 | (icalendar--dmsg "ordinary %s" entry-main) |
| 898 | (let* ((datestring (icalendar-datestring-to-isodate | 920 | (let* ((datestring (icalendar--datestring-to-isodate |
| 899 | (substring entry-main (match-beginning 1) | 921 | (substring entry-main (match-beginning 1) |
| 900 | (match-end 1)))) | 922 | (match-end 1)))) |
| 901 | (starttimestring (icalendar-diarytime-to-isotime | 923 | (starttimestring (icalendar--diarytime-to-isotime |
| 902 | (if (match-beginning 3) | 924 | (if (match-beginning 3) |
| 903 | (substring entry-main | 925 | (substring entry-main |
| 904 | (match-beginning 3) | 926 | (match-beginning 3) |
| @@ -909,38 +931,38 @@ Finto iCalendar file: ") | |||
| 909 | (match-beginning 4) | 931 | (match-beginning 4) |
| 910 | (match-end 4)) | 932 | (match-end 4)) |
| 911 | nil))) | 933 | nil))) |
| 912 | (endtimestring (icalendar-diarytime-to-isotime | 934 | (endtimestring (icalendar--diarytime-to-isotime |
| 913 | (if (match-beginning 6) | 935 | (if (match-beginning 6) |
| 914 | (substring entry-main | 936 | (substring entry-main |
| 915 | (match-beginning 6) | 937 | (match-beginning 6) |
| 916 | (match-end 6)) | 938 | (match-end 6)) |
| 917 | nil) | 939 | nil) |
| 918 | (if (match-beginning 7) | 940 | (if (match-beginning 7) |
| 919 | (substring entry-main | 941 | (substring entry-main |
| 920 | (match-beginning 7) | 942 | (match-beginning 7) |
| 921 | (match-end 7)) | 943 | (match-end 7)) |
| 922 | nil))) | 944 | nil))) |
| 923 | (summary (icalendar-convert-string-for-export | 945 | (summary (icalendar--convert-string-for-export |
| 924 | (substring entry-main (match-beginning 8) | 946 | (substring entry-main (match-beginning 8) |
| 925 | (match-end 8))))) | 947 | (match-end 8))))) |
| 926 | (when starttimestring | 948 | (when starttimestring |
| 927 | (unless endtimestring | 949 | (unless endtimestring |
| 928 | (let ((time (read (icalendar-rris "^T0?" "" | 950 | (let ((time (read (icalendar--rris "^T0?" "" |
| 929 | starttimestring)))) | 951 | starttimestring)))) |
| 930 | (setq endtimestring (format "T%06d" (+ 10000 time)))))) | 952 | (setq endtimestring (format "T%06d" (+ 10000 time)))))) |
| 931 | (setq contents (format | 953 | (setq contents (format |
| 932 | "\nDTSTART%s:%s%s\nDTEND%s:%s%s\nSUMMARY:%s" | 954 | "\nDTSTART%s:%s%s\nDTEND%s:%s%s\nSUMMARY:%s" |
| 933 | (if starttimestring "" ";VALUE=DATE") | 955 | (if starttimestring "" ";VALUE=DATE") |
| 934 | datestring | 956 | datestring |
| 935 | (or starttimestring "") | 957 | (or starttimestring "") |
| 936 | (if endtimestring "" | 958 | (if endtimestring "" |
| 937 | ";VALUE=DATE") | 959 | ";VALUE=DATE") |
| 938 | datestring | 960 | datestring |
| 939 | (or endtimestring "") | 961 | (or endtimestring "") |
| 940 | summary)) | 962 | summary)) |
| 941 | (unless (string= entry-rest "") | 963 | (unless (string= entry-rest "") |
| 942 | (setq contents (concat contents "\nDESCRIPTION:" | 964 | (setq contents (concat contents "\nDESCRIPTION:" |
| 943 | (icalendar-convert-string-for-export | 965 | (icalendar--convert-string-for-export |
| 944 | entry-rest)))))) | 966 | entry-rest)))))) |
| 945 | ;; everything else | 967 | ;; everything else |
| 946 | (t | 968 | (t |
| @@ -948,52 +970,42 @@ Finto iCalendar file: ") | |||
| 948 | (setq oops t))) | 970 | (setq oops t))) |
| 949 | (if oops | 971 | (if oops |
| 950 | (message "Cannot export entry on line %d" | 972 | (message "Cannot export entry on line %d" |
| 951 | (count-lines (point-min) (point))) | 973 | (count-lines (point-min) (point))) |
| 952 | (setq result (concat result header contents "\nEND:VEVENT")))) | 974 | (setq result (concat result header contents "\nEND:VEVENT")))) |
| 953 | ;; we're done, insert everything into the file | 975 | ;; we're done, insert everything into the file |
| 954 | (let ((coding-system-for-write 'utf8)) | 976 | (let ((coding-system-for-write 'utf8)) |
| 955 | (set-buffer (find-file ical-filename)) | 977 | (set-buffer (find-file ical-filename)) |
| 956 | (unless do-not-clear-diary-file | 978 | (goto-char (point-max)) |
| 957 | (erase-buffer)) | 979 | (insert "BEGIN:VCALENDAR") |
| 958 | (insert | 980 | (insert "\nPRODID:-//Emacs//NONSGML icalendar.el//EN") |
| 959 | "BEGIN:VCALENDAR\nPRODID:-//Emacs//NONSGML icalendar.el//EN") | ||
| 960 | (insert "\nVERSION:2.0") | 981 | (insert "\nVERSION:2.0") |
| 961 | (insert result) | 982 | (insert result) |
| 962 | (insert "\nEND:VCALENDAR\n"))))) | 983 | (insert "\nEND:VCALENDAR\n"))))) |
| 963 | 984 | ||
| 964 | |||
| 965 | ;; ====================================================================== | 985 | ;; ====================================================================== |
| 966 | ;; import -- convert icalendar to emacs-diary | 986 | ;; Import -- convert icalendar to emacs-diary |
| 967 | ;; ====================================================================== | 987 | ;; ====================================================================== |
| 968 | 988 | ||
| 969 | ;; user function | 989 | ;; User function |
| 970 | (defun icalendar-import-file (ical-filename diary-filename | 990 | (defun icalendar-import-file (ical-filename diary-filename |
| 971 | &optional non-marking | 991 | &optional non-marking) |
| 972 | do-not-clear-diary-file) | 992 | "Import a iCalendar file and append to a diary file. |
| 973 | "Import a iCalendar file and save to a diary file -- erases diary-file! | ||
| 974 | Argument ICAL-FILENAME output iCalendar file. | 993 | Argument ICAL-FILENAME output iCalendar file. |
| 975 | Argument DIARY-FILENAME input `diary-file'. | 994 | Argument DIARY-FILENAME input `diary-file'. |
| 976 | Optional argument NON-MARKING determines whether events are created as | 995 | Optional argument NON-MARKING determines whether events are created as |
| 977 | non-marking or not. | 996 | non-marking or not." |
| 978 | If DO-NOT-CLEAR-DIARY-FILE is not nil the target diary file is | ||
| 979 | not erased." | ||
| 980 | (interactive "fImport iCalendar data from file: | 997 | (interactive "fImport iCalendar data from file: |
| 981 | Finto diary file (will be erased!): | 998 | Finto diary file: |
| 982 | p") | 999 | p") |
| 983 | ;; clean up the diary file | 1000 | ;; clean up the diary file |
| 984 | (save-current-buffer | 1001 | (save-current-buffer |
| 985 | (unless do-not-clear-diary-file | ||
| 986 | ;; clear the target diary file | ||
| 987 | (set-buffer (find-file diary-filename)) | ||
| 988 | (erase-buffer)) | ||
| 989 | ;; now load and convert from the ical file | 1002 | ;; now load and convert from the ical file |
| 990 | (set-buffer (find-file ical-filename)) | 1003 | (set-buffer (find-file ical-filename)) |
| 991 | (icalendar-extract-ical-from-buffer diary-filename t non-marking))) | 1004 | (icalendar-import-buffer diary-filename t non-marking))) |
| 992 | 1005 | ||
| 993 | ; user function | 1006 | ;; User function |
| 994 | (defun icalendar-extract-ical-from-buffer (&optional | 1007 | (defun icalendar-import-buffer (&optional diary-file do-not-ask |
| 995 | diary-file do-not-ask | 1008 | non-marking) |
| 996 | non-marking) | ||
| 997 | "Extract iCalendar events from current buffer. | 1009 | "Extract iCalendar events from current buffer. |
| 998 | 1010 | ||
| 999 | This function searches the current buffer for the first iCalendar | 1011 | This function searches the current buffer for the first iCalendar |
| @@ -1013,7 +1025,7 @@ reading, parsing, or converting iCalendar data!" | |||
| 1013 | (save-current-buffer | 1025 | (save-current-buffer |
| 1014 | ;; prepare ical | 1026 | ;; prepare ical |
| 1015 | (message "Preparing icalendar...") | 1027 | (message "Preparing icalendar...") |
| 1016 | (set-buffer (icalendar-get-unfolded-buffer (current-buffer))) | 1028 | (set-buffer (icalendar--get-unfolded-buffer (current-buffer))) |
| 1017 | (goto-char (point-min)) | 1029 | (goto-char (point-min)) |
| 1018 | (message "Preparing icalendar...done") | 1030 | (message "Preparing icalendar...done") |
| 1019 | (if (re-search-forward "^BEGIN:VCALENDAR\\s-*$" nil t) | 1031 | (if (re-search-forward "^BEGIN:VCALENDAR\\s-*$" nil t) |
| @@ -1021,11 +1033,11 @@ reading, parsing, or converting iCalendar data!" | |||
| 1021 | ;; read ical | 1033 | ;; read ical |
| 1022 | (message "Reading icalendar...") | 1034 | (message "Reading icalendar...") |
| 1023 | (beginning-of-line) | 1035 | (beginning-of-line) |
| 1024 | (setq ical-contents (icalendar-read-element nil nil)) | 1036 | (setq ical-contents (icalendar--read-element nil nil)) |
| 1025 | (message "Reading icalendar...done") | 1037 | (message "Reading icalendar...done") |
| 1026 | ;; convert ical | 1038 | ;; convert ical |
| 1027 | (message "Converting icalendar...") | 1039 | (message "Converting icalendar...") |
| 1028 | (setq ical-errors (icalendar-convert-ical-to-diary | 1040 | (setq ical-errors (icalendar--convert-ical-to-diary |
| 1029 | ical-contents | 1041 | ical-contents |
| 1030 | diary-file do-not-ask non-marking)) | 1042 | diary-file do-not-ask non-marking)) |
| 1031 | (when diary-file | 1043 | (when diary-file |
| @@ -1035,17 +1047,23 @@ reading, parsing, or converting iCalendar data!" | |||
| 1035 | (save-buffer))) | 1047 | (save-buffer))) |
| 1036 | (message "Converting icalendar...done") | 1048 | (message "Converting icalendar...done") |
| 1037 | (if (and ical-errors (y-or-n-p | 1049 | (if (and ical-errors (y-or-n-p |
| 1038 | (concat "Something went wrong -- " | 1050 | (concat "Something went wrong -- " |
| 1039 | "do you want to see the " | 1051 | "do you want to see the " |
| 1040 | "error log? "))) | 1052 | "error log? "))) |
| 1041 | (switch-to-buffer " *icalendar-errors*"))) | 1053 | (switch-to-buffer " *icalendar-errors*"))) |
| 1042 | (message | 1054 | (message |
| 1043 | "Current buffer does not contain icalendar contents!")))) | 1055 | "Current buffer does not contain icalendar contents!")))) |
| 1044 | 1056 | ||
| 1045 | ;; ---------------------------------------------------------------------- | 1057 | (defalias 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer) |
| 1058 | |||
| 1059 | (make-obsolete 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer | ||
| 1060 | "icalendar 0.07") | ||
| 1061 | |||
| 1062 | ;; ====================================================================== | ||
| 1046 | ;; private area | 1063 | ;; private area |
| 1047 | ;; ---------------------------------------------------------------------- | 1064 | ;; ====================================================================== |
| 1048 | (defun icalendar-format-ical-event (event) | 1065 | |
| 1066 | (defun icalendar--format-ical-event (event) | ||
| 1049 | "Create a string representation of an iCalendar EVENT." | 1067 | "Create a string representation of an iCalendar EVENT." |
| 1050 | (let ((string icalendar-import-format) | 1068 | (let ((string icalendar-import-format) |
| 1051 | (conversion-list | 1069 | (conversion-list |
| @@ -1058,25 +1076,23 @@ reading, parsing, or converting iCalendar data!" | |||
| 1058 | (let* ((spec (car i)) | 1076 | (let* ((spec (car i)) |
| 1059 | (prop (cadr i)) | 1077 | (prop (cadr i)) |
| 1060 | (format (car (cddr i))) | 1078 | (format (car (cddr i))) |
| 1061 | (contents (icalendar-get-event-property event prop)) | 1079 | (contents (icalendar--get-event-property event prop)) |
| 1062 | (formatted-contents "")) | 1080 | (formatted-contents "")) |
| 1063 | ;;(message "%s" event) | ||
| 1064 | ;;(message "contents%s = %s" prop contents) | ||
| 1065 | (when (and contents (> (length contents) 0)) | 1081 | (when (and contents (> (length contents) 0)) |
| 1066 | (setq formatted-contents | 1082 | (setq formatted-contents |
| 1067 | (icalendar-rris "%s" | 1083 | (icalendar--rris "%s" |
| 1068 | (icalendar-convert-for-import | 1084 | (icalendar--convert-string-for-import |
| 1069 | contents) | 1085 | contents) |
| 1070 | (symbol-value format)))) | 1086 | (symbol-value format)))) |
| 1071 | (setq string (icalendar-rris spec | 1087 | (setq string (icalendar--rris spec |
| 1072 | formatted-contents | 1088 | formatted-contents |
| 1073 | string)))) | 1089 | string)))) |
| 1074 | conversion-list) | 1090 | conversion-list) |
| 1075 | string)) | 1091 | string)) |
| 1076 | 1092 | ||
| 1077 | (defun icalendar-convert-ical-to-diary (ical-list diary-file | 1093 | (defun icalendar--convert-ical-to-diary (ical-list diary-file |
| 1078 | &optional do-not-ask | 1094 | &optional do-not-ask |
| 1079 | non-marking) | 1095 | non-marking) |
| 1080 | "Convert an iCalendar file to an Emacs diary file. | 1096 | "Convert an iCalendar file to an Emacs diary file. |
| 1081 | Import VEVENTS from the iCalendar object ICAL-LIST and saves them to a | 1097 | Import VEVENTS from the iCalendar object ICAL-LIST and saves them to a |
| 1082 | DIARY-FILE. If DO-NOT-ASK is nil the user is asked for each event | 1098 | DIARY-FILE. If DO-NOT-ASK is nil the user is asked for each event |
| @@ -1085,7 +1101,7 @@ events are created as non-marking. | |||
| 1085 | This function attempts to return t if something goes wrong. In this | 1101 | This function attempts to return t if something goes wrong. In this |
| 1086 | case an error string which describes all the errors and problems is | 1102 | case an error string which describes all the errors and problems is |
| 1087 | written into the buffer ` *icalendar-errors*'." | 1103 | written into the buffer ` *icalendar-errors*'." |
| 1088 | (let* ((ev (icalendar-all-events ical-list)) | 1104 | (let* ((ev (icalendar--all-events ical-list)) |
| 1089 | (error-string "") | 1105 | (error-string "") |
| 1090 | (event-ok t) | 1106 | (event-ok t) |
| 1091 | (found-error nil) | 1107 | (found-error nil) |
| @@ -1096,69 +1112,69 @@ written into the buffer ` *icalendar-errors*'." | |||
| 1096 | (setq ev (cdr ev)) | 1112 | (setq ev (cdr ev)) |
| 1097 | (setq event-ok nil) | 1113 | (setq event-ok nil) |
| 1098 | (condition-case error-val | 1114 | (condition-case error-val |
| 1099 | (let* ((dtstart (icalendar-decode-isodatetime | 1115 | (let* ((dtstart (icalendar--decode-isodatetime |
| 1100 | (icalendar-get-event-property e 'DTSTART))) | 1116 | (icalendar--get-event-property e 'DTSTART))) |
| 1101 | (start-d (calendar-date-string | 1117 | (start-d (calendar-date-string |
| 1102 | (icalendar-datetime-to-noneuropean-date | 1118 | (icalendar--datetime-to-noneuropean-date |
| 1103 | dtstart) | 1119 | dtstart) |
| 1104 | t t)) | 1120 | t t)) |
| 1105 | (start-t (icalendar-datetime-to-colontime dtstart)) | 1121 | (start-t (icalendar--datetime-to-colontime dtstart)) |
| 1106 | (dtend (icalendar-decode-isodatetime | 1122 | (dtend (icalendar--decode-isodatetime |
| 1107 | (icalendar-get-event-property e 'DTEND))) | 1123 | (icalendar--get-event-property e 'DTEND))) |
| 1108 | end-d | 1124 | end-d |
| 1109 | end-t | 1125 | end-t |
| 1110 | (subject (icalendar-convert-for-import | 1126 | (subject (icalendar--convert-string-for-import |
| 1111 | (or (icalendar-get-event-property e 'SUMMARY) | 1127 | (or (icalendar--get-event-property e 'SUMMARY) |
| 1112 | "No Subject"))) | 1128 | "No Subject"))) |
| 1113 | (rrule (icalendar-get-event-property e 'RRULE)) | 1129 | (rrule (icalendar--get-event-property e 'RRULE)) |
| 1114 | (rdate (icalendar-get-event-property e 'RDATE)) | 1130 | (rdate (icalendar--get-event-property e 'RDATE)) |
| 1115 | (duration (icalendar-get-event-property e 'DURATION))) | 1131 | (duration (icalendar--get-event-property e 'DURATION))) |
| 1116 | (icalendar-dmsg "%s: %s" start-d subject) | 1132 | (icalendar--dmsg "%s: %s" start-d subject) |
| 1117 | (when duration | 1133 | (when duration |
| 1118 | (let ((dtend2 (icalendar-add-decoded-times | 1134 | (let ((dtend2 (icalendar--add-decoded-times |
| 1119 | dtstart | 1135 | dtstart |
| 1120 | (icalendar-decode-isoduration duration)))) | 1136 | (icalendar--decode-isoduration duration)))) |
| 1121 | (if (and dtend (not (eq dtend dtend2))) | 1137 | (if (and dtend (not (eq dtend dtend2))) |
| 1122 | (message "Inconsistent endtime and duration for %s" | 1138 | (message "Inconsistent endtime and duration for %s" |
| 1123 | subject)) | 1139 | subject)) |
| 1124 | (setq dtend dtend2))) | 1140 | (setq dtend dtend2))) |
| 1125 | (setq end-d (if dtend | 1141 | (setq end-d (if dtend |
| 1126 | (calendar-date-string | 1142 | (calendar-date-string |
| 1127 | (icalendar-datetime-to-noneuropean-date | 1143 | (icalendar--datetime-to-noneuropean-date |
| 1128 | dtend) | 1144 | dtend) |
| 1129 | t t) | 1145 | t t) |
| 1130 | start-d)) | 1146 | start-d)) |
| 1131 | (setq end-t (if dtend | 1147 | (setq end-t (if dtend |
| 1132 | (icalendar-datetime-to-colontime dtend) | 1148 | (icalendar--datetime-to-colontime dtend) |
| 1133 | start-t)) | 1149 | start-t)) |
| 1134 | (icalendar-dmsg "start-d: %s, end-d: %s" start-d end-d) | 1150 | (icalendar--dmsg "start-d: %s, end-d: %s" start-d end-d) |
| 1135 | (cond | 1151 | (cond |
| 1136 | ;; recurring event | 1152 | ;; recurring event |
| 1137 | (rrule | 1153 | (rrule |
| 1138 | (icalendar-dmsg "recurring event") | 1154 | (icalendar--dmsg "recurring event") |
| 1139 | (let* ((rrule-props (icalendar-split-value rrule)) | 1155 | (let* ((rrule-props (icalendar--split-value rrule)) |
| 1140 | (frequency (car (cdr (assoc 'FREQ rrule-props)))) | 1156 | (frequency (car (cdr (assoc 'FREQ rrule-props)))) |
| 1141 | (until (car (cdr (assoc 'UNTIL rrule-props)))) | 1157 | (until (car (cdr (assoc 'UNTIL rrule-props)))) |
| 1142 | (interval (read (car (cdr (assoc 'INTERVAL | 1158 | (interval (read (car (cdr (assoc 'INTERVAL |
| 1143 | rrule-props)))))) | 1159 | rrule-props)))))) |
| 1144 | (cond ((string-equal frequency "WEEKLY") | 1160 | (cond ((string-equal frequency "WEEKLY") |
| 1145 | (if (not start-t) | 1161 | (if (not start-t) |
| 1146 | (progn | 1162 | (progn |
| 1147 | ;; weekly and all-day | 1163 | ;; weekly and all-day |
| 1148 | (icalendar-dmsg "weekly all-day") | 1164 | (icalendar--dmsg "weekly all-day") |
| 1149 | (setq diary-string | 1165 | (setq diary-string |
| 1150 | (format | 1166 | (format |
| 1151 | "%%%%(diary-cyclic %d %s)" | 1167 | "%%%%(diary-cyclic %d %s)" |
| 1152 | (* interval 7) | 1168 | (* interval 7) |
| 1153 | (icalendar-datetime-to-european-date | 1169 | (icalendar--datetime-to-european-date |
| 1154 | dtstart)))) | 1170 | dtstart)))) |
| 1155 | ;; weekly and not all-day | 1171 | ;; weekly and not all-day |
| 1156 | (let* ((byday (cadr (assoc 'BYDAY rrule-props))) | 1172 | (let* ((byday (cadr (assoc 'BYDAY rrule-props))) |
| 1157 | (weekday | 1173 | (weekday |
| 1158 | (cdr (rassoc | 1174 | (cdr (rassoc |
| 1159 | byday | 1175 | byday |
| 1160 | icalendar-weekdayabbrev-table)))) | 1176 | icalendar-weekdayabbrev-table)))) |
| 1161 | (icalendar-dmsg "weekly not-all-day") | 1177 | (icalendar--dmsg "weekly not-all-day") |
| 1162 | (if weekday | 1178 | (if weekday |
| 1163 | (setq diary-string | 1179 | (setq diary-string |
| 1164 | (format "%s %s%s%s" weekday | 1180 | (format "%s %s%s%s" weekday |
| @@ -1169,19 +1185,19 @@ written into the buffer ` *icalendar-errors*'." | |||
| 1169 | ;; DTEND;VALUE=DATE-TIME:20030919T113000 | 1185 | ;; DTEND;VALUE=DATE-TIME:20030919T113000 |
| 1170 | (setq diary-string | 1186 | (setq diary-string |
| 1171 | (format | 1187 | (format |
| 1172 | "%%%%(diary-cyclic %s %s) %s%s%s" | 1188 | "%%%%(diary-cyclic %s %s) %s%s%s" |
| 1173 | (* interval 7) | 1189 | (* interval 7) |
| 1174 | (icalendar-datetime-to-european-date | 1190 | (icalendar--datetime-to-european-date |
| 1175 | dtstart) | 1191 | dtstart) |
| 1176 | start-t (if end-t "-" "") (or end-t "")))) | 1192 | start-t (if end-t "-" "") (or end-t "")))) |
| 1177 | (setq event-ok t)))) | 1193 | (setq event-ok t)))) |
| 1178 | ;; yearly | 1194 | ;; yearly |
| 1179 | ((string-equal frequency "YEARLY") | 1195 | ((string-equal frequency "YEARLY") |
| 1180 | (icalendar-dmsg "yearly") | 1196 | (icalendar--dmsg "yearly") |
| 1181 | (setq diary-string | 1197 | (setq diary-string |
| 1182 | (format | 1198 | (format |
| 1183 | "%%%%(diary-anniversary %s)" | 1199 | "%%%%(diary-anniversary %s)" |
| 1184 | (icalendar-datetime-to-european-date dtstart))) | 1200 | (icalendar--datetime-to-european-date dtstart))) |
| 1185 | (setq event-ok t)) | 1201 | (setq event-ok t)) |
| 1186 | ;; FIXME: war auskommentiert: | 1202 | ;; FIXME: war auskommentiert: |
| 1187 | ((and (string-equal frequency "DAILY") | 1203 | ((and (string-equal frequency "DAILY") |
| @@ -1189,34 +1205,34 @@ written into the buffer ` *icalendar-errors*'." | |||
| 1189 | ;;(not start-t) | 1205 | ;;(not start-t) |
| 1190 | ;;(not end-t) | 1206 | ;;(not end-t) |
| 1191 | ) | 1207 | ) |
| 1192 | (let ((ds (icalendar-datetime-to-noneuropean-date | 1208 | (let ((ds (icalendar--datetime-to-noneuropean-date |
| 1193 | (icalendar-decode-isodatetime | 1209 | (icalendar--decode-isodatetime |
| 1194 | (icalendar-get-event-property e | 1210 | (icalendar--get-event-property e |
| 1195 | 'DTSTART)))) | 1211 | 'DTSTART)))) |
| 1196 | (de (icalendar-datetime-to-noneuropean-date | 1212 | (de (icalendar--datetime-to-noneuropean-date |
| 1197 | (icalendar-decode-isodatetime | 1213 | (icalendar--decode-isodatetime |
| 1198 | until)))) | 1214 | until)))) |
| 1199 | (setq diary-string | 1215 | (setq diary-string |
| 1200 | (format | 1216 | (format |
| 1201 | "%%%%(diary-block %d %d %d %d %d %d)" | 1217 | "%%%%(diary-block %d %d %d %d %d %d)" |
| 1202 | (nth 1 ds) (nth 0 ds) (nth 2 ds) | 1218 | (nth 1 ds) (nth 0 ds) (nth 2 ds) |
| 1203 | (nth 1 de) (nth 0 de) (nth 2 de)))) | 1219 | (nth 1 de) (nth 0 de) (nth 2 de)))) |
| 1204 | (setq event-ok t))) | 1220 | (setq event-ok t))) |
| 1205 | )) | 1221 | )) |
| 1206 | (rdate | 1222 | (rdate |
| 1207 | (icalendar-dmsg "rdate event") | 1223 | (icalendar--dmsg "rdate event") |
| 1208 | (setq diary-string "") | 1224 | (setq diary-string "") |
| 1209 | (mapcar (lambda (datestring) | 1225 | (mapcar (lambda (datestring) |
| 1210 | (setq diary-string | 1226 | (setq diary-string |
| 1211 | (concat diary-string | 1227 | (concat diary-string |
| 1212 | (format "......")))) | 1228 | (format "......")))) |
| 1213 | (icalendar-split-value rdate))) | 1229 | (icalendar--split-value rdate))) |
| 1214 | ;; non-recurring event | 1230 | ;; non-recurring event |
| 1215 | ;; long event | 1231 | ;; long event |
| 1216 | ((not (string= start-d end-d)) | 1232 | ((not (string= start-d end-d)) |
| 1217 | (icalendar-dmsg "non-recurring event") | 1233 | (icalendar--dmsg "non-recurring event") |
| 1218 | (let ((ds (icalendar-datetime-to-noneuropean-date dtstart)) | 1234 | (let ((ds (icalendar--datetime-to-noneuropean-date dtstart)) |
| 1219 | (de (icalendar-datetime-to-noneuropean-date dtend))) | 1235 | (de (icalendar--datetime-to-noneuropean-date dtend))) |
| 1220 | (setq diary-string | 1236 | (setq diary-string |
| 1221 | (format "%%%%(diary-block %d %d %d %d %d %d)" | 1237 | (format "%%%%(diary-block %d %d %d %d %d %d)" |
| 1222 | (nth 1 ds) (nth 0 ds) (nth 2 ds) | 1238 | (nth 1 ds) (nth 0 ds) (nth 2 ds) |
| @@ -1225,17 +1241,17 @@ written into the buffer ` *icalendar-errors*'." | |||
| 1225 | ;; not all-day | 1241 | ;; not all-day |
| 1226 | ((and start-t (or (not end-t) | 1242 | ((and start-t (or (not end-t) |
| 1227 | (not (string= start-t end-t)))) | 1243 | (not (string= start-t end-t)))) |
| 1228 | (icalendar-dmsg "not all day event") | 1244 | (icalendar--dmsg "not all day event") |
| 1229 | (cond (end-t | 1245 | (cond (end-t |
| 1230 | (setq diary-string (format "%s %s-%s" start-d | 1246 | (setq diary-string (format "%s %s-%s" start-d |
| 1231 | start-t end-t))) | 1247 | start-t end-t))) |
| 1232 | (t | 1248 | (t |
| 1233 | (setq diary-string (format "%s %s" start-d | 1249 | (setq diary-string (format "%s %s" start-d |
| 1234 | start-t)))) | 1250 | start-t)))) |
| 1235 | (setq event-ok t)) | 1251 | (setq event-ok t)) |
| 1236 | ;; all-day event | 1252 | ;; all-day event |
| 1237 | (t | 1253 | (t |
| 1238 | (icalendar-dmsg "all day event") | 1254 | (icalendar--dmsg "all day event") |
| 1239 | (setq diary-string start-d) | 1255 | (setq diary-string start-d) |
| 1240 | (setq event-ok t))) | 1256 | (setq event-ok t))) |
| 1241 | ;; add all other elements unless the user doesn't want to have | 1257 | ;; add all other elements unless the user doesn't want to have |
| @@ -1243,16 +1259,16 @@ written into the buffer ` *icalendar-errors*'." | |||
| 1243 | (if event-ok | 1259 | (if event-ok |
| 1244 | (progn | 1260 | (progn |
| 1245 | (setq diary-string | 1261 | (setq diary-string |
| 1246 | (concat diary-string " " | 1262 | (concat diary-string " " |
| 1247 | (icalendar-format-ical-event e))) | 1263 | (icalendar--format-ical-event e))) |
| 1248 | (if do-not-ask (setq subject nil)) | 1264 | (if do-not-ask (setq subject nil)) |
| 1249 | (icalendar-add-diary-entry diary-string diary-file | 1265 | (icalendar--add-diary-entry diary-string diary-file |
| 1250 | non-marking subject)) | 1266 | non-marking subject)) |
| 1251 | ;; event was not ok | 1267 | ;; event was not ok |
| 1252 | (setq found-error t) | 1268 | (setq found-error t) |
| 1253 | (setq error-string | 1269 | (setq error-string |
| 1254 | (format "%s\nCannot handle this event:%s" | 1270 | (format "%s\nCannot handle this event:%s" |
| 1255 | error-string e)))) | 1271 | error-string e)))) |
| 1256 | ;; handle errors | 1272 | ;; handle errors |
| 1257 | (error | 1273 | (error |
| 1258 | (message "Ignoring event \"%s\"" e) | 1274 | (message "Ignoring event \"%s\"" e) |
| @@ -1267,17 +1283,17 @@ written into the buffer ` *icalendar-errors*'." | |||
| 1267 | (message "Converting icalendar...done") | 1283 | (message "Converting icalendar...done") |
| 1268 | found-error)) | 1284 | found-error)) |
| 1269 | 1285 | ||
| 1270 | (defun icalendar-add-diary-entry (string diary-file non-marking | 1286 | (defun icalendar--add-diary-entry (string diary-file non-marking |
| 1271 | &optional subject) | 1287 | &optional subject) |
| 1272 | "Add STRING to the diary file DIARY-FILE. | 1288 | "Add STRING to the diary file DIARY-FILE. |
| 1273 | STRING must be a properly formatted valid diary entry. NON-MARKING | 1289 | STRING must be a properly formatted valid diary entry. NON-MARKING |
| 1274 | determines whether diary events are created as non-marking. If | 1290 | determines whether diary events are created as non-marking. If |
| 1275 | SUBJECT is not nil it must be a string that gives the subject of the | 1291 | SUBJECT is not nil it must be a string that gives the subject of the |
| 1276 | entry. In this case the user will be asked whether he wants to insert | 1292 | entry. In this case the user will be asked whether he wants to insert |
| 1277 | the entry." | 1293 | the entry." |
| 1278 | (when (or (not subject) ; | 1294 | (when (or (not subject) ; |
| 1279 | (y-or-n-p (format "Add appointment for `%s' to diary? " | 1295 | (y-or-n-p (format "Add appointment for `%s' to diary? " |
| 1280 | subject))) | 1296 | subject))) |
| 1281 | (when subject | 1297 | (when subject |
| 1282 | (setq non-marking | 1298 | (setq non-marking |
| 1283 | (y-or-n-p (format "Make appointment non-marking? ")))) | 1299 | (y-or-n-p (format "Make appointment non-marking? ")))) |
| @@ -1287,12 +1303,6 @@ the entry." | |||
| 1287 | (read-file-name "Add appointment to this diary file: "))) | 1303 | (read-file-name "Add appointment to this diary file: "))) |
| 1288 | (make-diary-entry string non-marking diary-file)))) | 1304 | (make-diary-entry string non-marking diary-file)))) |
| 1289 | 1305 | ||
| 1290 | ;; ====================================================================== | ||
| 1291 | ;; (add-hook 'list-diary-entries-hook 'include-icalendar-files) | ||
| 1292 | ;; ====================================================================== | ||
| 1293 | (defun include-icalendar-files () | ||
| 1294 | "Not yet implemented.") | ||
| 1295 | |||
| 1296 | (provide 'icalendar) | 1306 | (provide 'icalendar) |
| 1297 | 1307 | ||
| 1298 | ;; arch-tag: 74fdbe8e-0451-4e38-bb61-4416e822f4fc | 1308 | ;; arch-tag: 74fdbe8e-0451-4e38-bb61-4416e822f4fc |
diff --git a/lisp/comint.el b/lisp/comint.el index 8b2c779ecd3..16fd9782116 100644 --- a/lisp/comint.el +++ b/lisp/comint.el | |||
| @@ -369,10 +369,10 @@ Takes one argument, the input. If non-nil, the input may be saved on the input | |||
| 369 | history list. Default is to save anything that isn't all whitespace.") | 369 | history list. Default is to save anything that isn't all whitespace.") |
| 370 | 370 | ||
| 371 | (defvar comint-input-filter-functions '() | 371 | (defvar comint-input-filter-functions '() |
| 372 | "Special hook run before input is sent to the process. | 372 | "Abnormal hook run before input is sent to the process. |
| 373 | These functions get one argument, a string containing the text to send.") | 373 | These functions get one argument, a string containing the text to send.") |
| 374 | 374 | ||
| 375 | (defvar comint-output-filter-functions '(comint-postoutput-scroll-to-bottom) | 375 | (defvar comint-output-filter-functions '(comint-postoutput-scroll-to-bottom comint-watch-for-password-prompt) |
| 376 | "Functions to call after output is inserted into the buffer. | 376 | "Functions to call after output is inserted into the buffer. |
| 377 | One possible function is `comint-postoutput-scroll-to-bottom'. | 377 | One possible function is `comint-postoutput-scroll-to-bottom'. |
| 378 | These functions get one argument, a string containing the text as originally | 378 | These functions get one argument, a string containing the text as originally |
| @@ -788,7 +788,7 @@ buffer. The hook `comint-exec-hook' is run after each exec." | |||
| 788 | 788 | ||
| 789 | (defun comint-insert-input (&optional event) | 789 | (defun comint-insert-input (&optional event) |
| 790 | "In a Comint buffer, set the current input to the previous input at point." | 790 | "In a Comint buffer, set the current input to the previous input at point." |
| 791 | (interactive (list last-input-event)) | 791 | (interactive "@") |
| 792 | (if event (mouse-set-point event)) | 792 | (if event (mouse-set-point event)) |
| 793 | (let ((pos (point))) | 793 | (let ((pos (point))) |
| 794 | (if (not (eq (get-char-property pos 'field) 'input)) | 794 | (if (not (eq (get-char-property pos 'field) 'input)) |
| @@ -1901,65 +1901,7 @@ prompt skip is done by skipping text matching the regular expression | |||
| 1901 | 1901 | ||
| 1902 | ;; These three functions are for entering text you don't want echoed or | 1902 | ;; These three functions are for entering text you don't want echoed or |
| 1903 | ;; saved -- typically passwords to ftp, telnet, or somesuch. | 1903 | ;; saved -- typically passwords to ftp, telnet, or somesuch. |
| 1904 | ;; Just enter m-x send-invisible and type in your line, or add | 1904 | ;; Just enter m-x send-invisible and type in your line. |
| 1905 | ;; `comint-watch-for-password-prompt' to `comint-output-filter-functions'. | ||
| 1906 | |||
| 1907 | (defun comint-read-noecho (prompt &optional stars) | ||
| 1908 | "Read a single line of text from user without echoing, and return it. | ||
| 1909 | Prompt with argument PROMPT, a string. Optional argument STARS causes | ||
| 1910 | input to be echoed with '*' characters on the prompt line. Input ends with | ||
| 1911 | RET, LFD, or ESC. DEL or C-h rubs out. C-u kills line. C-g aborts (if | ||
| 1912 | `inhibit-quit' is set because e.g. this function was called from a process | ||
| 1913 | filter and C-g is pressed, this function returns nil rather than a string). | ||
| 1914 | |||
| 1915 | Note that the keystrokes comprising the text can still be recovered | ||
| 1916 | \(temporarily) with \\[view-lossage]. Some people find this worrisome (see, | ||
| 1917 | however, `clear-this-command-keys'). | ||
| 1918 | Once the caller uses the password, it can erase the password | ||
| 1919 | by doing (clear-string STRING)." | ||
| 1920 | (let ((ans "") | ||
| 1921 | (newans nil) | ||
| 1922 | (c 0) | ||
| 1923 | (echo-keystrokes 0) | ||
| 1924 | (cursor-in-echo-area t) | ||
| 1925 | (message-log-max nil) | ||
| 1926 | (done nil)) | ||
| 1927 | (while (not done) | ||
| 1928 | (if stars | ||
| 1929 | (message "%s%s" prompt (make-string (length ans) ?*)) | ||
| 1930 | (message "%s" prompt)) | ||
| 1931 | ;; Use this instead of `read-char' to avoid "Non-character input-event". | ||
| 1932 | (setq c (read-char-exclusive)) | ||
| 1933 | (cond ((= c ?\C-g) | ||
| 1934 | ;; This function may get called from a process filter, where | ||
| 1935 | ;; inhibit-quit is set. In later versions of emacs read-char | ||
| 1936 | ;; may clear quit-flag itself and return C-g. That would make | ||
| 1937 | ;; it impossible to quit this loop in a simple way, so | ||
| 1938 | ;; re-enable it here (for backward-compatibility the check for | ||
| 1939 | ;; quit-flag below would still be necessary, so this seems | ||
| 1940 | ;; like the simplest way to do things). | ||
| 1941 | (setq quit-flag t | ||
| 1942 | done t)) | ||
| 1943 | ((or (= c ?\r) (= c ?\n) (= c ?\e)) | ||
| 1944 | (setq done t)) | ||
| 1945 | ((= c ?\C-u) | ||
| 1946 | (clear-string ans) | ||
| 1947 | (setq ans "")) | ||
| 1948 | ((and (/= c ?\b) (/= c ?\177)) | ||
| 1949 | (setq newans (concat ans (char-to-string c))) | ||
| 1950 | (clear-string ans) | ||
| 1951 | (setq ans newans)) | ||
| 1952 | ((> (length ans) 0) | ||
| 1953 | (aset ans (1- (length ans)) 0) | ||
| 1954 | (setq ans (substring ans 0 -1))))) | ||
| 1955 | (if quit-flag | ||
| 1956 | ;; Emulate a true quit, except that we have to return a value. | ||
| 1957 | (prog1 | ||
| 1958 | (setq quit-flag nil) | ||
| 1959 | (message "Quit") | ||
| 1960 | (beep t)) | ||
| 1961 | (message "") | ||
| 1962 | ans))) | ||
| 1963 | 1905 | ||
| 1964 | (defun send-invisible (&optional prompt) | 1906 | (defun send-invisible (&optional prompt) |
| 1965 | "Read a string without echoing. | 1907 | "Read a string without echoing. |
| @@ -1970,7 +1912,7 @@ Security bug: your string can still be temporarily recovered with | |||
| 1970 | (interactive "P") ; Defeat snooping via C-x ESC ESC | 1912 | (interactive "P") ; Defeat snooping via C-x ESC ESC |
| 1971 | (let ((proc (get-buffer-process (current-buffer)))) | 1913 | (let ((proc (get-buffer-process (current-buffer)))) |
| 1972 | (if proc | 1914 | (if proc |
| 1973 | (let ((str (comint-read-noecho (or prompt "Non-echoed text: ") t))) | 1915 | (let ((str (read-passwd (or prompt "Non-echoed text: ")))) |
| 1974 | (if (stringp str) | 1916 | (if (stringp str) |
| 1975 | (progn | 1917 | (progn |
| 1976 | (comint-snapshot-last-prompt) | 1918 | (comint-snapshot-last-prompt) |
| @@ -2340,7 +2282,7 @@ preceding newline is removed." | |||
| 2340 | 2282 | ||
| 2341 | (defun comint-kill-whole-line (&optional arg) | 2283 | (defun comint-kill-whole-line (&optional arg) |
| 2342 | "Kill current line, ignoring read-only and field properties. | 2284 | "Kill current line, ignoring read-only and field properties. |
| 2343 | With prefix ARG, kill that many lines starting from the current line. | 2285 | With prefix arg, kill that many lines starting from the current line. |
| 2344 | If arg is negative, kill backward. Also kill the preceding newline, | 2286 | If arg is negative, kill backward. Also kill the preceding newline, |
| 2345 | instead of the trailing one. \(This is meant to make \\[repeat] work well | 2287 | instead of the trailing one. \(This is meant to make \\[repeat] work well |
| 2346 | with negative arguments.) | 2288 | with negative arguments.) |
| @@ -2488,7 +2430,7 @@ Provides a default, if there is one, and returns the result filename. | |||
| 2488 | 2430 | ||
| 2489 | See `comint-source-default' for more on determining defaults. | 2431 | See `comint-source-default' for more on determining defaults. |
| 2490 | 2432 | ||
| 2491 | PROMPT is the prompt string. PREV-DIR/FILE is the (directory . file) pair | 2433 | PROMPT is the prompt string. PREV-DIR/FILE is the (DIRECTORY . FILE) pair |
| 2492 | from the last source processing command. SOURCE-MODES is a list of major | 2434 | from the last source processing command. SOURCE-MODES is a list of major |
| 2493 | modes used to determine what file buffers contain source files. (These | 2435 | modes used to determine what file buffers contain source files. (These |
| 2494 | two arguments are used for determining defaults). If MUSTMATCH-P is true, | 2436 | two arguments are used for determining defaults). If MUSTMATCH-P is true, |
diff --git a/lisp/delsel.el b/lisp/delsel.el index d8e034a5f9f..962fa156a07 100644 --- a/lisp/delsel.el +++ b/lisp/delsel.el | |||
| @@ -147,6 +147,8 @@ then it takes a second \\[keyboard-quit] to abort the minibuffer." | |||
| 147 | (define-key minibuffer-local-must-match-map "\C-g" 'abort-recursive-edit) | 147 | (define-key minibuffer-local-must-match-map "\C-g" 'abort-recursive-edit) |
| 148 | (define-key minibuffer-local-isearch-map "\C-g" 'abort-recursive-edit)) | 148 | (define-key minibuffer-local-isearch-map "\C-g" 'abort-recursive-edit)) |
| 149 | 149 | ||
| 150 | (add-hook 'delsel-unload-hook 'delsel-unload-hook) | ||
| 151 | |||
| 150 | (provide 'delsel) | 152 | (provide 'delsel) |
| 151 | 153 | ||
| 152 | ;;; arch-tag: 1e388890-1b50-4ed0-9347-763b1343b6ed | 154 | ;;; arch-tag: 1e388890-1b50-4ed0-9347-763b1343b6ed |
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 897a5393d8c..846f3efd2ee 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el | |||
| @@ -792,7 +792,8 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." | |||
| 792 | (let ((xs (pop hist-new)) | 792 | (let ((xs (pop hist-new)) |
| 793 | old-autoloads) | 793 | old-autoloads) |
| 794 | ;; Make sure the file was not already loaded before. | 794 | ;; Make sure the file was not already loaded before. |
| 795 | (unless (assoc (car xs) hist-orig) | 795 | (unless (or (assoc (car xs) hist-orig) |
| 796 | (equal (car xs) "cl")) | ||
| 796 | (dolist (s xs) | 797 | (dolist (s xs) |
| 797 | (cond | 798 | (cond |
| 798 | ((symbolp s) | 799 | ((symbolp s) |
| @@ -809,7 +810,18 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." | |||
| 809 | (when (and (symbolp s) (not (memq s old-autoloads))) | 810 | (when (and (symbolp s) (not (memq s old-autoloads))) |
| 810 | (push s byte-compile-noruntime-functions)) | 811 | (push s byte-compile-noruntime-functions)) |
| 811 | (when (and (consp s) (eq t (car s))) | 812 | (when (and (consp s) (eq t (car s))) |
| 812 | (push (cdr s) old-autoloads)))))))))) | 813 | (push (cdr s) old-autoloads))))))) |
| 814 | (when (memq 'cl-functions byte-compile-warnings) | ||
| 815 | (let ((hist-new load-history) | ||
| 816 | (hist-nil-new current-load-list)) | ||
| 817 | ;; Go through load-history, look for newly loaded files | ||
| 818 | ;; and mark all the functions defined therein. | ||
| 819 | (while (and hist-new (not (eq hist-new hist-orig))) | ||
| 820 | (let ((xs (pop hist-new)) | ||
| 821 | old-autoloads) | ||
| 822 | ;; Make sure the file was not already loaded before. | ||
| 823 | (when (and (equal (car xs) "cl") (not (assoc (car xs) hist-orig))) | ||
| 824 | (byte-compile-find-cl-functions))))))))) | ||
| 813 | 825 | ||
| 814 | (defun byte-compile-eval-before-compile (form) | 826 | (defun byte-compile-eval-before-compile (form) |
| 815 | "Evaluate FORM for `eval-and-compile'." | 827 | "Evaluate FORM for `eval-and-compile'." |
| @@ -848,12 +860,13 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." | |||
| 848 | ;; Log something that isn't a warning. | 860 | ;; Log something that isn't a warning. |
| 849 | (defun byte-compile-log-1 (string) | 861 | (defun byte-compile-log-1 (string) |
| 850 | (with-current-buffer "*Compile-Log*" | 862 | (with-current-buffer "*Compile-Log*" |
| 851 | (goto-char (point-max)) | 863 | (let ((inhibit-read-only t)) |
| 852 | (byte-compile-warning-prefix nil nil) | 864 | (goto-char (point-max)) |
| 853 | (cond (noninteractive | 865 | (byte-compile-warning-prefix nil nil) |
| 854 | (message " %s" string)) | 866 | (cond (noninteractive |
| 855 | (t | 867 | (message " %s" string)) |
| 856 | (insert (format "%s\n" string)))))) | 868 | (t |
| 869 | (insert (format "%s\n" string))))))) | ||
| 857 | 870 | ||
| 858 | (defvar byte-compile-read-position nil | 871 | (defvar byte-compile-read-position nil |
| 859 | "Character position we began the last `read' from.") | 872 | "Character position we began the last `read' from.") |
| @@ -904,7 +917,8 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." | |||
| 904 | ;; This is used as warning-prefix for the compiler. | 917 | ;; This is used as warning-prefix for the compiler. |
| 905 | ;; It is always called with the warnings buffer current. | 918 | ;; It is always called with the warnings buffer current. |
| 906 | (defun byte-compile-warning-prefix (level entry) | 919 | (defun byte-compile-warning-prefix (level entry) |
| 907 | (let* ((dir default-directory) | 920 | (let* ((inhibit-read-only t) |
| 921 | (dir default-directory) | ||
| 908 | (file (cond ((stringp byte-compile-current-file) | 922 | (file (cond ((stringp byte-compile-current-file) |
| 909 | (format "%s:" (file-relative-name byte-compile-current-file dir))) | 923 | (format "%s:" (file-relative-name byte-compile-current-file dir))) |
| 910 | ((bufferp byte-compile-current-file) | 924 | ((bufferp byte-compile-current-file) |
| @@ -950,7 +964,8 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." | |||
| 950 | (save-excursion | 964 | (save-excursion |
| 951 | (set-buffer (get-buffer-create "*Compile-Log*")) | 965 | (set-buffer (get-buffer-create "*Compile-Log*")) |
| 952 | (goto-char (point-max)) | 966 | (goto-char (point-max)) |
| 953 | (let* ((dir (and byte-compile-current-file | 967 | (let* ((inhibit-read-only t) |
| 968 | (dir (and byte-compile-current-file | ||
| 954 | (file-name-directory byte-compile-current-file))) | 969 | (file-name-directory byte-compile-current-file))) |
| 955 | (was-same (equal default-directory dir)) | 970 | (was-same (equal default-directory dir)) |
| 956 | pt) | 971 | pt) |
| @@ -984,7 +999,8 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." | |||
| 984 | (defun byte-compile-log-warning (string &optional fill level) | 999 | (defun byte-compile-log-warning (string &optional fill level) |
| 985 | (let ((warning-prefix-function 'byte-compile-warning-prefix) | 1000 | (let ((warning-prefix-function 'byte-compile-warning-prefix) |
| 986 | (warning-type-format "") | 1001 | (warning-type-format "") |
| 987 | (warning-fill-prefix (if fill " "))) | 1002 | (warning-fill-prefix (if fill " ")) |
| 1003 | (inhibit-read-only t)) | ||
| 988 | (display-warning 'bytecomp string level "*Compile-Log*"))) | 1004 | (display-warning 'bytecomp string level "*Compile-Log*"))) |
| 989 | 1005 | ||
| 990 | (defun byte-compile-warn (format &rest args) | 1006 | (defun byte-compile-warn (format &rest args) |
| @@ -2140,17 +2156,15 @@ list that represents a doc string reference. | |||
| 2140 | (setq tail (cdr tail)))) | 2156 | (setq tail (cdr tail)))) |
| 2141 | form) | 2157 | form) |
| 2142 | 2158 | ||
| 2143 | (put 'require 'byte-hunk-handler 'byte-compile-file-form-eval-boundary) | 2159 | (put 'require 'byte-hunk-handler 'byte-compile-file-form-require) |
| 2144 | (defun byte-compile-file-form-eval-boundary (form) | 2160 | (defun byte-compile-file-form-require (form) |
| 2145 | (let ((old-load-list current-load-list)) | 2161 | (let ((old-load-list current-load-list) |
| 2146 | (eval form) | 2162 | (args (mapcar 'eval (cdr form)))) |
| 2147 | ;; (require 'cl) turns off warnings for cl functions. | 2163 | (apply 'require args) |
| 2148 | (let ((tem current-load-list)) | 2164 | ;; Detech (require 'cl) in a way that works even if cl is already loaded. |
| 2149 | (while (not (eq tem old-load-list)) | 2165 | (if (member (car args) '("cl" cl)) |
| 2150 | (when (equal (car tem) '(require . cl)) | 2166 | (setq byte-compile-warnings |
| 2151 | (setq byte-compile-warnings | 2167 | (remq 'cl-functions byte-compile-warnings)))) |
| 2152 | (remq 'cl-functions byte-compile-warnings))) | ||
| 2153 | (setq tem (cdr tem))))) | ||
| 2154 | (byte-compile-keep-pending form 'byte-compile-normal-call)) | 2168 | (byte-compile-keep-pending form 'byte-compile-normal-call)) |
| 2155 | 2169 | ||
| 2156 | (put 'progn 'byte-hunk-handler 'byte-compile-file-form-progn) | 2170 | (put 'progn 'byte-hunk-handler 'byte-compile-file-form-progn) |
diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el index b098a467f9f..2f6c799f528 100644 --- a/lisp/emacs-lisp/cl.el +++ b/lisp/emacs-lisp/cl.el | |||
| @@ -108,8 +108,7 @@ printer proceeds to the next function on the list. | |||
| 108 | This variable is not used at present, but it is defined in hopes that | 108 | This variable is not used at present, but it is defined in hopes that |
| 109 | a future Emacs interpreter will be able to use it.") | 109 | a future Emacs interpreter will be able to use it.") |
| 110 | 110 | ||
| 111 | (defvar cl-unload-hook '(cl-cannot-unload) | 111 | (add-hook 'cl-unload-hook 'cl-cannot-unload) |
| 112 | "Prevent unloading the feature `cl', since it does not work.") | ||
| 113 | (defun cl-cannot-unload () | 112 | (defun cl-cannot-unload () |
| 114 | (error "Cannot unload the feature `cl'")) | 113 | (error "Cannot unload the feature `cl'")) |
| 115 | 114 | ||
diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el index f8d41f200d2..17991067fab 100644 --- a/lisp/emacs-lisp/elp.el +++ b/lisp/emacs-lisp/elp.el | |||
| @@ -626,6 +626,7 @@ displayed." | |||
| 626 | 626 | ||
| 627 | (defun elp-unload-hook () | 627 | (defun elp-unload-hook () |
| 628 | (elp-restore-all)) | 628 | (elp-restore-all)) |
| 629 | (add-hook 'elp-unload-hook 'elp-unload-hook) | ||
| 629 | 630 | ||
| 630 | (provide 'elp) | 631 | (provide 'elp) |
| 631 | 632 | ||
diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index 43d3c9c4e5e..ce30cec6604 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el | |||
| @@ -708,11 +708,7 @@ external command." | |||
| 708 | (eshell-parse-command (concat "*" command) | 708 | (eshell-parse-command (concat "*" command) |
| 709 | (eshell-stringify-list | 709 | (eshell-stringify-list |
| 710 | (eshell-flatten-list args)))) | 710 | (eshell-flatten-list args)))) |
| 711 | (let* ((compilation-process-setup-function | 711 | (let* ((args (mapconcat 'identity |
| 712 | (list 'lambda nil | ||
| 713 | (list 'setq 'process-environment | ||
| 714 | (list 'quote (eshell-copy-environment))))) | ||
| 715 | (args (mapconcat 'identity | ||
| 716 | (mapcar 'shell-quote-argument | 712 | (mapcar 'shell-quote-argument |
| 717 | (eshell-stringify-list | 713 | (eshell-stringify-list |
| 718 | (eshell-flatten-list args))) | 714 | (eshell-flatten-list args))) |
diff --git a/lisp/frame.el b/lisp/frame.el index 8d979cdaff4..76049faddee 100644 --- a/lisp/frame.el +++ b/lisp/frame.el | |||
| @@ -135,7 +135,9 @@ Pass it BUFFER as first arg, and (cdr ARGS) gives the rest of the args." | |||
| 135 | ;; (set-window-dedicated-p window t) | 135 | ;; (set-window-dedicated-p window t) |
| 136 | window)) | 136 | window)) |
| 137 | ;; If no window yet, make one in a new frame. | 137 | ;; If no window yet, make one in a new frame. |
| 138 | (let ((frame (make-frame (append args special-display-frame-alist)))) | 138 | (let ((frame |
| 139 | (with-current-buffer buffer | ||
| 140 | (make-frame (append args special-display-frame-alist))))) | ||
| 139 | (set-window-buffer (frame-selected-window frame) buffer) | 141 | (set-window-buffer (frame-selected-window frame) buffer) |
| 140 | (set-window-dedicated-p (frame-selected-window frame) t) | 142 | (set-window-dedicated-p (frame-selected-window frame) t) |
| 141 | (frame-selected-window frame)))))) | 143 | (frame-selected-window frame)))))) |
diff --git a/lisp/fringe.el b/lisp/fringe.el index 07c93d39f40..f9ddd87931f 100644 --- a/lisp/fringe.el +++ b/lisp/fringe.el | |||
| @@ -43,7 +43,8 @@ | |||
| 43 | 43 | ||
| 44 | (defvar fringe-bitmaps) | 44 | (defvar fringe-bitmaps) |
| 45 | 45 | ||
| 46 | (unless (get 'left-truncation 'fringe) | 46 | (unless (or (not (boundp 'fringe-bitmaps)) |
| 47 | (get 'left-truncation 'fringe)) | ||
| 47 | (let ((bitmaps '(left-truncation right-truncation | 48 | (let ((bitmaps '(left-truncation right-truncation |
| 48 | up-arrow down-arrow | 49 | up-arrow down-arrow |
| 49 | continued-line continuation-line | 50 | continued-line continuation-line |
| @@ -112,6 +113,25 @@ See `fringe-mode' for possible values and their effect." | |||
| 112 | fringe-mode)))) | 113 | fringe-mode)))) |
| 113 | (setq frames (cdr frames))))) | 114 | (setq frames (cdr frames))))) |
| 114 | 115 | ||
| 116 | ;; For initialization of fringe-mode, take account of changes | ||
| 117 | ;; made explicitly to default-frame-alist. | ||
| 118 | (defun fringe-mode-initialize (symbol value) | ||
| 119 | (let* ((left-pair (assq 'left-fringe default-frame-alist)) | ||
| 120 | (right-pair (assq 'right-fringe default-frame-alist)) | ||
| 121 | (left (cdr left-pair)) | ||
| 122 | (right (cdr right-pair))) | ||
| 123 | (if (or left-pair right-pair) | ||
| 124 | ;; If there's something in default-frame-alist for fringes, | ||
| 125 | ;; don't change it, but reflect that into the value of fringe-mode. | ||
| 126 | (progn | ||
| 127 | (setq fringe-mode (cons left right)) | ||
| 128 | (if (equal fringe-mode '(nil . nil)) | ||
| 129 | (setq fringe-mode nil)) | ||
| 130 | (if (equal fringe-mode '(0 . 0)) | ||
| 131 | (setq fringe-mode 0))) | ||
| 132 | ;; Otherwise impose the user-specified value of fringe-mode. | ||
| 133 | (custom-initialize-reset symbol value)))) | ||
| 134 | |||
| 115 | ;;;###autoload | 135 | ;;;###autoload |
| 116 | (defcustom fringe-mode nil | 136 | (defcustom fringe-mode nil |
| 117 | "*Specify appearance of fringes on all frames. | 137 | "*Specify appearance of fringes on all frames. |
| @@ -138,6 +158,7 @@ you can use the interactive function `toggle-fringe'" | |||
| 138 | (integer :tag "Right width"))) | 158 | (integer :tag "Right width"))) |
| 139 | :group 'frames | 159 | :group 'frames |
| 140 | :require 'fringe | 160 | :require 'fringe |
| 161 | :initialize 'fringe-mode-initialize | ||
| 141 | :set 'set-fringe-mode-1) | 162 | :set 'set-fringe-mode-1) |
| 142 | 163 | ||
| 143 | (defun fringe-query-style (&optional all-frames) | 164 | (defun fringe-query-style (&optional all-frames) |
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 292d36ce9e1..2a4b0a80398 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog | |||
| @@ -1,3 +1,365 @@ | |||
| 1 | 2004-10-21 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 2 | |||
| 3 | * mm-view.el (mm-display-inline-fontify): Inhibit font-lock when | ||
| 4 | running the major-mode function. | ||
| 5 | |||
| 6 | 2004-10-21 Kevin Greiner <kevin.greiner@compsol.cc> | ||
| 7 | |||
| 8 | * gnus-start.el (gnus-convert-old-newsrc): Two of the converters | ||
| 9 | have been backported to 'Gnus v5.11' from 'No Gnus v0.2'. Added a | ||
| 10 | boolean check to not apply converters that apply to future | ||
| 11 | versions of gnus. | ||
| 12 | |||
| 13 | 2004-10-19 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 14 | |||
| 15 | * gnus-sum.el (gnus-update-summary-mark-positions): Search for | ||
| 16 | dummy marks in the right way. | ||
| 17 | |||
| 18 | 2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> | ||
| 19 | |||
| 20 | * nnagent.el (nnagent-request-type): Bind gnus-agent to nil to | ||
| 21 | avoid infinite recursion via gnus-get-function. | ||
| 22 | |||
| 23 | 2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> | ||
| 24 | |||
| 25 | * gnus-agent.el (gnus-agent-synchronize-group-flags): When | ||
| 26 | necessary, pass full group name to gnus-request-set-marks. | ||
| 27 | (gnus-agent-synchronize-group-flags): Added support for sync'ing | ||
| 28 | tick marks. | ||
| 29 | (gnus-agent-synchronize-flags-server): Be silent when writing file. | ||
| 30 | |||
| 31 | 2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> | ||
| 32 | |||
| 33 | * gnus-agent.el (gnus-agent-synchronize-group-flags): Replaced | ||
| 34 | gnus-request-update-info with explicit code to sync the in-memory | ||
| 35 | info read flags with the marks being sync'd to the backend. | ||
| 36 | |||
| 37 | 2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> | ||
| 38 | |||
| 39 | * gnus-agent.el (gnus-agent-possibly-synchronize-flags): Ignore | ||
| 40 | servers that are offline. Avoids having gnus-agent-toggle-plugged | ||
| 41 | first ask if you want to open a server and then, even when you | ||
| 42 | responded with no, asking if you want to synchronize the server's | ||
| 43 | flags. | ||
| 44 | (gnus-agent-synchronize-flags-server): Rewrote read loop to handle | ||
| 45 | multi-line expressions. | ||
| 46 | (gnus-agent-synchronize-group-flags): New internal function. | ||
| 47 | Updates marks in memory (in the info structure) AND in the | ||
| 48 | backend. | ||
| 49 | (gnus-agent-check-overview-buffer): Fixed range of | ||
| 50 | deletion to remove entire duplicate line. Fixes merged article | ||
| 51 | number bug. | ||
| 52 | |||
| 53 | * gnus-util.el (gnus-remassoc): Fixed typo in documentation. | ||
| 54 | |||
| 55 | * nnagent.el (nnagent-request-set-mark): Use | ||
| 56 | gnus-agent-synchronize-group-flags, not backend's request-set-mark | ||
| 57 | method, to ensure that synchronization updates marks in the | ||
| 58 | backend and in the info (in memory) structure. | ||
| 59 | |||
| 60 | 2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> | ||
| 61 | |||
| 62 | * gnus-agent.el (gnus-agent-synchronize-flags-server): Do nothing | ||
| 63 | unless plugged. Disable the agent so that an open failure causes | ||
| 64 | an error. | ||
| 65 | |||
| 66 | 2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Reiner Steib <Reiner.Steib@gmx.de> | ||
| 67 | * gnus-agent.el (gnus-agent-fetched-hook): Add :version. | ||
| 68 | (gnus-agent-go-online): Change :version. | ||
| 69 | (gnus-agent-expire-unagentized-dirs) | ||
| 70 | (gnus-agent-auto-agentize-methods): Add :version. | ||
| 71 | |||
| 72 | 2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> | ||
| 73 | |||
| 74 | * legacy-gnus-agent.el (gnus-agent-convert-to-compressed-agentview-prompt): | ||
| 75 | New function. Used internally to only display 'gnus converting | ||
| 76 | files' message when actually necessary. | ||
| 77 | |||
| 78 | * gnus-sum.el (): Removed (require 'gnus-agent) as required | ||
| 79 | methods now autoloaded. | ||
| 80 | |||
| 81 | * gnus-int.el (gnus-request-move-article): Use | ||
| 82 | gnus-agent-unfetch-articles in place of gnus-agent-expire to | ||
| 83 | improve performance. | ||
| 84 | |||
| 85 | 2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> | ||
| 86 | |||
| 87 | * gnus-agent.el (gnus-agent-cat-groups): rewrote avoiding defsetf | ||
| 88 | to avoid run-time CL dependencies. | ||
| 89 | (gnus-agent-unfetch-articles): New function. | ||
| 90 | (gnus-agent-fetch-headers): Use gnus-agent-braid-nov to validate | ||
| 91 | article numbers even when local .overview file is missing. | ||
| 92 | (gnus-agent-read-article-number): New function. Only accepts | ||
| 93 | 27-bit article numbers. | ||
| 94 | (gnus-agent-copy-nov-line, gnus-agent-uncached-articles): Use | ||
| 95 | gnus-agent-read-article-number. | ||
| 96 | (gnus-agent-braid-nov): Rewrote to validate article numbers coming | ||
| 97 | from backend while recognizing that article numbers in .overview | ||
| 98 | must be valid. | ||
| 99 | |||
| 100 | * gnus-start.el (gnus-convert-old-newsrc): Changed message text as | ||
| 101 | some users confused by references to .newsrc when they only have a | ||
| 102 | .newsrc.eld file. | ||
| 103 | (gnus-convert-mark-converter-prompt, | ||
| 104 | gnus-convert-converter-needs-prompt): Fixed use of property list. | ||
| 105 | |||
| 106 | 2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 107 | |||
| 108 | * gnus-agent.el (gnus-agent-restore-gcc): Use ^ and regexp-quote. | ||
| 109 | |||
| 110 | 2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 111 | |||
| 112 | * gnus-start.el (gnus-get-unread-articles-in-group): Don't do | ||
| 113 | stuff for non-living groups. | ||
| 114 | |||
| 115 | 2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 116 | |||
| 117 | * gnus-agent.el (gnus-agent-synchronize-flags): Default to nil. | ||
| 118 | (gnus-agent-regenerate-group): Using nil messages aren't valid. | ||
| 119 | |||
| 120 | 2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 121 | |||
| 122 | * gnus-agent.el (gnus-agent-read-agentview): Inline | ||
| 123 | gnus-uncompress-range. | ||
| 124 | |||
| 125 | 2004-10-18 Kevin Greiner <kgreiner@xpediantsolutions.com> | ||
| 126 | |||
| 127 | * legacy-gnus-agent.el | ||
| 128 | (gnus-agent-convert-to-compressed-agentview): Fixed typos with | ||
| 129 | help from Florian Weimer <fw@deneb.enyo.de> | ||
| 130 | |||
| 131 | * gnus-agent.el (gnus-agentize): | ||
| 132 | gnus-agent-send-mail-real-function no longer set to current value | ||
| 133 | of message-send-mail-function but rather a lambda that calls | ||
| 134 | message-send-mail-function. The change makes the agent real-time | ||
| 135 | responsive to user changes to message-send-mail-function. | ||
| 136 | |||
| 137 | 2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Reiner Steib <Reiner.Steib@gmx.de> | ||
| 138 | |||
| 139 | * gnus-start.el (gnus-get-unread-articles): Fix last commit. | ||
| 140 | |||
| 141 | 2004-10-18 Kevin Greiner <kgreiner@xpediantsolutions.com> | ||
| 142 | |||
| 143 | * gnus-cache.el (gnus-cache-rename-group): New function. | ||
| 144 | (gnus-cache-delete-group): New function. | ||
| 145 | |||
| 146 | * gnus-agent.el (gnus-agent-rename-group): New function. | ||
| 147 | (gnus-agent-delete-group): New function. | ||
| 148 | (gnus-agent-save-group-info): Use gnus-command-method when | ||
| 149 | `method' parameter is nil. Don't write nil entries into the | ||
| 150 | active file. | ||
| 151 | (gnus-agent-get-group-info): New function. | ||
| 152 | (gnus-agent-get-local): Added optional parameters to avoid calling | ||
| 153 | gnus-group-real-name and gnus-find-method-for-group. | ||
| 154 | (gnus-agent-set-local): Delete stored entry if either min, or max, | ||
| 155 | are nil. | ||
| 156 | (gnus-agent-fetch-session): Reworded error/quit messages. On | ||
| 157 | quit, use gnus-agent-regenerate-group to record existance of any | ||
| 158 | articles fetched to disk before the quit occurred. | ||
| 159 | |||
| 160 | * gnus-int.el (gnus-request-delete-group): Use | ||
| 161 | gnus-cache-delete-group and gnus-agent-delete-group to keep the | ||
| 162 | local disk in sync with the server. | ||
| 163 | (gnus-request-rename-group): Use | ||
| 164 | gnus-cache-rename-group and gnus-agent-rename-group to keep the | ||
| 165 | local disk in sync with the server. | ||
| 166 | |||
| 167 | * gnus-start.el (gnus-get-unread-articles): Cosmetic | ||
| 168 | simplification to logic. | ||
| 169 | |||
| 170 | * gnus-group.el (): (gnus-group-delete-group): No longer update | ||
| 171 | gnus-cache-active-altered as gnus-request-delete-group now keeps | ||
| 172 | the cache in sync. | ||
| 173 | (gnus-group-list-active): Let the agent store a server's active | ||
| 174 | list if currently plugged. | ||
| 175 | |||
| 176 | * gnus-util.el (gnus-rename-file): New function. | ||
| 177 | |||
| 178 | 2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 179 | |||
| 180 | * gnus-agent.el (gnus-agent-regenerate-group): Activate the group | ||
| 181 | when the group's active is not available. | ||
| 182 | |||
| 183 | 2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 184 | |||
| 185 | * gnus-agent.el (gnus-agent-read-agentview): Add a missing arg to | ||
| 186 | error. | ||
| 187 | |||
| 188 | 2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> | ||
| 189 | |||
| 190 | * gnus-start.el (gnus-convert-old-newsrc): Only write the | ||
| 191 | conversion message to newsrc-dribble when an actual conversion is | ||
| 192 | performed. | ||
| 193 | |||
| 194 | 2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> | ||
| 195 | |||
| 196 | * gnus-agent.el (gnus-agent-read-local): Bind | ||
| 197 | nnheader-file-coding-system to gnus-agent-file-coding-system to | ||
| 198 | avoid the implicit assumption that they will always be equal. | ||
| 199 | (gnus-agent-save-local): Bind buffer-file-coding-system, not | ||
| 200 | coding-system-for-write, as the with-temp-file macro first prints | ||
| 201 | to a buffer then saves the buffer. | ||
| 202 | |||
| 203 | 2004-10-18 Kevin Greiner <kgreiner@xpediantsolutions.com> | ||
| 204 | |||
| 205 | * legacy-gnus-agent.el (): New. Provides converters that are only | ||
| 206 | loaded when gnus-convert-old-newsrc needs to call them. | ||
| 207 | |||
| 208 | * gnus-agent.el (gnus-agent-read-agentview): Removed support for | ||
| 209 | old file versions. | ||
| 210 | (gnus-group-prepare-hook): Removed function that converted list | ||
| 211 | form of gnus-agent-expire-days to group properties. | ||
| 212 | |||
| 213 | * gnus-start.el (gnus-convert-old-newsrc): Registered new | ||
| 214 | converters to handle old agent file formats. Added logic for a | ||
| 215 | "backup before upgrading warning". | ||
| 216 | (gnus-convert-mark-converter-prompt): Developers can mark | ||
| 217 | functions as needing (default), or not needing, | ||
| 218 | gnus-convert-old-newsrc's "backup before upgrading warning". | ||
| 219 | (gnus-convert-converter-needs-prompt): Tests whether the user | ||
| 220 | should be protected from potentially irreversable changes by the | ||
| 221 | function. | ||
| 222 | |||
| 223 | 2004-10-18 Kevin Greiner <kgreiner@xpediantsolutions.com> | ||
| 224 | |||
| 225 | * gnus-int.el (gnus-request-accept-article): Inform the agent that | ||
| 226 | articles are being added to a group. | ||
| 227 | (gnus-request-replace-article): Inform the agent that articles | ||
| 228 | need to be uncached as the cached contents are no longer valid. | ||
| 229 | |||
| 230 | * gnus-agent.el (gnus-agent-file-header-cache): Removed. | ||
| 231 | (gnus-agent-possibly-alter-active): Avoid null in numeric | ||
| 232 | comparison. | ||
| 233 | (gnus-agent-set-local): Refuse to save null in local object table. | ||
| 234 | (gnus-agent-regenerate-group): The REREAD parameter can now be a | ||
| 235 | list of articles that will be marked as unread. | ||
| 236 | |||
| 237 | 2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> | ||
| 238 | |||
| 239 | * gnus-range.el (gnus-sorted-range-intersection): Now accepts | ||
| 240 | single-interval range of the form (min . max). Previously the | ||
| 241 | range had to look like ((min . max)). Likewise, return | ||
| 242 | (min . max) rather than ((min . max)). | ||
| 243 | (gnus-range-map): Use gnus-range-normalize to accept | ||
| 244 | single-interval range. | ||
| 245 | |||
| 246 | * gnus-sum.el (gnus-summary-highlight-line): Articles stored in | ||
| 247 | the cache, but not the agent, now appear with their usual face. | ||
| 248 | |||
| 249 | 2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> | ||
| 250 | |||
| 251 | * gnus-sum.el (gnus-adjust-marks): Now correctly handles a list of | ||
| 252 | marks consisting of a single range {for example, (3 . 5)} rather | ||
| 253 | than a list of a single range { ((3 . 5)) }. | ||
| 254 | |||
| 255 | 2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> | ||
| 256 | |||
| 257 | * gnus-sum.el (gnus-adjust-marks): Avoid splicing null INTO the | ||
| 258 | uncompressed list. | ||
| 259 | |||
| 260 | 2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> | ||
| 261 | |||
| 262 | * gnus-draft.el (gnus-group-send-queue): Pass the group name | ||
| 263 | "nndraft:queue" along to gnus-draft-send. Use | ||
| 264 | gnus-agent-prompt-send-queue. | ||
| 265 | (gnus-draft-send): Rebind gnus-agent-queue-mail to nil when group | ||
| 266 | is "nndraft:queue". Suggested by Gaute Strokkenes | ||
| 267 | <gs234@srcf.ucam.org> | ||
| 268 | |||
| 269 | * gnus-group.el (gnus-group-catchup): Use new | ||
| 270 | gnus-sequence-of-unread-articles, not | ||
| 271 | gnus-list-of-unread-articles, to avoid exhausting memory with huge | ||
| 272 | numbers of articles. Use gnus-range-map to avoid having to | ||
| 273 | uncompress the unread list. | ||
| 274 | (gnus-group-archive-directory, | ||
| 275 | gnus-group-recent-archive-directory): Fixed invalid ange-ftp | ||
| 276 | reference. | ||
| 277 | |||
| 278 | * gnus-range.el (gnus-range-map): Iterate over list or sequence. | ||
| 279 | (gnus-sorted-range-intersection): Intersection of two ranges | ||
| 280 | without requiring that they first be uncompressed. | ||
| 281 | |||
| 282 | * gnus-start.el (gnus-activate-group): Unless blocked by the | ||
| 283 | caller, possibly expand the active range to include both cached | ||
| 284 | and agentized articles. | ||
| 285 | (gnus-convert-old-newsrc): Rewrote in anticipation of having | ||
| 286 | multiple version-dependent converters. | ||
| 287 | (gnus-groups-to-gnus-format): Replaced gnus-agent-save-groups with | ||
| 288 | gnus-agent-save-active. | ||
| 289 | (gnus-save-newsrc-file): Save dirty agent range limits. | ||
| 290 | |||
| 291 | * gnus-sum.el (gnus-select-newgroup): Replaced inline code with | ||
| 292 | gnus-agent-possibly-alter-active. | ||
| 293 | (gnus-adjust-marked-articles): Faster handling of simple lists | ||
| 294 | |||
| 295 | 2004-10-18 David Edmondson <dme@dme.org> | ||
| 296 | |||
| 297 | * mm-view.el (mm-w3m-cid-retrieve-1): Don't use recursive call | ||
| 298 | excessively. | ||
| 299 | |||
| 300 | 2004-10-18 Reiner Steib <Reiner.Steib@gmx.de> | ||
| 301 | |||
| 302 | * mml.el (mml-preview): Use `pop-to-buffer'. | ||
| 303 | |||
| 304 | * message.el (message-goto-mail-followup-to): Insert after "To". | ||
| 305 | (message-carefully-insert-headers): Add comment. | ||
| 306 | |||
| 307 | * gnus-sum.el (gnus-summary-make-menu-bar): Add help texts. | ||
| 308 | |||
| 309 | * gnus-art.el (gnus-button-alist): Improve | ||
| 310 | `gnus-button-handle-library' entry. | ||
| 311 | |||
| 312 | * gnus-art.el (gnus-button-alist): Fixed regexp for manual links. | ||
| 313 | |||
| 314 | * gnus-group.el (gnus-group-get-new-news-this-group): Added | ||
| 315 | doc-string. | ||
| 316 | |||
| 317 | * gnus-start.el (gnus-activate-group): Added doc-string. | ||
| 318 | |||
| 319 | * gnus-art.el (gnus-button-handle-man, gnus-button-alist): Try to | ||
| 320 | handle manual section. | ||
| 321 | |||
| 322 | * imap.el (imap-store-password): New variable. | ||
| 323 | (imap-interactive-login): Use it. | ||
| 324 | Suggested by Mark Plaksin <happy@mcplaksin.org>. | ||
| 325 | |||
| 326 | * gnus-art.el (gnus-button-alist, gnus-header-button-alist): Allow | ||
| 327 | / in mailto URLs. | ||
| 328 | |||
| 329 | * spam.el (spam-directory): Derive from `gnus-directory'. | ||
| 330 | |||
| 331 | * gnus-sum.el (gnus-pick-line-number): Add autoload. | ||
| 332 | |||
| 333 | 2004-10-17 Richard M. Stallman <rms@gnu.org> | ||
| 334 | |||
| 335 | * gnus-registry.el (gnus-registry-unload-hook): | ||
| 336 | Set as a variable with add-hook. | ||
| 337 | |||
| 338 | * nnspool.el (nnspool-spool-directory): Use news-directory instead | ||
| 339 | of news-path. | ||
| 340 | |||
| 341 | * spam-stat.el (spam-stat-unload-hook): Set as a variable w/ add-hook. | ||
| 342 | |||
| 343 | * spam.el: Delete duplicate `provide'. | ||
| 344 | (spam-unload-hook): Set as a variable with add-hook. | ||
| 345 | |||
| 346 | 2004-10-15 Reiner Steib <Reiner.Steib@gmx.de> | ||
| 347 | |||
| 348 | * pop3.el (pop3-leave-mail-on-server): Describe possible problems | ||
| 349 | in the doc string. | ||
| 350 | |||
| 351 | * message.el (message-ignored-news-headers) | ||
| 352 | (message-ignored-supersedes-headers) | ||
| 353 | (message-ignored-resent-headers) | ||
| 354 | (message-forward-ignored-headers): Improve custom type. | ||
| 355 | |||
| 356 | 2004-10-15 Simon Josefsson <jas@extundo.com> | ||
| 357 | |||
| 358 | * pop3.el (top-level): Don't require nnheader. | ||
| 359 | (pop3-read-timeout): Add. | ||
| 360 | (pop3-accept-process-output): Add. | ||
| 361 | (pop3-read-response, pop3-retr): Use it. | ||
| 362 | |||
| 1 | 2004-10-13 Katsumi Yamaoka <yamaoka@jpl.org> | 363 | 2004-10-13 Katsumi Yamaoka <yamaoka@jpl.org> |
| 2 | 364 | ||
| 3 | * message.el (message-tokenize-header): Fix 2004-09-06 change | 365 | * message.el (message-tokenize-header): Fix 2004-09-06 change |
| @@ -9,6 +371,10 @@ | |||
| 9 | (tls-certificate-information): New function, based on | 371 | (tls-certificate-information): New function, based on |
| 10 | ssl-certificate-information. | 372 | ssl-certificate-information. |
| 11 | 373 | ||
| 374 | 2004-10-11 Reiner Steib <Reiner.Steib@gmx.de> | ||
| 375 | |||
| 376 | * message.el (message-bury): Use `window-dedicated-p'. | ||
| 377 | |||
| 12 | 2004-10-10 Reiner Steib <Reiner.Steib@gmx.de> | 378 | 2004-10-10 Reiner Steib <Reiner.Steib@gmx.de> |
| 13 | 379 | ||
| 14 | * gnus-sum.el: Mention that multibyte characters don't work as marks. | 380 | * gnus-sum.el: Mention that multibyte characters don't work as marks. |
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 4596c783d32..c62460946ab 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el | |||
| @@ -114,7 +114,7 @@ If nil, only read articles will be expired." | |||
| 114 | :group 'gnus-agent | 114 | :group 'gnus-agent |
| 115 | :type 'function) | 115 | :type 'function) |
| 116 | 116 | ||
| 117 | (defcustom gnus-agent-synchronize-flags 'ask | 117 | (defcustom gnus-agent-synchronize-flags nil |
| 118 | "Indicate if flags are synchronized when you plug in. | 118 | "Indicate if flags are synchronized when you plug in. |
| 119 | If this is `ask' the hook will query the user." | 119 | If this is `ask' the hook will query the user." |
| 120 | :version "21.1" | 120 | :version "21.1" |
| @@ -362,9 +362,23 @@ manipulated as follows: | |||
| 362 | (gnus-agent-cat-defaccessor | 362 | (gnus-agent-cat-defaccessor |
| 363 | gnus-agent-cat-enable-undownloaded-faces agent-enable-undownloaded-faces) | 363 | gnus-agent-cat-enable-undownloaded-faces agent-enable-undownloaded-faces) |
| 364 | 364 | ||
| 365 | |||
| 366 | ;; This form is equivalent to defsetf except that it calls make-symbol | ||
| 367 | ;; whereas defsetf calls gensym (Using gensym creates a run-time | ||
| 368 | ;; dependency on the CL library). | ||
| 369 | |||
| 365 | (eval-and-compile | 370 | (eval-and-compile |
| 366 | (defsetf gnus-agent-cat-groups (category) (groups) | 371 | (define-setf-method gnus-agent-cat-groups (category) |
| 367 | (list 'gnus-agent-set-cat-groups category groups))) | 372 | (let* ((--category--temp-- (make-symbol "--category--")) |
| 373 | (--groups--temp-- (make-symbol "--groups--"))) | ||
| 374 | (list (list --category--temp--) | ||
| 375 | (list category) | ||
| 376 | (list --groups--temp--) | ||
| 377 | (let* ((category --category--temp--) | ||
| 378 | (groups --groups--temp--)) | ||
| 379 | (list (quote gnus-agent-set-cat-groups) category groups)) | ||
| 380 | (list (quote gnus-agent-cat-groups) --category--temp--)))) | ||
| 381 | ) | ||
| 368 | 382 | ||
| 369 | (defun gnus-agent-set-cat-groups (category groups) | 383 | (defun gnus-agent-set-cat-groups (category groups) |
| 370 | (unless (eq groups 'ignore) | 384 | (unless (eq groups 'ignore) |
| @@ -624,7 +638,7 @@ minor mode in all Gnus buffers." | |||
| 624 | (unless gnus-agent-send-mail-function | 638 | (unless gnus-agent-send-mail-function |
| 625 | (setq gnus-agent-send-mail-function | 639 | (setq gnus-agent-send-mail-function |
| 626 | (or message-send-mail-real-function | 640 | (or message-send-mail-real-function |
| 627 | message-send-mail-function) | 641 | (function (lambda () (funcall message-send-mail-function)))) |
| 628 | message-send-mail-real-function 'gnus-agent-send-mail)) | 642 | message-send-mail-real-function 'gnus-agent-send-mail)) |
| 629 | 643 | ||
| 630 | ;; If the servers file doesn't exist, auto-agentize some servers and | 644 | ;; If the servers file doesn't exist, auto-agentize some servers and |
| @@ -790,25 +804,39 @@ be a select method." | |||
| 790 | (interactive) | 804 | (interactive) |
| 791 | (save-excursion | 805 | (save-excursion |
| 792 | (dolist (gnus-command-method (gnus-agent-covered-methods)) | 806 | (dolist (gnus-command-method (gnus-agent-covered-methods)) |
| 793 | (when (file-exists-p (gnus-agent-lib-file "flags")) | 807 | (when (and (file-exists-p (gnus-agent-lib-file "flags")) |
| 808 | (not (eq (gnus-server-status gnus-command-method) 'offline))) | ||
| 794 | (gnus-agent-possibly-synchronize-flags-server gnus-command-method))))) | 809 | (gnus-agent-possibly-synchronize-flags-server gnus-command-method))))) |
| 795 | 810 | ||
| 796 | (defun gnus-agent-synchronize-flags-server (method) | 811 | (defun gnus-agent-synchronize-flags-server (method) |
| 797 | "Synchronize flags set when unplugged for server." | 812 | "Synchronize flags set when unplugged for server." |
| 798 | (let ((gnus-command-method method)) | 813 | (let ((gnus-command-method method) |
| 814 | (gnus-agent nil)) | ||
| 799 | (when (file-exists-p (gnus-agent-lib-file "flags")) | 815 | (when (file-exists-p (gnus-agent-lib-file "flags")) |
| 800 | (set-buffer (get-buffer-create " *Gnus Agent flag synchronize*")) | 816 | (set-buffer (get-buffer-create " *Gnus Agent flag synchronize*")) |
| 801 | (erase-buffer) | 817 | (erase-buffer) |
| 802 | (nnheader-insert-file-contents (gnus-agent-lib-file "flags")) | 818 | (nnheader-insert-file-contents (gnus-agent-lib-file "flags")) |
| 803 | (if (null (gnus-check-server gnus-command-method)) | 819 | (cond ((null gnus-plugged) |
| 804 | (gnus-message 1 "Couldn't open server %s" (nth 1 gnus-command-method)) | 820 | (gnus-message |
| 805 | (while (not (eobp)) | 821 | 1 "You must be plugged to synchronize flags with server %s" |
| 806 | (if (null (eval (read (current-buffer)))) | 822 | (nth 1 gnus-command-method))) |
| 807 | (gnus-delete-line) | 823 | ((null (gnus-check-server gnus-command-method)) |
| 808 | (write-file (gnus-agent-lib-file "flags")) | 824 | (gnus-message |
| 809 | (error "Couldn't set flags from file %s" | 825 | 1 "Couldn't open server %s" (nth 1 gnus-command-method))) |
| 810 | (gnus-agent-lib-file "flags")))) | 826 | (t |
| 811 | (delete-file (gnus-agent-lib-file "flags"))) | 827 | (condition-case err |
| 828 | (while t | ||
| 829 | (let ((bgn (point))) | ||
| 830 | (eval (read (current-buffer))) | ||
| 831 | (delete-region bgn (point)))) | ||
| 832 | (end-of-file | ||
| 833 | (delete-file (gnus-agent-lib-file "flags"))) | ||
| 834 | (error | ||
| 835 | (let ((file (gnus-agent-lib-file "flags"))) | ||
| 836 | (write-region (point-min) (point-max) | ||
| 837 | (gnus-agent-lib-file "flags") nil 'silent) | ||
| 838 | (error "Couldn't set flags from file %s due to %s" | ||
| 839 | file (error-message-string err))))))) | ||
| 812 | (kill-buffer nil)))) | 840 | (kill-buffer nil)))) |
| 813 | 841 | ||
| 814 | (defun gnus-agent-possibly-synchronize-flags-server (method) | 842 | (defun gnus-agent-possibly-synchronize-flags-server (method) |
| @@ -820,6 +848,56 @@ be a select method." | |||
| 820 | (cadr method))))) | 848 | (cadr method))))) |
| 821 | (gnus-agent-synchronize-flags-server method))) | 849 | (gnus-agent-synchronize-flags-server method))) |
| 822 | 850 | ||
| 851 | ;;;###autoload | ||
| 852 | (defun gnus-agent-rename-group (old-group new-group) | ||
| 853 | "Rename fully-qualified OLD-GROUP as NEW-GROUP. Always updates the agent, even when | ||
| 854 | disabled, as the old agent files would corrupt gnus when the agent was | ||
| 855 | next enabled. Depends upon the caller to determine whether group renaming is supported." | ||
| 856 | (let* ((old-command-method (gnus-find-method-for-group old-group)) | ||
| 857 | (old-path (directory-file-name | ||
| 858 | (let (gnus-command-method old-command-method) | ||
| 859 | (gnus-agent-group-pathname old-group)))) | ||
| 860 | (new-command-method (gnus-find-method-for-group new-group)) | ||
| 861 | (new-path (directory-file-name | ||
| 862 | (let (gnus-command-method new-command-method) | ||
| 863 | (gnus-agent-group-pathname new-group))))) | ||
| 864 | (gnus-rename-file old-path new-path t) | ||
| 865 | |||
| 866 | (let* ((old-real-group (gnus-group-real-name old-group)) | ||
| 867 | (new-real-group (gnus-group-real-name new-group)) | ||
| 868 | (old-active (gnus-agent-get-group-info old-command-method old-real-group))) | ||
| 869 | (gnus-agent-save-group-info old-command-method old-real-group nil) | ||
| 870 | (gnus-agent-save-group-info new-command-method new-real-group old-active) | ||
| 871 | |||
| 872 | (let ((old-local (gnus-agent-get-local old-group | ||
| 873 | old-real-group old-command-method))) | ||
| 874 | (gnus-agent-set-local old-group | ||
| 875 | nil nil | ||
| 876 | old-real-group old-command-method) | ||
| 877 | (gnus-agent-set-local new-group | ||
| 878 | (car old-local) (cdr old-local) | ||
| 879 | new-real-group new-command-method))))) | ||
| 880 | |||
| 881 | ;;;###autoload | ||
| 882 | (defun gnus-agent-delete-group (group) | ||
| 883 | "Delete fully-qualified GROUP. Always updates the agent, even when | ||
| 884 | disabled, as the old agent files would corrupt gnus when the agent was | ||
| 885 | next enabled. Depends upon the caller to determine whether group deletion is supported." | ||
| 886 | (let* ((command-method (gnus-find-method-for-group group)) | ||
| 887 | (path (directory-file-name | ||
| 888 | (let (gnus-command-method command-method) | ||
| 889 | (gnus-agent-group-pathname group))))) | ||
| 890 | (gnus-delete-file path) | ||
| 891 | |||
| 892 | (let* ((real-group (gnus-group-real-name group))) | ||
| 893 | (gnus-agent-save-group-info command-method real-group nil) | ||
| 894 | |||
| 895 | (let ((local (gnus-agent-get-local group | ||
| 896 | real-group command-method))) | ||
| 897 | (gnus-agent-set-local group | ||
| 898 | nil nil | ||
| 899 | real-group command-method))))) | ||
| 900 | |||
| 823 | ;;; | 901 | ;;; |
| 824 | ;;; Server mode commands | 902 | ;;; Server mode commands |
| 825 | ;;; | 903 | ;;; |
| @@ -969,6 +1047,7 @@ article's mark is toggled." | |||
| 969 | gnus-downloadable-mark) | 1047 | gnus-downloadable-mark) |
| 970 | 'unread)))) | 1048 | 'unread)))) |
| 971 | 1049 | ||
| 1050 | ;;;###autoload | ||
| 972 | (defun gnus-agent-get-undownloaded-list () | 1051 | (defun gnus-agent-get-undownloaded-list () |
| 973 | "Construct list of articles that have not been downloaded." | 1052 | "Construct list of articles that have not been downloaded." |
| 974 | (let ((gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name))) | 1053 | (let ((gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name))) |
| @@ -1113,6 +1192,49 @@ This can be added to `gnus-select-article-hook' or | |||
| 1113 | ;;; Internal functions | 1192 | ;;; Internal functions |
| 1114 | ;;; | 1193 | ;;; |
| 1115 | 1194 | ||
| 1195 | (defun gnus-agent-synchronize-group-flags (group actions server) | ||
| 1196 | "Update a plugged group by performing the indicated actions." | ||
| 1197 | (let* ((gnus-command-method (gnus-server-to-method server)) | ||
| 1198 | (info | ||
| 1199 | ;; This initializer is required as gnus-request-set-mark | ||
| 1200 | ;; calls gnus-group-real-name to strip off the host name | ||
| 1201 | ;; before calling the backend. Now that the backend is | ||
| 1202 | ;; trying to call gnus-request-set-mark, I have to | ||
| 1203 | ;; reconstruct the original group name. | ||
| 1204 | (or (gnus-get-info group) | ||
| 1205 | (gnus-get-info | ||
| 1206 | (setq group (gnus-group-full-name | ||
| 1207 | group gnus-command-method)))))) | ||
| 1208 | (gnus-request-set-mark group actions) | ||
| 1209 | |||
| 1210 | (when info | ||
| 1211 | (dolist (action actions) | ||
| 1212 | (let ((range (nth 0 action)) | ||
| 1213 | (what (nth 1 action)) | ||
| 1214 | (marks (nth 2 action))) | ||
| 1215 | (dolist (mark marks) | ||
| 1216 | (cond ((eq mark 'read) | ||
| 1217 | (gnus-info-set-read | ||
| 1218 | info | ||
| 1219 | (funcall (if (eq what 'add) | ||
| 1220 | 'gnus-range-add | ||
| 1221 | 'gnus-remove-from-range) | ||
| 1222 | (gnus-info-read info) | ||
| 1223 | range)) | ||
| 1224 | (gnus-get-unread-articles-in-group | ||
| 1225 | info | ||
| 1226 | (gnus-active (gnus-info-group info)))) | ||
| 1227 | ((memq mark '(tick)) | ||
| 1228 | (let ((info-marks (assoc mark (gnus-info-marks info)))) | ||
| 1229 | (unless info-marks | ||
| 1230 | (gnus-info-set-marks info (cons (setq info-marks (list mark)) (gnus-info-marks info)))) | ||
| 1231 | (setcdr info-marks (funcall (if (eq what 'add) | ||
| 1232 | 'gnus-range-add | ||
| 1233 | 'gnus-remove-from-range) | ||
| 1234 | (cdr info-marks) | ||
| 1235 | range))))))))) | ||
| 1236 | nil)) | ||
| 1237 | |||
| 1116 | (defun gnus-agent-save-active (method) | 1238 | (defun gnus-agent-save-active (method) |
| 1117 | (when (gnus-agent-method-p method) | 1239 | (when (gnus-agent-method-p method) |
| 1118 | (let* ((gnus-command-method method) | 1240 | (let* ((gnus-command-method method) |
| @@ -1131,6 +1253,7 @@ This can be added to `gnus-select-article-hook' or | |||
| 1131 | ;; will add it while reading the file. | 1253 | ;; will add it while reading the file. |
| 1132 | (gnus-write-active-file file new nil))) | 1254 | (gnus-write-active-file file new nil))) |
| 1133 | 1255 | ||
| 1256 | ;;;###autoload | ||
| 1134 | (defun gnus-agent-possibly-alter-active (group active &optional info) | 1257 | (defun gnus-agent-possibly-alter-active (group active &optional info) |
| 1135 | "Possibly expand a group's active range to include articles | 1258 | "Possibly expand a group's active range to include articles |
| 1136 | downloaded into the agent." | 1259 | downloaded into the agent." |
| @@ -1183,7 +1306,7 @@ downloaded into the agent." | |||
| 1183 | (defun gnus-agent-save-group-info (method group active) | 1306 | (defun gnus-agent-save-group-info (method group active) |
| 1184 | "Update a single group's active range in the agent's copy of the server's active file." | 1307 | "Update a single group's active range in the agent's copy of the server's active file." |
| 1185 | (when (gnus-agent-method-p method) | 1308 | (when (gnus-agent-method-p method) |
| 1186 | (let* ((gnus-command-method method) | 1309 | (let* ((gnus-command-method (or method gnus-command-method)) |
| 1187 | (coding-system-for-write nnheader-file-coding-system) | 1310 | (coding-system-for-write nnheader-file-coding-system) |
| 1188 | (file-name-coding-system nnmail-pathname-coding-system) | 1311 | (file-name-coding-system nnmail-pathname-coding-system) |
| 1189 | (file (gnus-agent-lib-file "active")) | 1312 | (file (gnus-agent-lib-file "active")) |
| @@ -1199,15 +1322,39 @@ downloaded into the agent." | |||
| 1199 | (when (re-search-forward | 1322 | (when (re-search-forward |
| 1200 | (concat "^" (regexp-quote group) " ") nil t) | 1323 | (concat "^" (regexp-quote group) " ") nil t) |
| 1201 | (save-excursion | 1324 | (save-excursion |
| 1202 | (setq oactive-max (read (current-buffer)) ;; max | 1325 | (setq oactive-max (read (current-buffer)) ;; max |
| 1203 | oactive-min (read (current-buffer)))) ;; min | 1326 | oactive-min (read (current-buffer)))) ;; min |
| 1204 | (gnus-delete-line))) | 1327 | (gnus-delete-line))) |
| 1205 | (insert (format "%S %d %d y\n" (intern group) | 1328 | (when active |
| 1206 | (max (or oactive-max (cdr active)) (cdr active)) | 1329 | (insert (format "%S %d %d y\n" (intern group) |
| 1207 | (min (or oactive-min (car active)) (car active)))) | 1330 | (max (or oactive-max (cdr active)) (cdr active)) |
| 1208 | (goto-char (point-max)) | 1331 | (min (or oactive-min (car active)) (car active)))) |
| 1209 | (while (search-backward "\\." nil t) | 1332 | (goto-char (point-max)) |
| 1210 | (delete-char 1)))))) | 1333 | (while (search-backward "\\." nil t) |
| 1334 | (delete-char 1))))))) | ||
| 1335 | |||
| 1336 | (defun gnus-agent-get-group-info (method group) | ||
| 1337 | "Get a single group's active range in the agent's copy of the server's active file." | ||
| 1338 | (when (gnus-agent-method-p method) | ||
| 1339 | (let* ((gnus-command-method (or method gnus-command-method)) | ||
| 1340 | (coding-system-for-write nnheader-file-coding-system) | ||
| 1341 | (file-name-coding-system nnmail-pathname-coding-system) | ||
| 1342 | (file (gnus-agent-lib-file "active")) | ||
| 1343 | oactive-min oactive-max) | ||
| 1344 | (gnus-make-directory (file-name-directory file)) | ||
| 1345 | (with-temp-buffer | ||
| 1346 | ;; Emacs got problem to match non-ASCII group in multibyte buffer. | ||
| 1347 | (mm-disable-multibyte) | ||
| 1348 | (when (file-exists-p file) | ||
| 1349 | (nnheader-insert-file-contents file) | ||
| 1350 | |||
| 1351 | (goto-char (point-min)) | ||
| 1352 | (when (re-search-forward | ||
| 1353 | (concat "^" (regexp-quote group) " ") nil t) | ||
| 1354 | (save-excursion | ||
| 1355 | (setq oactive-max (read (current-buffer)) ;; max | ||
| 1356 | oactive-min (read (current-buffer))) ;; min | ||
| 1357 | (cons oactive-min oactive-max)))))))) | ||
| 1211 | 1358 | ||
| 1212 | (defun gnus-agent-group-path (group) | 1359 | (defun gnus-agent-group-path (group) |
| 1213 | "Translate GROUP into a file name." | 1360 | "Translate GROUP into a file name." |
| @@ -1413,6 +1560,31 @@ downloaded into the agent." | |||
| 1413 | (gnus-message 7 "")) | 1560 | (gnus-message 7 "")) |
| 1414 | (cdr fetched-articles)))))) | 1561 | (cdr fetched-articles)))))) |
| 1415 | 1562 | ||
| 1563 | (defun gnus-agent-unfetch-articles (group articles) | ||
| 1564 | "Delete ARTICLES that were fetched from GROUP into the agent." | ||
| 1565 | (when articles | ||
| 1566 | (gnus-agent-load-alist group) | ||
| 1567 | (let* ((alist (cons nil gnus-agent-article-alist)) | ||
| 1568 | (articles (sort articles #'<)) | ||
| 1569 | (next-possibility alist) | ||
| 1570 | (delete-this (pop articles))) | ||
| 1571 | (while (and (cdr next-possibility) delete-this) | ||
| 1572 | (let ((have-this (caar (cdr next-possibility)))) | ||
| 1573 | (cond ((< delete-this have-this) | ||
| 1574 | (setq delete-this (pop articles))) | ||
| 1575 | ((= delete-this have-this) | ||
| 1576 | (let ((timestamp (cdar (cdr next-possibility)))) | ||
| 1577 | (when timestamp | ||
| 1578 | (let* ((file-name (concat (gnus-agent-group-pathname group) | ||
| 1579 | (number-to-string have-this)))) | ||
| 1580 | (delete-file file-name)))) | ||
| 1581 | |||
| 1582 | (setcdr next-possibility (cddr next-possibility))) | ||
| 1583 | (t | ||
| 1584 | (setq next-possibility (cdr next-possibility)))))) | ||
| 1585 | (setq gnus-agent-article-alist (cdr alist)) | ||
| 1586 | (gnus-agent-save-alist group)))) | ||
| 1587 | |||
| 1416 | (defun gnus-agent-crosspost (crosses article &optional date) | 1588 | (defun gnus-agent-crosspost (crosses article &optional date) |
| 1417 | (setq date (or date t)) | 1589 | (setq date (or date t)) |
| 1418 | 1590 | ||
| @@ -1487,7 +1659,7 @@ and that there are no duplicates." | |||
| 1487 | (setq backed-up (gnus-agent-backup-overview-buffer))) | 1659 | (setq backed-up (gnus-agent-backup-overview-buffer))) |
| 1488 | (gnus-message 1 | 1660 | (gnus-message 1 |
| 1489 | "Duplicate overview line for %d" cur) | 1661 | "Duplicate overview line for %d" cur) |
| 1490 | (delete-region (point) (progn (forward-line 1) (point)))) | 1662 | (delete-region p (progn (forward-line 1) (point)))) |
| 1491 | ((< cur prev-num) | 1663 | ((< cur prev-num) |
| 1492 | (or backed-up | 1664 | (or backed-up |
| 1493 | (setq backed-up (gnus-agent-backup-overview-buffer))) | 1665 | (setq backed-up (gnus-agent-backup-overview-buffer))) |
| @@ -1519,6 +1691,7 @@ and that there are no duplicates." | |||
| 1519 | (insert "\n")) | 1691 | (insert "\n")) |
| 1520 | (setq gnus-agent-group-alist (cdr gnus-agent-group-alist))))) | 1692 | (setq gnus-agent-group-alist (cdr gnus-agent-group-alist))))) |
| 1521 | 1693 | ||
| 1694 | ;;;###autoload | ||
| 1522 | (defun gnus-agent-find-parameter (group symbol) | 1695 | (defun gnus-agent-find-parameter (group symbol) |
| 1523 | "Search for GROUPs SYMBOL in the group's parameters, the group's | 1696 | "Search for GROUPs SYMBOL in the group's parameters, the group's |
| 1524 | topic parameters, the group's category, or the customizable | 1697 | topic parameters, the group's category, or the customizable |
| @@ -1623,8 +1796,10 @@ article numbers will be returned." | |||
| 1623 | ;; of FILE. | 1796 | ;; of FILE. |
| 1624 | (copy-to-buffer | 1797 | (copy-to-buffer |
| 1625 | gnus-agent-overview-buffer (point-min) (point-max)) | 1798 | gnus-agent-overview-buffer (point-min) (point-max)) |
| 1626 | (when (file-exists-p file) | 1799 | ;; NOTE: Call g-a-brand-nov even when the file does not |
| 1627 | (gnus-agent-braid-nov group articles file)) | 1800 | ;; exist. As a minimum, it will validate the article |
| 1801 | ;; numbers already in the buffer. | ||
| 1802 | (gnus-agent-braid-nov group articles file) | ||
| 1628 | (let ((coding-system-for-write | 1803 | (let ((coding-system-for-write |
| 1629 | gnus-agent-file-coding-system)) | 1804 | gnus-agent-file-coding-system)) |
| 1630 | (gnus-agent-check-overview-buffer) | 1805 | (gnus-agent-check-overview-buffer) |
| @@ -1636,11 +1811,32 @@ article numbers will be returned." | |||
| 1636 | (nnheader-insert-file-contents file))))) | 1811 | (nnheader-insert-file-contents file))))) |
| 1637 | articles)) | 1812 | articles)) |
| 1638 | 1813 | ||
| 1814 | (defsubst gnus-agent-read-article-number () | ||
| 1815 | "Reads the article number at point. Returns nil when a valid article number can not be read." | ||
| 1816 | |||
| 1817 | ;; It is unfortunite but the read function quietly overflows | ||
| 1818 | ;; integer. As a result, I have to use string operations to test | ||
| 1819 | ;; for overflow BEFORE calling read. | ||
| 1820 | (when (looking-at "[0-9]+\t") | ||
| 1821 | (let ((len (- (match-end 0) (match-beginning 0)))) | ||
| 1822 | (cond ((< len 9) | ||
| 1823 | (read (current-buffer))) | ||
| 1824 | ((= len 9) | ||
| 1825 | ;; Many 9 digit base-10 numbers can be represented in a 27-bit int | ||
| 1826 | ;; Back convert from int to string to ensure that this is one of them. | ||
| 1827 | (let* ((str1 (buffer-substring (match-beginning 0) (1- (match-end 0)))) | ||
| 1828 | (num (read (current-buffer))) | ||
| 1829 | (str2 (int-to-string num))) | ||
| 1830 | (when (equal str1 str2) | ||
| 1831 | num))))))) | ||
| 1832 | |||
| 1639 | (defsubst gnus-agent-copy-nov-line (article) | 1833 | (defsubst gnus-agent-copy-nov-line (article) |
| 1834 | "Copy the indicated ARTICLE from the overview buffer to the nntp server buffer." | ||
| 1640 | (let (art b e) | 1835 | (let (art b e) |
| 1641 | (set-buffer gnus-agent-overview-buffer) | 1836 | (set-buffer gnus-agent-overview-buffer) |
| 1642 | (while (and (not (eobp)) | 1837 | (while (and (not (eobp)) |
| 1643 | (< (setq art (read (current-buffer))) article)) | 1838 | (or (not (setq art (gnus-agent-read-article-number))) |
| 1839 | (< art article))) | ||
| 1644 | (forward-line 1)) | 1840 | (forward-line 1)) |
| 1645 | (beginning-of-line) | 1841 | (beginning-of-line) |
| 1646 | (if (or (eobp) | 1842 | (if (or (eobp) |
| @@ -1653,64 +1849,77 @@ article numbers will be returned." | |||
| 1653 | 1849 | ||
| 1654 | (defun gnus-agent-braid-nov (group articles file) | 1850 | (defun gnus-agent-braid-nov (group articles file) |
| 1655 | "Merge agent overview data with given file. | 1851 | "Merge agent overview data with given file. |
| 1656 | Takes headers for ARTICLES from `gnus-agent-overview-buffer' and the given | 1852 | Takes unvalidated headers for ARTICLES from |
| 1657 | FILE and places the combined headers into `nntp-server-buffer'." | 1853 | `gnus-agent-overview-buffer' and validated headers from the given |
| 1854 | FILE and places the combined valid headers into | ||
| 1855 | `nntp-server-buffer'. This function can be used, when file | ||
| 1856 | doesn't exist, to valid the overview buffer." | ||
| 1658 | (let (start last) | 1857 | (let (start last) |
| 1659 | (set-buffer gnus-agent-overview-buffer) | 1858 | (set-buffer gnus-agent-overview-buffer) |
| 1660 | (goto-char (point-min)) | 1859 | (goto-char (point-min)) |
| 1661 | (set-buffer nntp-server-buffer) | 1860 | (set-buffer nntp-server-buffer) |
| 1662 | (erase-buffer) | 1861 | (erase-buffer) |
| 1663 | (nnheader-insert-file-contents file) | 1862 | (when (file-exists-p file) |
| 1863 | (nnheader-insert-file-contents file)) | ||
| 1664 | (goto-char (point-max)) | 1864 | (goto-char (point-max)) |
| 1665 | (forward-line -1) | 1865 | (forward-line -1) |
| 1666 | (unless (looking-at "[0-9]+\t") | 1866 | |
| 1667 | ;; Remove corrupted lines | ||
| 1668 | (gnus-message | ||
| 1669 | 1 "Overview %s is corrupted. Removing corrupted lines..." file) | ||
| 1670 | (goto-char (point-min)) | ||
| 1671 | (while (not (eobp)) | ||
| 1672 | (if (looking-at "[0-9]+\t") | ||
| 1673 | (forward-line 1) | ||
| 1674 | (delete-region (point) (progn (forward-line 1) (point))))) | ||
| 1675 | (forward-line -1)) | ||
| 1676 | (unless (or (= (point-min) (point-max)) | 1867 | (unless (or (= (point-min) (point-max)) |
| 1677 | (< (setq last (read (current-buffer))) (car articles))) | 1868 | (< (setq last (read (current-buffer))) (car articles))) |
| 1678 | ;; We do it the hard way. | 1869 | ;; Old and new overlap -- We do it the hard way. |
| 1679 | (when (nnheader-find-nov-line (car articles)) | 1870 | (when (nnheader-find-nov-line (car articles)) |
| 1680 | ;; Replacing existing NOV entry | 1871 | ;; Replacing existing NOV entry |
| 1681 | (delete-region (point) (progn (forward-line 1) (point)))) | 1872 | (delete-region (point) (progn (forward-line 1) (point)))) |
| 1682 | (gnus-agent-copy-nov-line (pop articles)) | 1873 | (gnus-agent-copy-nov-line (pop articles)) |
| 1683 | 1874 | ||
| 1684 | (ignore-errors | 1875 | (ignore-errors |
| 1685 | (while articles | 1876 | (while articles |
| 1686 | (while (let ((art (read (current-buffer)))) | 1877 | (while (let ((art (read (current-buffer)))) |
| 1687 | (cond ((< art (car articles)) | 1878 | (cond ((< art (car articles)) |
| 1688 | (forward-line 1) | 1879 | (forward-line 1) |
| 1689 | t) | 1880 | t) |
| 1690 | ((= art (car articles)) | 1881 | ((= art (car articles)) |
| 1691 | (beginning-of-line) | 1882 | (beginning-of-line) |
| 1692 | (delete-region | 1883 | (delete-region |
| 1693 | (point) (progn (forward-line 1) (point))) | 1884 | (point) (progn (forward-line 1) (point))) |
| 1694 | nil) | 1885 | nil) |
| 1695 | (t | 1886 | (t |
| 1696 | (beginning-of-line) | 1887 | (beginning-of-line) |
| 1697 | nil)))) | 1888 | nil)))) |
| 1698 | 1889 | ||
| 1699 | (gnus-agent-copy-nov-line (pop articles))))) | 1890 | (gnus-agent-copy-nov-line (pop articles))))) |
| 1700 | 1891 | ||
| 1701 | ;; Copy the rest lines | ||
| 1702 | (set-buffer nntp-server-buffer) | ||
| 1703 | (goto-char (point-max)) | 1892 | (goto-char (point-max)) |
| 1893 | |||
| 1894 | ;; Append the remaining lines | ||
| 1704 | (when articles | 1895 | (when articles |
| 1705 | (when last | 1896 | (when last |
| 1706 | (set-buffer gnus-agent-overview-buffer) | 1897 | (set-buffer gnus-agent-overview-buffer) |
| 1707 | (ignore-errors | ||
| 1708 | (while (<= (read (current-buffer)) last) | ||
| 1709 | (forward-line 1))) | ||
| 1710 | (beginning-of-line) | ||
| 1711 | (setq start (point)) | 1898 | (setq start (point)) |
| 1712 | (set-buffer nntp-server-buffer)) | 1899 | (set-buffer nntp-server-buffer)) |
| 1713 | (insert-buffer-substring gnus-agent-overview-buffer start)))) | 1900 | |
| 1901 | (let ((p (point))) | ||
| 1902 | (insert-buffer-substring gnus-agent-overview-buffer start) | ||
| 1903 | (goto-char p)) | ||
| 1904 | |||
| 1905 | (setq last (or last -134217728)) | ||
| 1906 | (let (sort art) | ||
| 1907 | (while (not (eobp)) | ||
| 1908 | (setq art (gnus-agent-read-article-number)) | ||
| 1909 | (cond ((not art) | ||
| 1910 | ;; Bad art num - delete this line | ||
| 1911 | (beginning-of-line) | ||
| 1912 | (delete-region (point) (progn (forward-line 1) (point)))) | ||
| 1913 | ((< art last) | ||
| 1914 | ;; Art num out of order - enable sort | ||
| 1915 | (setq sort t) | ||
| 1916 | (forward-line 1)) | ||
| 1917 | (t | ||
| 1918 | ;; Good art num | ||
| 1919 | (setq last art) | ||
| 1920 | (forward-line 1)))) | ||
| 1921 | (when sort | ||
| 1922 | (sort-numeric-fields 1 (point-min) (point-max))))))) | ||
| 1714 | 1923 | ||
| 1715 | ;; Keeps the compiler from warning about the free variable in | 1924 | ;; Keeps the compiler from warning about the free variable in |
| 1716 | ;; gnus-agent-read-agentview. | 1925 | ;; gnus-agent-read-agentview. |
| @@ -1735,7 +1944,8 @@ FILE and places the combined headers into `nntp-server-buffer'." | |||
| 1735 | (defun gnus-agent-read-agentview (file) | 1944 | (defun gnus-agent-read-agentview (file) |
| 1736 | "Load FILE and do a `read' there." | 1945 | "Load FILE and do a `read' there." |
| 1737 | (with-temp-buffer | 1946 | (with-temp-buffer |
| 1738 | (ignore-errors | 1947 | (condition-case nil |
| 1948 | (progn | ||
| 1739 | (nnheader-insert-file-contents file) | 1949 | (nnheader-insert-file-contents file) |
| 1740 | (goto-char (point-min)) | 1950 | (goto-char (point-min)) |
| 1741 | (let ((alist (read (current-buffer))) | 1951 | (let ((alist (read (current-buffer))) |
| @@ -1744,6 +1954,8 @@ FILE and places the combined headers into `nntp-server-buffer'." | |||
| 1744 | changed-version) | 1954 | changed-version) |
| 1745 | 1955 | ||
| 1746 | (cond | 1956 | (cond |
| 1957 | ((< version 2) | ||
| 1958 | (error "gnus-agent-read-agentview no longer supports version %d. Stop gnus, manually evaluate gnus-agent-convert-to-compressed-agentview, then restart gnus." version)) | ||
| 1747 | ((= version 0) | 1959 | ((= version 0) |
| 1748 | (let ((inhibit-quit t) | 1960 | (let ((inhibit-quit t) |
| 1749 | entry) | 1961 | entry) |
| @@ -1767,8 +1979,9 @@ FILE and places the combined headers into `nntp-server-buffer'." | |||
| 1767 | (mapcar | 1979 | (mapcar |
| 1768 | (lambda (comp-list) | 1980 | (lambda (comp-list) |
| 1769 | (let ((state (car comp-list)) | 1981 | (let ((state (car comp-list)) |
| 1770 | (sequence (gnus-uncompress-sequence | 1982 | (sequence (inline |
| 1771 | (cdr comp-list)))) | 1983 | (gnus-uncompress-range |
| 1984 | (cdr comp-list))))) | ||
| 1772 | (mapcar (lambda (article-id) | 1985 | (mapcar (lambda (article-id) |
| 1773 | (setq uncomp (cons (cons article-id state) uncomp))) | 1986 | (setq uncomp (cons (cons article-id state) uncomp))) |
| 1774 | sequence))) | 1987 | sequence))) |
| @@ -1777,7 +1990,8 @@ FILE and places the combined headers into `nntp-server-buffer'." | |||
| 1777 | (when changed-version | 1990 | (when changed-version |
| 1778 | (let ((gnus-agent-article-alist alist)) | 1991 | (let ((gnus-agent-article-alist alist)) |
| 1779 | (gnus-agent-save-alist gnus-agent-read-agentview))) | 1992 | (gnus-agent-save-alist gnus-agent-read-agentview))) |
| 1780 | alist)))) | 1993 | alist)) |
| 1994 | (file-error nil)))) | ||
| 1781 | 1995 | ||
| 1782 | (defun gnus-agent-save-alist (group &optional articles state) | 1996 | (defun gnus-agent-save-alist (group &optional articles state) |
| 1783 | "Save the article-state alist for GROUP." | 1997 | "Save the article-state alist for GROUP." |
| @@ -1860,7 +2074,8 @@ modified) original contents, they are first saved to their own file." | |||
| 1860 | (line 1)) | 2074 | (line 1)) |
| 1861 | (with-temp-buffer | 2075 | (with-temp-buffer |
| 1862 | (condition-case nil | 2076 | (condition-case nil |
| 1863 | (nnheader-insert-file-contents file) | 2077 | (let ((nnheader-file-coding-system gnus-agent-file-coding-system)) |
| 2078 | (nnheader-insert-file-contents file)) | ||
| 1864 | (file-error)) | 2079 | (file-error)) |
| 1865 | 2080 | ||
| 1866 | (goto-char (point-min)) | 2081 | (goto-char (point-min)) |
| @@ -1903,31 +2118,31 @@ modified) original contents, they are first saved to their own file." | |||
| 1903 | ;; NOTE: gnus-command-method is used within gnus-agent-lib-file. | 2118 | ;; NOTE: gnus-command-method is used within gnus-agent-lib-file. |
| 1904 | (dest (gnus-agent-lib-file "local"))) | 2119 | (dest (gnus-agent-lib-file "local"))) |
| 1905 | (gnus-make-directory (gnus-agent-lib-file "")) | 2120 | (gnus-make-directory (gnus-agent-lib-file "")) |
| 1906 | (with-temp-file dest | 2121 | |
| 1907 | (let ((gnus-command-method (symbol-value (intern "+method" my-obarray))) | 2122 | (let ((buffer-file-coding-system gnus-agent-file-coding-system)) |
| 1908 | (file-name-coding-system nnmail-pathname-coding-system) | 2123 | (with-temp-file dest |
| 1909 | (coding-system-for-write | 2124 | (let ((gnus-command-method (symbol-value (intern "+method" my-obarray))) |
| 1910 | gnus-agent-file-coding-system) | 2125 | (file-name-coding-system nnmail-pathname-coding-system) |
| 1911 | print-level print-length item article | 2126 | print-level print-length item article |
| 1912 | (standard-output (current-buffer))) | 2127 | (standard-output (current-buffer))) |
| 1913 | (mapatoms (lambda (symbol) | 2128 | (mapatoms (lambda (symbol) |
| 1914 | (cond ((not (boundp symbol)) | 2129 | (cond ((not (boundp symbol)) |
| 1915 | nil) | 2130 | nil) |
| 1916 | ((member (symbol-name symbol) '("+dirty" "+method")) | 2131 | ((member (symbol-name symbol) '("+dirty" "+method")) |
| 1917 | nil) | 2132 | nil) |
| 1918 | (t | 2133 | (t |
| 1919 | (prin1 symbol) | 2134 | (prin1 symbol) |
| 1920 | (let ((range (symbol-value symbol))) | 2135 | (let ((range (symbol-value symbol))) |
| 1921 | (princ " ") | 2136 | (princ " ") |
| 1922 | (princ (car range)) | 2137 | (princ (car range)) |
| 1923 | (princ " ") | 2138 | (princ " ") |
| 1924 | (princ (cdr range)) | 2139 | (princ (cdr range)) |
| 1925 | (princ "\n"))))) | 2140 | (princ "\n"))))) |
| 1926 | my-obarray))))))) | 2141 | my-obarray)))))))) |
| 1927 | 2142 | ||
| 1928 | (defun gnus-agent-get-local (group) | 2143 | (defun gnus-agent-get-local (group &optional gmane method) |
| 1929 | (let* ((gmane (gnus-group-real-name group)) | 2144 | (let* ((gmane (or gmane (gnus-group-real-name group))) |
| 1930 | (gnus-command-method (gnus-find-method-for-group group)) | 2145 | (gnus-command-method (or method (gnus-find-method-for-group group))) |
| 1931 | (local (gnus-agent-load-local)) | 2146 | (local (gnus-agent-load-local)) |
| 1932 | (symb (intern gmane local)) | 2147 | (symb (intern gmane local)) |
| 1933 | (minmax (and (boundp symb) (symbol-value symb)))) | 2148 | (minmax (and (boundp symb) (symbol-value symb)))) |
| @@ -1962,7 +2177,9 @@ modified) original contents, they are first saved to their own file." | |||
| 1962 | nil) | 2177 | nil) |
| 1963 | ((and min max) | 2178 | ((and min max) |
| 1964 | (set symb (cons min max)) | 2179 | (set symb (cons min max)) |
| 1965 | t)) | 2180 | t) |
| 2181 | (t | ||
| 2182 | (unintern symb local))) | ||
| 1966 | (set (intern "+dirty" local) t)))) | 2183 | (set (intern "+dirty" local) t)))) |
| 1967 | 2184 | ||
| 1968 | (defun gnus-agent-article-name (article group) | 2185 | (defun gnus-agent-article-name (article group) |
| @@ -2012,13 +2229,14 @@ modified) original contents, they are first saved to their own file." | |||
| 2012 | group gnus-command-method) | 2229 | group gnus-command-method) |
| 2013 | (error | 2230 | (error |
| 2014 | (unless (funcall gnus-agent-confirmation-function | 2231 | (unless (funcall gnus-agent-confirmation-function |
| 2015 | (format "Error %s. Continue? " | 2232 | (format "Error %s while fetching session. Should gnus continue? " |
| 2016 | (error-message-string err))) | 2233 | (error-message-string err))) |
| 2017 | (error "Cannot fetch articles into the Gnus agent"))) | 2234 | (error "Cannot fetch articles into the Gnus agent"))) |
| 2018 | (quit | 2235 | (quit |
| 2236 | (gnus-agent-regenerate-group group) | ||
| 2019 | (unless (funcall gnus-agent-confirmation-function | 2237 | (unless (funcall gnus-agent-confirmation-function |
| 2020 | (format | 2238 | (format |
| 2021 | "Quit fetching session %s. Continue? " | 2239 | "%s while fetching session. Should gnus continue? " |
| 2022 | (error-message-string err))) | 2240 | (error-message-string err))) |
| 2023 | (signal 'quit | 2241 | (signal 'quit |
| 2024 | "Cannot fetch articles into the Gnus agent"))))))))) | 2242 | "Cannot fetch articles into the Gnus agent"))))))))) |
| @@ -2736,328 +2954,334 @@ FORCE is equivalent to setting the expiration predicates to true." | |||
| 2736 | (let ((dir (gnus-agent-group-pathname group))) | 2954 | (let ((dir (gnus-agent-group-pathname group))) |
| 2737 | (when (boundp 'gnus-agent-expire-current-dirs) | 2955 | (when (boundp 'gnus-agent-expire-current-dirs) |
| 2738 | (set 'gnus-agent-expire-current-dirs | 2956 | (set 'gnus-agent-expire-current-dirs |
| 2739 | (cons dir | 2957 | (cons dir |
| 2740 | (symbol-value 'gnus-agent-expire-current-dirs)))) | 2958 | (symbol-value 'gnus-agent-expire-current-dirs)))) |
| 2741 | 2959 | ||
| 2742 | (if (and (not force) | 2960 | (if (and (not force) |
| 2743 | (eq 'DISABLE (gnus-agent-find-parameter group | 2961 | (eq 'DISABLE (gnus-agent-find-parameter group |
| 2744 | 'agent-enable-expiration))) | 2962 | 'agent-enable-expiration))) |
| 2745 | (gnus-message 5 "Expiry skipping over %s" group) | 2963 | (gnus-message 5 "Expiry skipping over %s" group) |
| 2746 | (gnus-message 5 "Expiring articles in %s" group) | 2964 | (gnus-message 5 "Expiring articles in %s" group) |
| 2747 | (gnus-agent-load-alist group) | 2965 | (gnus-agent-load-alist group) |
| 2748 | (let* ((stats (if (boundp 'gnus-agent-expire-stats) | 2966 | (let* ((bytes-freed 0) |
| 2749 | ;; Use the list provided by my caller | 2967 | (files-deleted 0) |
| 2750 | (symbol-value 'gnus-agent-expire-stats) | 2968 | (nov-entries-deleted 0) |
| 2751 | ;; otherwise use my own temporary list | 2969 | (info (gnus-get-info group)) |
| 2752 | (list 0 0 0.0))) | 2970 | (alist gnus-agent-article-alist) |
| 2753 | (info (gnus-get-info group)) | 2971 | (day (- (time-to-days (current-time)) |
| 2754 | (alist gnus-agent-article-alist) | 2972 | (gnus-agent-find-parameter group 'agent-days-until-old))) |
| 2755 | (day (- (time-to-days (current-time)) | 2973 | (specials (if (and alist |
| 2756 | (gnus-agent-find-parameter group 'agent-days-until-old))) | 2974 | (not force)) |
| 2757 | (specials (if (and alist | 2975 | ;; This could be a bit of a problem. I need to |
| 2758 | (not force)) | 2976 | ;; keep the last article to avoid refetching |
| 2759 | ;; This could be a bit of a problem. I need to | 2977 | ;; headers when using nntp in the backend. At |
| 2760 | ;; keep the last article to avoid refetching | 2978 | ;; the same time, if someone uses a backend |
| 2761 | ;; headers when using nntp in the backend. At | 2979 | ;; that supports article moving then I may have |
| 2762 | ;; the same time, if someone uses a backend | 2980 | ;; to remove the last article to complete the |
| 2763 | ;; that supports article moving then I may have | 2981 | ;; move. Right now, I'm going to assume that |
| 2764 | ;; to remove the last article to complete the | 2982 | ;; FORCE overrides specials. |
| 2765 | ;; move. Right now, I'm going to assume that | 2983 | (list (caar (last alist))))) |
| 2766 | ;; FORCE overrides specials. | 2984 | (unreads ;; Articles that are excluded from the |
| 2767 | (list (caar (last alist))))) | 2985 | ;; expiration process |
| 2768 | (unreads ;; Articles that are excluded from the | 2986 | (cond (gnus-agent-expire-all |
| 2769 | ;; expiration process | 2987 | ;; All articles are marked read by global decree |
| 2770 | (cond (gnus-agent-expire-all | 2988 | nil) |
| 2771 | ;; All articles are marked read by global decree | 2989 | ((eq articles t) |
| 2772 | nil) | 2990 | ;; All articles are marked read by function |
| 2773 | ((eq articles t) | 2991 | ;; parameter |
| 2774 | ;; All articles are marked read by function | 2992 | nil) |
| 2775 | ;; parameter | 2993 | ((not articles) |
| 2776 | nil) | 2994 | ;; Unread articles are marked protected from |
| 2777 | ((not articles) | 2995 | ;; expiration Don't call |
| 2778 | ;; Unread articles are marked protected from | 2996 | ;; gnus-list-of-unread-articles as it returns |
| 2779 | ;; expiration Don't call | 2997 | ;; articles that have not been fetched into the |
| 2780 | ;; gnus-list-of-unread-articles as it returns | 2998 | ;; agent. |
| 2781 | ;; articles that have not been fetched into the | 2999 | (ignore-errors |
| 2782 | ;; agent. | 3000 | (gnus-agent-unread-articles group))) |
| 2783 | (ignore-errors | 3001 | (t |
| 2784 | (gnus-agent-unread-articles group))) | 3002 | ;; All articles EXCEPT those named by the caller |
| 2785 | (t | 3003 | ;; are protected from expiration |
| 2786 | ;; All articles EXCEPT those named by the caller | 3004 | (gnus-sorted-difference |
| 2787 | ;; are protected from expiration | 3005 | (gnus-uncompress-range |
| 2788 | (gnus-sorted-difference | 3006 | (cons (caar alist) |
| 2789 | (gnus-uncompress-range | 3007 | (caar (last alist)))) |
| 2790 | (cons (caar alist) | 3008 | (sort articles '<))))) |
| 2791 | (caar (last alist)))) | 3009 | (marked ;; More articles that are excluded from the |
| 2792 | (sort articles '<))))) | 3010 | ;; expiration process |
| 2793 | (marked ;; More articles that are excluded from the | 3011 | (cond (gnus-agent-expire-all |
| 2794 | ;; expiration process | 3012 | ;; All articles are unmarked by global decree |
| 2795 | (cond (gnus-agent-expire-all | 3013 | nil) |
| 2796 | ;; All articles are unmarked by global decree | 3014 | ((eq articles t) |
| 2797 | nil) | 3015 | ;; All articles are unmarked by function |
| 2798 | ((eq articles t) | 3016 | ;; parameter |
| 2799 | ;; All articles are unmarked by function | 3017 | nil) |
| 2800 | ;; parameter | 3018 | (articles |
| 2801 | nil) | 3019 | ;; All articles may as well be unmarked as the |
| 2802 | (articles | 3020 | ;; unreads list already names the articles we are |
| 2803 | ;; All articles may as well be unmarked as the | 3021 | ;; going to keep |
| 2804 | ;; unreads list already names the articles we are | 3022 | nil) |
| 2805 | ;; going to keep | 3023 | (t |
| 2806 | nil) | 3024 | ;; Ticked and/or dormant articles are excluded |
| 2807 | (t | 3025 | ;; from expiration |
| 2808 | ;; Ticked and/or dormant articles are excluded | 3026 | (nconc |
| 2809 | ;; from expiration | 3027 | (gnus-uncompress-range |
| 2810 | (nconc | 3028 | (cdr (assq 'tick (gnus-info-marks info)))) |
| 2811 | (gnus-uncompress-range | 3029 | (gnus-uncompress-range |
| 2812 | (cdr (assq 'tick (gnus-info-marks info)))) | 3030 | (cdr (assq 'dormant |
| 2813 | (gnus-uncompress-range | 3031 | (gnus-info-marks info)))))))) |
| 2814 | (cdr (assq 'dormant | 3032 | (nov-file (concat dir ".overview")) |
| 2815 | (gnus-info-marks info)))))))) | 3033 | (cnt 0) |
| 2816 | (nov-file (concat dir ".overview")) | 3034 | (completed -1) |
| 2817 | (cnt 0) | 3035 | dlist |
| 2818 | (completed -1) | 3036 | type) |
| 2819 | dlist | 3037 | |
| 2820 | type) | 3038 | ;; The normal article alist contains elements that look like |
| 2821 | 3039 | ;; (article# . fetch_date) I need to combine other | |
| 2822 | ;; The normal article alist contains elements that look like | 3040 | ;; information with this list. For example, a flag indicating |
| 2823 | ;; (article# . fetch_date) I need to combine other | 3041 | ;; that a particular article MUST BE KEPT. To do this, I'm |
| 2824 | ;; information with this list. For example, a flag indicating | 3042 | ;; going to transform the elements to look like (article# |
| 2825 | ;; that a particular article MUST BE KEPT. To do this, I'm | 3043 | ;; fetch_date keep_flag NOV_entry_marker) Later, I'll reverse |
| 2826 | ;; going to transform the elements to look like (article# | 3044 | ;; the process to generate the expired article alist. |
| 2827 | ;; fetch_date keep_flag NOV_entry_marker) Later, I'll reverse | 3045 | |
| 2828 | ;; the process to generate the expired article alist. | 3046 | ;; Convert the alist elements to (article# fetch_date nil |
| 2829 | 3047 | ;; nil). | |
| 2830 | ;; Convert the alist elements to (article# fetch_date nil | 3048 | (setq dlist (mapcar (lambda (e) |
| 2831 | ;; nil). | 3049 | (list (car e) (cdr e) nil nil)) alist)) |
| 2832 | (setq dlist (mapcar (lambda (e) | 3050 | |
| 2833 | (list (car e) (cdr e) nil nil)) alist)) | 3051 | ;; Convert the keep lists to elements that look like (article# |
| 2834 | 3052 | ;; nil keep_flag nil) then append it to the expanded dlist | |
| 2835 | ;; Convert the keep lists to elements that look like (article# | 3053 | ;; These statements are sorted by ascending precidence of the |
| 2836 | ;; nil keep_flag nil) then append it to the expanded dlist | 3054 | ;; keep_flag. |
| 2837 | ;; These statements are sorted by ascending precidence of the | 3055 | (setq dlist (nconc dlist |
| 2838 | ;; keep_flag. | 3056 | (mapcar (lambda (e) |
| 2839 | (setq dlist (nconc dlist | 3057 | (list e nil 'unread nil)) |
| 2840 | (mapcar (lambda (e) | 3058 | unreads))) |
| 2841 | (list e nil 'unread nil)) | 3059 | (setq dlist (nconc dlist |
| 2842 | unreads))) | 3060 | (mapcar (lambda (e) |
| 2843 | (setq dlist (nconc dlist | 3061 | (list e nil 'marked nil)) |
| 2844 | (mapcar (lambda (e) | 3062 | marked))) |
| 2845 | (list e nil 'marked nil)) | 3063 | (setq dlist (nconc dlist |
| 2846 | marked))) | 3064 | (mapcar (lambda (e) |
| 2847 | (setq dlist (nconc dlist | 3065 | (list e nil 'special nil)) |
| 2848 | (mapcar (lambda (e) | 3066 | specials))) |
| 2849 | (list e nil 'special nil)) | 3067 | |
| 2850 | specials))) | 3068 | (set-buffer overview) |
| 2851 | 3069 | (erase-buffer) | |
| 2852 | (set-buffer overview) | 3070 | (buffer-disable-undo) |
| 2853 | (erase-buffer) | 3071 | (when (file-exists-p nov-file) |
| 2854 | (buffer-disable-undo) | 3072 | (gnus-message 7 "gnus-agent-expire: Loading overview...") |
| 2855 | (when (file-exists-p nov-file) | 3073 | (nnheader-insert-file-contents nov-file) |
| 2856 | (gnus-message 7 "gnus-agent-expire: Loading overview...") | 3074 | (goto-char (point-min)) |
| 2857 | (nnheader-insert-file-contents nov-file) | 3075 | |
| 2858 | (goto-char (point-min)) | 3076 | (let (p) |
| 2859 | 3077 | (while (< (setq p (point)) (point-max)) | |
| 2860 | (let (p) | 3078 | (condition-case nil |
| 2861 | (while (< (setq p (point)) (point-max)) | 3079 | ;; If I successfully read an integer (the plus zero |
| 2862 | (condition-case nil | 3080 | ;; ensures a numeric type), prepend a marker entry |
| 2863 | ;; If I successfully read an integer (the plus zero | 3081 | ;; to the list |
| 2864 | ;; ensures a numeric type), prepend a marker entry | 3082 | (push (list (+ 0 (read (current-buffer))) nil nil |
| 2865 | ;; to the list | 3083 | (set-marker (make-marker) p)) |
| 2866 | (push (list (+ 0 (read (current-buffer))) nil nil | 3084 | dlist) |
| 2867 | (set-marker (make-marker) p)) | 3085 | (error |
| 2868 | dlist) | 3086 | (gnus-message 1 "gnus-agent-expire: read error \ |
| 2869 | (error | ||
| 2870 | (gnus-message 1 "gnus-agent-expire: read error \ | ||
| 2871 | occurred when reading expression at %s in %s. Skipping to next \ | 3087 | occurred when reading expression at %s in %s. Skipping to next \ |
| 2872 | line." (point) nov-file))) | 3088 | line." (point) nov-file))) |
| 2873 | ;; Whether I succeeded, or failed, it doesn't matter. | 3089 | ;; Whether I succeeded, or failed, it doesn't matter. |
| 2874 | ;; Move to the next line then try again. | 3090 | ;; Move to the next line then try again. |
| 2875 | (forward-line 1))) | 3091 | (forward-line 1))) |
| 2876 | 3092 | ||
| 2877 | (gnus-message | 3093 | (gnus-message |
| 2878 | 7 "gnus-agent-expire: Loading overview... Done")) | 3094 | 7 "gnus-agent-expire: Loading overview... Done")) |
| 2879 | (set-buffer-modified-p nil) | 3095 | (set-buffer-modified-p nil) |
| 2880 | 3096 | ||
| 2881 | ;; At this point, all of the information is in dlist. The | 3097 | ;; At this point, all of the information is in dlist. The |
| 2882 | ;; only problem is that much of it is spread across multiple | 3098 | ;; only problem is that much of it is spread across multiple |
| 2883 | ;; entries. Sort then MERGE!! | 3099 | ;; entries. Sort then MERGE!! |
| 2884 | (gnus-message 7 "gnus-agent-expire: Sorting entries... ") | 3100 | (gnus-message 7 "gnus-agent-expire: Sorting entries... ") |
| 2885 | ;; If two entries have the same article-number then sort by | 3101 | ;; If two entries have the same article-number then sort by |
| 2886 | ;; ascending keep_flag. | 3102 | ;; ascending keep_flag. |
| 2887 | (let ((special 0) | 3103 | (let ((special 0) |
| 2888 | (marked 1) | 3104 | (marked 1) |
| 2889 | (unread 2)) | 3105 | (unread 2)) |
| 2890 | (setq dlist | 3106 | (setq dlist |
| 2891 | (sort dlist | 3107 | (sort dlist |
| 2892 | (lambda (a b) | 3108 | (lambda (a b) |
| 2893 | (cond ((< (nth 0 a) (nth 0 b)) | 3109 | (cond ((< (nth 0 a) (nth 0 b)) |
| 2894 | t) | 3110 | t) |
| 2895 | ((> (nth 0 a) (nth 0 b)) | 3111 | ((> (nth 0 a) (nth 0 b)) |
| 2896 | nil) | 3112 | nil) |
| 2897 | (t | 3113 | (t |
| 2898 | (let ((a (or (symbol-value (nth 2 a)) | 3114 | (let ((a (or (symbol-value (nth 2 a)) |
| 2899 | 3)) | 3115 | 3)) |
| 2900 | (b (or (symbol-value (nth 2 b)) | 3116 | (b (or (symbol-value (nth 2 b)) |
| 2901 | 3))) | 3117 | 3))) |
| 2902 | (<= a b)))))))) | 3118 | (<= a b)))))))) |
| 2903 | (gnus-message 7 "gnus-agent-expire: Sorting entries... Done") | 3119 | (gnus-message 7 "gnus-agent-expire: Sorting entries... Done") |
| 2904 | (gnus-message 7 "gnus-agent-expire: Merging entries... ") | 3120 | (gnus-message 7 "gnus-agent-expire: Merging entries... ") |
| 2905 | (let ((dlist dlist)) | 3121 | (let ((dlist dlist)) |
| 2906 | (while (cdr dlist) ; I'm not at the end-of-list | 3122 | (while (cdr dlist) ; I'm not at the end-of-list |
| 2907 | (if (eq (caar dlist) (caadr dlist)) | 3123 | (if (eq (caar dlist) (caadr dlist)) |
| 2908 | (let ((first (cdr (car dlist))) | 3124 | (let ((first (cdr (car dlist))) |
| 2909 | (secnd (cdr (cadr dlist)))) | 3125 | (secnd (cdr (cadr dlist)))) |
| 2910 | (setcar first (or (car first) | 3126 | (setcar first (or (car first) |
| 2911 | (car secnd))) ; fetch_date | 3127 | (car secnd))) ; fetch_date |
| 2912 | (setq first (cdr first) | 3128 | (setq first (cdr first) |
| 2913 | secnd (cdr secnd)) | 3129 | secnd (cdr secnd)) |
| 2914 | (setcar first (or (car first) | 3130 | (setcar first (or (car first) |
| 2915 | (car secnd))) ; Keep_flag | 3131 | (car secnd))) ; Keep_flag |
| 2916 | (setq first (cdr first) | 3132 | (setq first (cdr first) |
| 2917 | secnd (cdr secnd)) | 3133 | secnd (cdr secnd)) |
| 2918 | (setcar first (or (car first) | 3134 | (setcar first (or (car first) |
| 2919 | (car secnd))) ; NOV_entry_marker | 3135 | (car secnd))) ; NOV_entry_marker |
| 2920 | 3136 | ||
| 2921 | (setcdr dlist (cddr dlist))) | 3137 | (setcdr dlist (cddr dlist))) |
| 2922 | (setq dlist (cdr dlist))))) | 3138 | (setq dlist (cdr dlist))))) |
| 2923 | (gnus-message 7 "gnus-agent-expire: Merging entries... Done") | 3139 | (gnus-message 7 "gnus-agent-expire: Merging entries... Done") |
| 2924 | 3140 | ||
| 2925 | (let* ((len (float (length dlist))) | 3141 | (let* ((len (float (length dlist))) |
| 2926 | (alist (list nil)) | 3142 | (alist (list nil)) |
| 2927 | (tail-alist alist)) | 3143 | (tail-alist alist)) |
| 2928 | (while dlist | 3144 | (while dlist |
| 2929 | (let ((new-completed (truncate (* 100.0 | 3145 | (let ((new-completed (truncate (* 100.0 |
| 2930 | (/ (setq cnt (1+ cnt)) | 3146 | (/ (setq cnt (1+ cnt)) |
| 2931 | len)))) | 3147 | len)))) |
| 2932 | message-log-max) | 3148 | message-log-max) |
| 2933 | (when (> new-completed completed) | 3149 | (when (> new-completed completed) |
| 2934 | (setq completed new-completed) | 3150 | (setq completed new-completed) |
| 2935 | (gnus-message 7 "%3d%% completed..." completed))) | 3151 | (gnus-message 7 "%3d%% completed..." completed))) |
| 2936 | (let* ((entry (car dlist)) | 3152 | (let* ((entry (car dlist)) |
| 2937 | (article-number (nth 0 entry)) | 3153 | (article-number (nth 0 entry)) |
| 2938 | (fetch-date (nth 1 entry)) | 3154 | (fetch-date (nth 1 entry)) |
| 2939 | (keep (nth 2 entry)) | 3155 | (keep (nth 2 entry)) |
| 2940 | (marker (nth 3 entry))) | 3156 | (marker (nth 3 entry))) |
| 2941 | 3157 | ||
| 2942 | (cond | 3158 | (cond |
| 2943 | ;; Kept articles are unread, marked, or special. | 3159 | ;; Kept articles are unread, marked, or special. |
| 2944 | (keep | 3160 | (keep |
| 2945 | (gnus-agent-message 10 | 3161 | (gnus-agent-message 10 |
| 2946 | "gnus-agent-expire: %s:%d: Kept %s article%s." | 3162 | "gnus-agent-expire: %s:%d: Kept %s article%s." |
| 2947 | group article-number keep (if fetch-date " and file" "")) | 3163 | group article-number keep (if fetch-date " and file" "")) |
| 2948 | (when fetch-date | 3164 | (when fetch-date |
| 2949 | (unless (file-exists-p | 3165 | (unless (file-exists-p |
| 2950 | (concat dir (number-to-string | 3166 | (concat dir (number-to-string |
| 2951 | article-number))) | 3167 | article-number))) |
| 2952 | (setf (nth 1 entry) nil) | 3168 | (setf (nth 1 entry) nil) |
| 2953 | (gnus-agent-message 3 "gnus-agent-expire cleared \ | 3169 | (gnus-agent-message 3 "gnus-agent-expire cleared \ |
| 2954 | download flag on %s:%d as the cached article file is missing." | 3170 | download flag on %s:%d as the cached article file is missing." |
| 2955 | group (caar dlist))) | 3171 | group (caar dlist))) |
| 2956 | (unless marker | 3172 | (unless marker |
| 2957 | (gnus-message 1 "gnus-agent-expire detected a \ | 3173 | (gnus-message 1 "gnus-agent-expire detected a \ |
| 2958 | missing NOV entry. Run gnus-agent-regenerate-group to restore it."))) | 3174 | missing NOV entry. Run gnus-agent-regenerate-group to restore it."))) |
| 2959 | (gnus-agent-append-to-list | 3175 | (gnus-agent-append-to-list |
| 2960 | tail-alist | 3176 | tail-alist |
| 2961 | (cons article-number fetch-date))) | 3177 | (cons article-number fetch-date))) |
| 2962 | 3178 | ||
| 2963 | ;; The following articles are READ, UNMARKED, and | 3179 | ;; The following articles are READ, UNMARKED, and |
| 2964 | ;; ORDINARY. See if they can be EXPIRED!!! | 3180 | ;; ORDINARY. See if they can be EXPIRED!!! |
| 2965 | ((setq type | 3181 | ((setq type |
| 2966 | (cond | 3182 | (cond |
| 2967 | ((not (integerp fetch-date)) | 3183 | ((not (integerp fetch-date)) |
| 2968 | 'read) ;; never fetched article (may expire | 3184 | 'read) ;; never fetched article (may expire |
| 2969 | ;; right now) | 3185 | ;; right now) |
| 2970 | ((not (file-exists-p | 3186 | ((not (file-exists-p |
| 2971 | (concat dir (number-to-string | 3187 | (concat dir (number-to-string |
| 2972 | article-number)))) | 3188 | article-number)))) |
| 2973 | (setf (nth 1 entry) nil) | 3189 | (setf (nth 1 entry) nil) |
| 2974 | 'externally-expired) ;; Can't find the cached | 3190 | 'externally-expired) ;; Can't find the cached |
| 2975 | ;; article. Handle case | 3191 | ;; article. Handle case |
| 2976 | ;; as though this article | 3192 | ;; as though this article |
| 2977 | ;; was never fetched. | 3193 | ;; was never fetched. |
| 2978 | 3194 | ||
| 2979 | ;; We now have the arrival day, so we see | 3195 | ;; We now have the arrival day, so we see |
| 2980 | ;; whether it's old enough to be expired. | 3196 | ;; whether it's old enough to be expired. |
| 2981 | ((< fetch-date day) | 3197 | ((< fetch-date day) |
| 2982 | 'expired) | 3198 | 'expired) |
| 2983 | (force | 3199 | (force |
| 2984 | 'forced))) | 3200 | 'forced))) |
| 2985 | 3201 | ||
| 2986 | ;; I found some reason to expire this entry. | 3202 | ;; I found some reason to expire this entry. |
| 2987 | 3203 | ||
| 2988 | (let ((actions nil)) | 3204 | (let ((actions nil)) |
| 2989 | (when (memq type '(forced expired)) | 3205 | (when (memq type '(forced expired)) |
| 2990 | (ignore-errors ; Just being paranoid. | 3206 | (ignore-errors ; Just being paranoid. |
| 2991 | (let ((file-name (concat dir (number-to-string | 3207 | (let* ((file-name (nnheader-concat dir (number-to-string |
| 2992 | article-number)))) | 3208 | article-number))) |
| 2993 | (incf (nth 2 stats) (nth 7 (file-attributes file-name))) | 3209 | (size (float (nth 7 (file-attributes file-name))))) |
| 2994 | (incf (nth 1 stats)) | 3210 | (incf bytes-freed size) |
| 2995 | (delete-file file-name)) | 3211 | (incf files-deleted) |
| 2996 | (push "expired cached article" actions)) | 3212 | (delete-file file-name)) |
| 2997 | (setf (nth 1 entry) nil) | 3213 | (push "expired cached article" actions)) |
| 2998 | ) | 3214 | (setf (nth 1 entry) nil) |
| 2999 | 3215 | ) | |
| 3000 | (when marker | 3216 | |
| 3001 | (push "NOV entry removed" actions) | 3217 | (when marker |
| 3002 | (goto-char marker) | 3218 | (push "NOV entry removed" actions) |
| 3003 | 3219 | (goto-char marker) | |
| 3004 | (incf (nth 0 stats)) | 3220 | |
| 3005 | 3221 | (incf nov-entries-deleted) | |
| 3006 | (let ((from (gnus-point-at-bol)) | 3222 | |
| 3007 | (to (progn (forward-line 1) (point)))) | 3223 | (let ((from (gnus-point-at-bol)) |
| 3008 | (incf (nth 2 stats) (- to from)) | 3224 | (to (progn (forward-line 1) (point)))) |
| 3009 | (delete-region from to))) | 3225 | (incf bytes-freed (- to from)) |
| 3010 | 3226 | (delete-region from to))) | |
| 3011 | ;; If considering all articles is set, I can only | 3227 | |
| 3012 | ;; expire article IDs that are no longer in the | 3228 | ;; If considering all articles is set, I can only |
| 3013 | ;; active range (That is, articles that preceed the | 3229 | ;; expire article IDs that are no longer in the |
| 3014 | ;; first article in the new alist). | 3230 | ;; active range (That is, articles that preceed the |
| 3015 | (if (and gnus-agent-consider-all-articles | 3231 | ;; first article in the new alist). |
| 3016 | (>= article-number (car active))) | 3232 | (if (and gnus-agent-consider-all-articles |
| 3017 | ;; I have to keep this ID in the alist | 3233 | (>= article-number (car active))) |
| 3018 | (gnus-agent-append-to-list | 3234 | ;; I have to keep this ID in the alist |
| 3019 | tail-alist (cons article-number fetch-date)) | 3235 | (gnus-agent-append-to-list |
| 3020 | (push (format "Removed %s article number from \ | 3236 | tail-alist (cons article-number fetch-date)) |
| 3237 | (push (format "Removed %s article number from \ | ||
| 3021 | article alist" type) actions)) | 3238 | article alist" type) actions)) |
| 3022 | 3239 | ||
| 3023 | (when actions | 3240 | (when actions |
| 3024 | (gnus-agent-message 8 "gnus-agent-expire: %s:%d: %s" | 3241 | (gnus-agent-message 8 "gnus-agent-expire: %s:%d: %s" |
| 3025 | group article-number | 3242 | group article-number |
| 3026 | (mapconcat 'identity actions ", "))))) | 3243 | (mapconcat 'identity actions ", "))))) |
| 3027 | (t | 3244 | (t |
| 3028 | (gnus-agent-message | 3245 | (gnus-agent-message |
| 3029 | 10 "gnus-agent-expire: %s:%d: Article kept as \ | 3246 | 10 "gnus-agent-expire: %s:%d: Article kept as \ |
| 3030 | expiration tests failed." group article-number) | 3247 | expiration tests failed." group article-number) |
| 3031 | (gnus-agent-append-to-list | 3248 | (gnus-agent-append-to-list |
| 3032 | tail-alist (cons article-number fetch-date))) | 3249 | tail-alist (cons article-number fetch-date))) |
| 3033 | ) | 3250 | ) |
| 3034 | 3251 | ||
| 3035 | ;; Clean up markers as I want to recycle this buffer | 3252 | ;; Clean up markers as I want to recycle this buffer |
| 3036 | ;; over several groups. | 3253 | ;; over several groups. |
| 3037 | (when marker | 3254 | (when marker |
| 3038 | (set-marker marker nil)) | 3255 | (set-marker marker nil)) |
| 3039 | 3256 | ||
| 3040 | (setq dlist (cdr dlist)))) | 3257 | (setq dlist (cdr dlist)))) |
| 3041 | 3258 | ||
| 3042 | (setq alist (cdr alist)) | 3259 | (setq alist (cdr alist)) |
| 3043 | 3260 | ||
| 3044 | (let ((inhibit-quit t)) | 3261 | (let ((inhibit-quit t)) |
| 3045 | (unless (equal alist gnus-agent-article-alist) | 3262 | (unless (equal alist gnus-agent-article-alist) |
| 3046 | (setq gnus-agent-article-alist alist) | 3263 | (setq gnus-agent-article-alist alist) |
| 3047 | (gnus-agent-save-alist group)) | 3264 | (gnus-agent-save-alist group)) |
| 3048 | 3265 | ||
| 3049 | (when (buffer-modified-p) | 3266 | (when (buffer-modified-p) |
| 3050 | (let ((coding-system-for-write | 3267 | (let ((coding-system-for-write |
| 3051 | gnus-agent-file-coding-system)) | 3268 | gnus-agent-file-coding-system)) |
| 3052 | (gnus-make-directory dir) | 3269 | (gnus-make-directory dir) |
| 3053 | (write-region (point-min) (point-max) nov-file nil | 3270 | (write-region (point-min) (point-max) nov-file nil |
| 3054 | 'silent) | 3271 | 'silent) |
| 3055 | ;; clear the modified flag as that I'm not confused by | 3272 | ;; clear the modified flag as that I'm not confused by |
| 3056 | ;; its status on the next pass through this routine. | 3273 | ;; its status on the next pass through this routine. |
| 3057 | (set-buffer-modified-p nil))) | 3274 | (set-buffer-modified-p nil))) |
| 3058 | 3275 | ||
| 3059 | (when (eq articles t) | 3276 | (when (eq articles t) |
| 3060 | (gnus-summary-update-info)))))))) | 3277 | (gnus-summary-update-info)))) |
| 3278 | |||
| 3279 | (when (boundp 'gnus-agent-expire-stats) | ||
| 3280 | (let ((stats (symbol-value 'gnus-agent-expire-stats))) | ||
| 3281 | (incf (nth 2 stats) bytes-freed) | ||
| 3282 | (incf (nth 1 stats) files-deleted) | ||
| 3283 | (incf (nth 0 stats) nov-entries-deleted))) | ||
| 3284 | )))) | ||
| 3061 | 3285 | ||
| 3062 | (defun gnus-agent-expire (&optional articles group force) | 3286 | (defun gnus-agent-expire (&optional articles group force) |
| 3063 | "Expire all old articles. | 3287 | "Expire all old articles. |
| @@ -3248,7 +3472,7 @@ articles in every agentized group.")) | |||
| 3248 | 3472 | ||
| 3249 | (defun gnus-agent-uncached-articles (articles group &optional cached-header) | 3473 | (defun gnus-agent-uncached-articles (articles group &optional cached-header) |
| 3250 | "Restrict ARTICLES to numbers already fetched. | 3474 | "Restrict ARTICLES to numbers already fetched. |
| 3251 | Returns a sublist of ARTICLES that excludes thos article ids in GROUP | 3475 | Returns a sublist of ARTICLES that excludes those article ids in GROUP |
| 3252 | that have already been fetched. | 3476 | that have already been fetched. |
| 3253 | If CACHED-HEADER is nil, articles are only excluded if the article itself | 3477 | If CACHED-HEADER is nil, articles are only excluded if the article itself |
| 3254 | has been fetched." | 3478 | has been fetched." |
| @@ -3338,12 +3562,11 @@ has been fetched." | |||
| 3338 | 3562 | ||
| 3339 | ;; Get the list of articles that were fetched | 3563 | ;; Get the list of articles that were fetched |
| 3340 | (goto-char (point-min)) | 3564 | (goto-char (point-min)) |
| 3341 | (let ((pm (point-max))) | 3565 | (let ((pm (point-max)) |
| 3566 | art) | ||
| 3342 | (while (< (point) pm) | 3567 | (while (< (point) pm) |
| 3343 | (when (looking-at "[0-9]+\t") | 3568 | (when (setq art (gnus-agent-read-article-number)) |
| 3344 | (gnus-agent-append-to-list | 3569 | (gnus-agent-append-to-list tail-fetched-articles art)) |
| 3345 | tail-fetched-articles | ||
| 3346 | (read (current-buffer)))) | ||
| 3347 | (forward-line 1))) | 3570 | (forward-line 1))) |
| 3348 | 3571 | ||
| 3349 | ;; Clip this list to the headers that will | 3572 | ;; Clip this list to the headers that will |
| @@ -3380,12 +3603,12 @@ has been fetched." | |||
| 3380 | (set-buffer nntp-server-buffer) | 3603 | (set-buffer nntp-server-buffer) |
| 3381 | (copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max)) | 3604 | (copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max)) |
| 3382 | 3605 | ||
| 3383 | ;; Merge the temp buffer with the known headers (found on | 3606 | ;; Merge the temp buffer with the known headers (found on |
| 3384 | ;; disk in FILE) into the nntp-server-buffer | 3607 | ;; disk in FILE) into the nntp-server-buffer |
| 3385 | (when (and uncached-articles (file-exists-p file)) | 3608 | (when uncached-articles |
| 3386 | (gnus-agent-braid-nov group uncached-articles file)) | 3609 | (gnus-agent-braid-nov group uncached-articles file)) |
| 3387 | 3610 | ||
| 3388 | ;; Save the new set of known headers to FILE | 3611 | ;; Save the new set of known headers to FILE |
| 3389 | (set-buffer nntp-server-buffer) | 3612 | (set-buffer nntp-server-buffer) |
| 3390 | (let ((coding-system-for-write | 3613 | (let ((coding-system-for-write |
| 3391 | gnus-agent-file-coding-system)) | 3614 | gnus-agent-file-coding-system)) |
| @@ -3465,7 +3688,6 @@ If REREAD is not nil, downloaded articles are marked as unread." | |||
| 3465 | (gnus-message 3 "Ignoring unexpected input") | 3688 | (gnus-message 3 "Ignoring unexpected input") |
| 3466 | (sit-for 1) | 3689 | (sit-for 1) |
| 3467 | t))))) | 3690 | t))))) |
| 3468 | |||
| 3469 | (when group | 3691 | (when group |
| 3470 | (gnus-message 5 "Regenerating in %s" group) | 3692 | (gnus-message 5 "Regenerating in %s" group) |
| 3471 | (let* ((gnus-command-method (or gnus-command-method | 3693 | (let* ((gnus-command-method (or gnus-command-method |
| @@ -3506,7 +3728,7 @@ If REREAD is not nil, downloaded articles are marked as unread." | |||
| 3506 | (gnus-delete-line) | 3728 | (gnus-delete-line) |
| 3507 | (setq nov-arts (cdr nov-arts)) | 3729 | (setq nov-arts (cdr nov-arts)) |
| 3508 | (gnus-message 4 "gnus-agent-regenerate-group: NOV\ | 3730 | (gnus-message 4 "gnus-agent-regenerate-group: NOV\ |
| 3509 | entry of article %s deleted." l1)) | 3731 | entry of article %s deleted." l1)) |
| 3510 | ((not l2) | 3732 | ((not l2) |
| 3511 | nil) | 3733 | nil) |
| 3512 | ((< l1 l2) | 3734 | ((< l1 l2) |
| @@ -3651,10 +3873,9 @@ entry of article %s deleted." l1)) | |||
| 3651 | gnus-agent-article-alist)))) | 3873 | gnus-agent-article-alist)))) |
| 3652 | 3874 | ||
| 3653 | (when (gnus-buffer-live-p gnus-group-buffer) | 3875 | (when (gnus-buffer-live-p gnus-group-buffer) |
| 3654 | (gnus-group-update-group group t) | 3876 | (gnus-group-update-group group t))) |
| 3655 | (sit-for 0))) | ||
| 3656 | 3877 | ||
| 3657 | (gnus-message 5 nil) | 3878 | (gnus-message 5 "") |
| 3658 | regenerated))) | 3879 | regenerated))) |
| 3659 | 3880 | ||
| 3660 | ;;;###autoload | 3881 | ;;;###autoload |
| @@ -3700,49 +3921,6 @@ If CLEAN, obsolete (ignore)." | |||
| 3700 | (defun gnus-agent-group-covered-p (group) | 3921 | (defun gnus-agent-group-covered-p (group) |
| 3701 | (gnus-agent-method-p (gnus-group-method group))) | 3922 | (gnus-agent-method-p (gnus-group-method group))) |
| 3702 | 3923 | ||
| 3703 | (add-hook 'gnus-group-prepare-hook | ||
| 3704 | (lambda () | ||
| 3705 | 'gnus-agent-do-once | ||
| 3706 | |||
| 3707 | (when (listp gnus-agent-expire-days) | ||
| 3708 | (beep) | ||
| 3709 | (beep) | ||
| 3710 | (gnus-message 1 "WARNING: gnus-agent-expire-days no longer\ | ||
| 3711 | supports being set to a list.")(sleep-for 3) | ||
| 3712 | (gnus-message 1 "Change your configuration to set it to an\ | ||
| 3713 | integer.")(sleep-for 3) | ||
| 3714 | (gnus-message 1 "I am now setting group parameters on each\ | ||
| 3715 | group to match the configuration that the list offered.") | ||
| 3716 | |||
| 3717 | (save-excursion | ||
| 3718 | (let ((groups (gnus-group-listed-groups))) | ||
| 3719 | (while groups | ||
| 3720 | (let* ((group (pop groups)) | ||
| 3721 | (days gnus-agent-expire-days) | ||
| 3722 | (day (catch 'found | ||
| 3723 | (while days | ||
| 3724 | (when (eq 0 (string-match | ||
| 3725 | (caar days) | ||
| 3726 | group)) | ||
| 3727 | (throw 'found (cadar days))) | ||
| 3728 | (setq days (cdr days))) | ||
| 3729 | nil))) | ||
| 3730 | (when day | ||
| 3731 | (gnus-group-set-parameter group 'agent-days-until-old | ||
| 3732 | day)))))) | ||
| 3733 | |||
| 3734 | (let ((h gnus-group-prepare-hook)) | ||
| 3735 | (while h | ||
| 3736 | (let ((func (pop h))) | ||
| 3737 | (when (and (listp func) | ||
| 3738 | (eq (cadr (caddr func)) 'gnus-agent-do-once)) | ||
| 3739 | (remove-hook 'gnus-group-prepare-hook func) | ||
| 3740 | (setq h nil))))) | ||
| 3741 | |||
| 3742 | (gnus-message 1 "I have finished setting group parameters on\ | ||
| 3743 | each group. You may now customize your groups and/or topics to control the\ | ||
| 3744 | agent.")))) | ||
| 3745 | |||
| 3746 | (provide 'gnus-agent) | 3924 | (provide 'gnus-agent) |
| 3747 | 3925 | ||
| 3748 | ;;; arch-tag: b0ba4afc-5229-4cee-ad25-9956daa4e91e | 3926 | ;;; arch-tag: b0ba4afc-5229-4cee-ad25-9956daa4e91e |
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index d4dbe1319e0..7a365d81a2c 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el | |||
| @@ -6122,7 +6122,7 @@ positives are possible." | |||
| 6122 | ("\\(<URL: *\\)mailto: *\\([^> \n\t]+\\)>" | 6122 | ("\\(<URL: *\\)mailto: *\\([^> \n\t]+\\)>" |
| 6123 | 0 (>= gnus-button-message-level 0) gnus-url-mailto 2) | 6123 | 0 (>= gnus-button-message-level 0) gnus-url-mailto 2) |
| 6124 | ;; RFC 2368 (The mailto URL scheme) | 6124 | ;; RFC 2368 (The mailto URL scheme) |
| 6125 | ("mailto:\\([-a-z.@_+0-9%=?&]+\\)" | 6125 | ("\\bmailto:\\([-a-z.@_+0-9%=?&/]+\\)" |
| 6126 | 0 (>= gnus-button-message-level 0) gnus-url-mailto 1) | 6126 | 0 (>= gnus-button-message-level 0) gnus-url-mailto 1) |
| 6127 | ("\\bmailto:\\([^ \n\t]+\\)" | 6127 | ("\\bmailto:\\([^ \n\t]+\\)" |
| 6128 | 0 (>= gnus-button-message-level 0) gnus-url-mailto 1) | 6128 | 0 (>= gnus-button-message-level 0) gnus-url-mailto 1) |
| @@ -6170,8 +6170,9 @@ positives are possible." | |||
| 6170 | ("M-x[ \t\n]+apropos-documentation[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET" | 6170 | ("M-x[ \t\n]+apropos-documentation[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET" |
| 6171 | 0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-documentation 1) | 6171 | 0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-documentation 1) |
| 6172 | ;; The following entries may lead to many false positives so don't enable | 6172 | ;; The following entries may lead to many false positives so don't enable |
| 6173 | ;; them by default (use a high button level): | 6173 | ;; them by default (use a high button level). |
| 6174 | ("/\\([a-z][-a-z0-9]+\\.el\\)\\>" | 6174 | ("/\\([a-z][-a-z0-9]+\\.el\\)\\>[^.?]" |
| 6175 | ;; Exclude [.?] for URLs in gmane.emacs.cvs | ||
| 6175 | 1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1) | 6176 | 1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1) |
| 6176 | ("`\\([a-z][-a-z0-9]+\\.el\\)'" | 6177 | ("`\\([a-z][-a-z0-9]+\\.el\\)'" |
| 6177 | 1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1) | 6178 | 1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1) |
| @@ -6204,16 +6205,16 @@ positives are possible." | |||
| 6204 | (gnus-button-url-regexp | 6205 | (gnus-button-url-regexp |
| 6205 | 0 (>= gnus-button-browse-level 0) browse-url 0) | 6206 | 0 (>= gnus-button-browse-level 0) browse-url 0) |
| 6206 | ;; man pages | 6207 | ;; man pages |
| 6207 | ("\\b\\([a-z][a-z]+\\)([1-9])\\W" | 6208 | ("\\b\\([a-z][a-z]+([1-9])\\)\\W" |
| 6208 | 0 (and (>= gnus-button-man-level 1) (< gnus-button-man-level 3)) | 6209 | 0 (and (>= gnus-button-man-level 1) (< gnus-button-man-level 3)) |
| 6209 | gnus-button-handle-man 1) | 6210 | gnus-button-handle-man 1) |
| 6210 | ;; more man pages: resolv.conf(5), iso_8859-1(7), xterm(1x) | 6211 | ;; more man pages: resolv.conf(5), iso_8859-1(7), xterm(1x) |
| 6211 | ("\\b\\([a-z][-_.a-z0-9]+\\)([1-9])\\W" | 6212 | ("\\b\\([a-z][-_.a-z0-9]+([1-9])\\)\\W" |
| 6212 | 0 (and (>= gnus-button-man-level 3) (< gnus-button-man-level 5)) | 6213 | 0 (and (>= gnus-button-man-level 3) (< gnus-button-man-level 5)) |
| 6213 | gnus-button-handle-man 1) | 6214 | gnus-button-handle-man 1) |
| 6214 | ;; even more: Apache::PerlRun(3pm), PDL::IO::FastRaw(3pm), | 6215 | ;; even more: Apache::PerlRun(3pm), PDL::IO::FastRaw(3pm), |
| 6215 | ;; SoWWWAnchor(3iv), XSelectInput(3X11), X(1), X(7) | 6216 | ;; SoWWWAnchor(3iv), XSelectInput(3X11), X(1), X(7) |
| 6216 | ("\\b\\([a-z][-+_.:a-z0-9]+\\)([1-9][X1a-z]*)\\W\\|\\b\\(X\\)([1-9])\\W" | 6217 | ("\\b\\(\\(?:[a-z][-+_.:a-z0-9]+([1-9][X1a-z]*)\\)\\|\\b\\(?:X([1-9])\\)\\)\\W" |
| 6217 | 0 (>= gnus-button-man-level 5) gnus-button-handle-man 1) | 6218 | 0 (>= gnus-button-man-level 5) gnus-button-handle-man 1) |
| 6218 | ;; MID or mail: To avoid too many false positives we don't try to catch | 6219 | ;; MID or mail: To avoid too many false positives we don't try to catch |
| 6219 | ;; all kind of allowed MIDs or mail addresses. Domain part must contain | 6220 | ;; all kind of allowed MIDs or mail addresses. Domain part must contain |
| @@ -6257,7 +6258,7 @@ variable it the real callback function." | |||
| 6257 | 0 (>= gnus-button-browse-level 0) browse-url 0) | 6258 | 0 (>= gnus-button-browse-level 0) browse-url 0) |
| 6258 | ("^[^:]+:" gnus-button-url-regexp | 6259 | ("^[^:]+:" gnus-button-url-regexp |
| 6259 | 0 (>= gnus-button-browse-level 0) browse-url 0) | 6260 | 0 (>= gnus-button-browse-level 0) browse-url 0) |
| 6260 | ("^[^:]+:" "\\bmailto:\\([-a-z.@_+0-9%=?&]+\\)" | 6261 | ("^[^:]+:" "\\bmailto:\\([-a-z.@_+0-9%=?&/]+\\)" |
| 6261 | 0 (>= gnus-button-message-level 0) gnus-url-mailto 1) | 6262 | 0 (>= gnus-button-message-level 0) gnus-url-mailto 1) |
| 6262 | ("^[^:]+:" "\\(<\\(url: \\)?\\(nntp\\|news\\):\\([^>\n ]*\\)>\\)" | 6263 | ("^[^:]+:" "\\(<\\(url: \\)?\\(nntp\\|news\\):\\([^>\n ]*\\)>\\)" |
| 6263 | 1 (>= gnus-button-message-level 0) gnus-button-message-id 4)) | 6264 | 1 (>= gnus-button-message-level 0) gnus-button-message-id 4)) |
| @@ -6602,6 +6603,10 @@ specified by `gnus-button-alist'." | |||
| 6602 | 6603 | ||
| 6603 | (defun gnus-button-handle-man (url) | 6604 | (defun gnus-button-handle-man (url) |
| 6604 | "Fetch a man page." | 6605 | "Fetch a man page." |
| 6606 | (gnus-message 9 "`%s' `%s'" gnus-button-man-handler url) | ||
| 6607 | (when (eq gnus-button-man-handler 'woman) | ||
| 6608 | (setq url (gnus-replace-in-string url "([1-9][X1a-z]*).*\\'" ""))) | ||
| 6609 | (gnus-message 9 "`%s' `%s'" gnus-button-man-handler url) | ||
| 6605 | (funcall gnus-button-man-handler url)) | 6610 | (funcall gnus-button-man-handler url)) |
| 6606 | 6611 | ||
| 6607 | (defun gnus-button-handle-info-url (url) | 6612 | (defun gnus-button-handle-info-url (url) |
diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el index 99e77b18f68..f0a5aa318fd 100644 --- a/lisp/gnus/gnus-cache.el +++ b/lisp/gnus/gnus-cache.el | |||
| @@ -726,6 +726,46 @@ If GROUP is non-nil, also cater to `gnus-cacheable-groups' and | |||
| 726 | (or (not gnus-uncacheable-groups) | 726 | (or (not gnus-uncacheable-groups) |
| 727 | (not (string-match gnus-uncacheable-groups group))))))) | 727 | (not (string-match gnus-uncacheable-groups group))))))) |
| 728 | 728 | ||
| 729 | ;;;###autoload | ||
| 730 | (defun gnus-cache-rename-group (old-group new-group) | ||
| 731 | "Rename OLD-GROUP as NEW-GROUP. Always updates the cache, even when | ||
| 732 | disabled, as the old cache files would corrupt gnus when the cache was | ||
| 733 | next enabled. Depends upon the caller to determine whether group renaming is supported." | ||
| 734 | (let ((old-dir (gnus-cache-file-name old-group "")) | ||
| 735 | (new-dir (gnus-cache-file-name new-group ""))) | ||
| 736 | (gnus-rename-file old-dir new-dir t)) | ||
| 737 | |||
| 738 | (let ((no-save gnus-cache-active-hashtb)) | ||
| 739 | (unless gnus-cache-active-hashtb | ||
| 740 | (gnus-cache-read-active)) | ||
| 741 | (let* ((old-group-hash-value (gnus-gethash old-group gnus-cache-active-hashtb)) | ||
| 742 | (new-group-hash-value (gnus-gethash new-group gnus-cache-active-hashtb)) | ||
| 743 | (delta (or old-group-hash-value new-group-hash-value))) | ||
| 744 | (gnus-sethash new-group old-group-hash-value gnus-cache-active-hashtb) | ||
| 745 | (gnus-sethash old-group nil gnus-cache-active-hashtb) | ||
| 746 | |||
| 747 | (if no-save | ||
| 748 | (setq gnus-cache-active-altered delta) | ||
| 749 | (gnus-cache-write-active delta))))) | ||
| 750 | |||
| 751 | ;;;###autoload | ||
| 752 | (defun gnus-cache-delete-group (group) | ||
| 753 | "Delete GROUP. Always updates the cache, even when | ||
| 754 | disabled, as the old cache files would corrupt gnus when the cache was | ||
| 755 | next enabled. Depends upon the caller to determine whether group deletion is supported." | ||
| 756 | (let ((dir (gnus-cache-file-name group ""))) | ||
| 757 | (gnus-delete-file dir)) | ||
| 758 | |||
| 759 | (let ((no-save gnus-cache-active-hashtb)) | ||
| 760 | (unless gnus-cache-active-hashtb | ||
| 761 | (gnus-cache-read-active)) | ||
| 762 | (let* ((group-hash-value (gnus-gethash group gnus-cache-active-hashtb))) | ||
| 763 | (gnus-sethash group nil gnus-cache-active-hashtb) | ||
| 764 | |||
| 765 | (if no-save | ||
| 766 | (setq gnus-cache-active-altered group-hash-value) | ||
| 767 | (gnus-cache-write-active group-hash-value))))) | ||
| 768 | |||
| 729 | (provide 'gnus-cache) | 769 | (provide 'gnus-cache) |
| 730 | 770 | ||
| 731 | ;;; arch-tag: 05a79442-8c58-4e65-bd0a-3cbb1b89a33a | 771 | ;;; arch-tag: 05a79442-8c58-4e65-bd0a-3cbb1b89a33a |
diff --git a/lisp/gnus/gnus-draft.el b/lisp/gnus/gnus-draft.el index 62deeb4b894..15bb3bc3544 100644 --- a/lisp/gnus/gnus-draft.el +++ b/lisp/gnus/gnus-draft.el | |||
| @@ -132,17 +132,21 @@ | |||
| 132 | 132 | ||
| 133 | (defun gnus-draft-send (article &optional group interactive) | 133 | (defun gnus-draft-send (article &optional group interactive) |
| 134 | "Send message ARTICLE." | 134 | "Send message ARTICLE." |
| 135 | (let ((message-syntax-checks (if interactive message-syntax-checks | 135 | (let* ((is-queue (or (not group) |
| 136 | 'dont-check-for-anything-just-trust-me)) | 136 | (equal group "nndraft:queue"))) |
| 137 | (message-hidden-headers nil) | 137 | (message-syntax-checks (if interactive message-syntax-checks |
| 138 | (message-inhibit-body-encoding (or (not group) | 138 | 'dont-check-for-anything-just-trust-me)) |
| 139 | (equal group "nndraft:queue") | 139 | (message-hidden-headers nil) |
| 140 | message-inhibit-body-encoding)) | 140 | (message-inhibit-body-encoding (or is-queue |
| 141 | (message-send-hook (and group (not (equal group "nndraft:queue")) | 141 | message-inhibit-body-encoding)) |
| 142 | message-send-hook)) | 142 | (message-send-hook (and (not is-queue) |
| 143 | (message-setup-hook (and group (not (equal group "nndraft:queue")) | 143 | message-send-hook)) |
| 144 | message-setup-hook)) | 144 | (message-setup-hook (and (not is-queue) |
| 145 | type method move-to) | 145 | message-setup-hook)) |
| 146 | (gnus-agent-queue-mail (and (not is-queue) | ||
| 147 | gnus-agent-queue-mail)) | ||
| 148 | (rfc2047-encode-encoded-words nil) | ||
| 149 | type method move-to) | ||
| 146 | (gnus-draft-setup article (or group "nndraft:queue")) | 150 | (gnus-draft-setup article (or group "nndraft:queue")) |
| 147 | ;; We read the meta-information that says how and where | 151 | ;; We read the meta-information that says how and where |
| 148 | ;; this message is to be sent. | 152 | ;; this message is to be sent. |
| @@ -196,22 +200,25 @@ | |||
| 196 | (defun gnus-group-send-queue () | 200 | (defun gnus-group-send-queue () |
| 197 | "Send all sendable articles from the queue group." | 201 | "Send all sendable articles from the queue group." |
| 198 | (interactive) | 202 | (interactive) |
| 199 | (gnus-activate-group "nndraft:queue") | 203 | (when (or gnus-plugged |
| 200 | (save-excursion | 204 | (not gnus-agent-prompt-send-queue) |
| 201 | (let* ((articles (nndraft-articles)) | 205 | (gnus-y-or-n-p "Gnus is unplugged; really send queue? ")) |
| 202 | (unsendable (gnus-uncompress-range | 206 | (gnus-activate-group "nndraft:queue") |
| 203 | (cdr (assq 'unsend | 207 | (save-excursion |
| 204 | (gnus-info-marks | 208 | (let* ((articles (nndraft-articles)) |
| 205 | (gnus-get-info "nndraft:queue")))))) | 209 | (unsendable (gnus-uncompress-range |
| 206 | (gnus-posting-styles nil) | 210 | (cdr (assq 'unsend |
| 207 | (total (length articles)) | 211 | (gnus-info-marks |
| 208 | article) | 212 | (gnus-get-info "nndraft:queue")))))) |
| 209 | (while (setq article (pop articles)) | 213 | (gnus-posting-styles nil) |
| 210 | (unless (memq article unsendable) | 214 | (total (length articles)) |
| 211 | (let ((message-sending-message | 215 | article) |
| 212 | (format "Sending message %d of %d..." | 216 | (while (setq article (pop articles)) |
| 213 | (- total (length articles)) total))) | 217 | (unless (memq article unsendable) |
| 214 | (gnus-draft-send article))))))) | 218 | (let ((message-sending-message |
| 219 | (format "Sending message %d of %d..." | ||
| 220 | (- total (length articles)) total))) | ||
| 221 | (gnus-draft-send article)))))))) | ||
| 215 | 222 | ||
| 216 | ;;;###autoload | 223 | ;;;###autoload |
| 217 | (defun gnus-draft-reminder () | 224 | (defun gnus-draft-reminder () |
| @@ -265,12 +272,13 @@ | |||
| 265 | `(lambda (arg) | 272 | `(lambda (arg) |
| 266 | (gnus-post-method arg ,(car ga)))) | 273 | (gnus-post-method arg ,(car ga)))) |
| 267 | (unless (equal (cadr ga) "") | 274 | (unless (equal (cadr ga) "") |
| 268 | (message-add-action | 275 | (dolist (article (cdr ga)) |
| 269 | `(progn | 276 | (message-add-action |
| 270 | (gnus-add-mark ,(car ga) 'replied ,(cadr ga)) | 277 | `(progn |
| 271 | (gnus-request-set-mark ,(car ga) (list (list (list ,(cadr ga)) | 278 | (gnus-add-mark ,(car ga) 'replied ,article) |
| 272 | 'add '(reply))))) | 279 | (gnus-request-set-mark ,(car ga) (list (list (list ,article) |
| 273 | 'send)))))) | 280 | 'add '(reply))))) |
| 281 | 'send))))))) | ||
| 274 | 282 | ||
| 275 | (defun gnus-draft-article-sendable-p (article) | 283 | (defun gnus-draft-article-sendable-p (article) |
| 276 | "Say whether ARTICLE is sendable." | 284 | "Say whether ARTICLE is sendable." |
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 435acb1d6c2..f3b2f91cd5e 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el | |||
| @@ -44,13 +44,13 @@ | |||
| 44 | (eval-when-compile (require 'mm-url)) | 44 | (eval-when-compile (require 'mm-url)) |
| 45 | 45 | ||
| 46 | (defcustom gnus-group-archive-directory | 46 | (defcustom gnus-group-archive-directory |
| 47 | "*ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/" | 47 | "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/" |
| 48 | "*The address of the (ding) archives." | 48 | "*The address of the (ding) archives." |
| 49 | :group 'gnus-group-foreign | 49 | :group 'gnus-group-foreign |
| 50 | :type 'directory) | 50 | :type 'directory) |
| 51 | 51 | ||
| 52 | (defcustom gnus-group-recent-archive-directory | 52 | (defcustom gnus-group-recent-archive-directory |
| 53 | "*ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/" | 53 | "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/" |
| 54 | "*The address of the most recent (ding) articles." | 54 | "*The address of the most recent (ding) articles." |
| 55 | :group 'gnus-group-foreign | 55 | :group 'gnus-group-foreign |
| 56 | :type 'directory) | 56 | :type 'directory) |
| @@ -2283,8 +2283,6 @@ ADDRESS." | |||
| 2283 | (lambda (group) | 2283 | (lambda (group) |
| 2284 | (gnus-group-delete-group group nil t)))))) | 2284 | (gnus-group-delete-group group nil t)))))) |
| 2285 | 2285 | ||
| 2286 | (defvar gnus-cache-active-altered) | ||
| 2287 | |||
| 2288 | (defun gnus-group-delete-group (group &optional force no-prompt) | 2286 | (defun gnus-group-delete-group (group &optional force no-prompt) |
| 2289 | "Delete the current group. Only meaningful with editable groups. | 2287 | "Delete the current group. Only meaningful with editable groups. |
| 2290 | If FORCE (the prefix) is non-nil, all the articles in the group will | 2288 | If FORCE (the prefix) is non-nil, all the articles in the group will |
| @@ -2314,10 +2312,6 @@ be removed from the server, even when it's empty." | |||
| 2314 | (gnus-group-goto-group group) | 2312 | (gnus-group-goto-group group) |
| 2315 | (gnus-group-kill-group 1 t) | 2313 | (gnus-group-kill-group 1 t) |
| 2316 | (gnus-sethash group nil gnus-active-hashtb) | 2314 | (gnus-sethash group nil gnus-active-hashtb) |
| 2317 | (if (boundp 'gnus-cache-active-hashtb) | ||
| 2318 | (when gnus-cache-active-hashtb | ||
| 2319 | (gnus-sethash group nil gnus-cache-active-hashtb) | ||
| 2320 | (setq gnus-cache-active-altered t))) | ||
| 2321 | t)) | 2315 | t)) |
| 2322 | (gnus-group-position-point))) | 2316 | (gnus-group-position-point))) |
| 2323 | 2317 | ||
| @@ -3133,7 +3127,7 @@ or nil if no action could be taken." | |||
| 3133 | (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) | 3127 | (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) |
| 3134 | (num (car entry)) | 3128 | (num (car entry)) |
| 3135 | (marks (nth 3 (nth 2 entry))) | 3129 | (marks (nth 3 (nth 2 entry))) |
| 3136 | (unread (gnus-list-of-unread-articles group))) | 3130 | (unread (gnus-sequence-of-unread-articles group))) |
| 3137 | ;; Remove entries for this group. | 3131 | ;; Remove entries for this group. |
| 3138 | (nnmail-purge-split-history (gnus-group-real-name group)) | 3132 | (nnmail-purge-split-history (gnus-group-real-name group)) |
| 3139 | ;; Do the updating only if the newsgroup isn't killed. | 3133 | ;; Do the updating only if the newsgroup isn't killed. |
| @@ -3146,16 +3140,17 @@ or nil if no action could be taken." | |||
| 3146 | 'del '(tick)) | 3140 | 'del '(tick)) |
| 3147 | (list (cdr (assq 'dormant marks)) | 3141 | (list (cdr (assq 'dormant marks)) |
| 3148 | 'del '(dormant)))) | 3142 | 'del '(dormant)))) |
| 3149 | (setq unread (gnus-uncompress-range | 3143 | (setq unread (gnus-range-add (gnus-range-add |
| 3150 | (gnus-range-add (gnus-range-add | 3144 | unread (cdr (assq 'dormant marks))) |
| 3151 | unread (cdr (assq 'dormant marks))) | 3145 | (cdr (assq 'tick marks)))) |
| 3152 | (cdr (assq 'tick marks))))) | ||
| 3153 | (gnus-add-marked-articles group 'tick nil nil 'force) | 3146 | (gnus-add-marked-articles group 'tick nil nil 'force) |
| 3154 | (gnus-add-marked-articles group 'dormant nil nil 'force)) | 3147 | (gnus-add-marked-articles group 'dormant nil nil 'force)) |
| 3155 | ;; Do auto-expirable marks if that's required. | 3148 | ;; Do auto-expirable marks if that's required. |
| 3156 | (when (gnus-group-auto-expirable-p group) | 3149 | (when (gnus-group-auto-expirable-p group) |
| 3157 | (gnus-add-marked-articles group 'expire unread) | 3150 | (gnus-range-map (lambda (article) |
| 3158 | (gnus-request-set-mark group (list (list unread 'add '(expire))))) | 3151 | (gnus-add-marked-articles group 'expire (list article)) |
| 3152 | (gnus-request-set-mark group (list (list (list article) 'add '(expire))))) | ||
| 3153 | unread)) | ||
| 3159 | (let ((gnus-newsgroup-name group)) | 3154 | (let ((gnus-newsgroup-name group)) |
| 3160 | (gnus-run-hooks 'gnus-group-catchup-group-hook)) | 3155 | (gnus-run-hooks 'gnus-group-catchup-group-hook)) |
| 3161 | num))) | 3156 | num))) |
| @@ -3517,7 +3512,7 @@ entail asking the server for the groups." | |||
| 3517 | ;; First we make sure that we have really read the active file. | 3512 | ;; First we make sure that we have really read the active file. |
| 3518 | (unless (gnus-read-active-file-p) | 3513 | (unless (gnus-read-active-file-p) |
| 3519 | (let ((gnus-read-active-file t) | 3514 | (let ((gnus-read-active-file t) |
| 3520 | (gnus-agent nil)) ; Trick the agent into ignoring the active file. | 3515 | (gnus-agent gnus-plugged)); If we're actually plugged, store the active file in the agent. |
| 3521 | (gnus-read-active-file))) | 3516 | (gnus-read-active-file))) |
| 3522 | ;; Find all groups and sort them. | 3517 | ;; Find all groups and sort them. |
| 3523 | (let ((groups | 3518 | (let ((groups |
| @@ -3599,7 +3594,8 @@ re-scanning. If ARG is non-nil and not a number, this will force | |||
| 3599 | (defun gnus-group-get-new-news-this-group (&optional n dont-scan) | 3594 | (defun gnus-group-get-new-news-this-group (&optional n dont-scan) |
| 3600 | "Check for newly arrived news in the current group (and the N-1 next groups). | 3595 | "Check for newly arrived news in the current group (and the N-1 next groups). |
| 3601 | The difference between N and the number of newsgroup checked is returned. | 3596 | The difference between N and the number of newsgroup checked is returned. |
| 3602 | If N is negative, this group and the N-1 previous groups will be checked." | 3597 | If N is negative, this group and the N-1 previous groups will be checked. |
| 3598 | If DONT-SCAN is non-nil, scan non-activated groups as well." | ||
| 3603 | (interactive "P") | 3599 | (interactive "P") |
| 3604 | (let* ((groups (gnus-group-process-prefix n)) | 3600 | (let* ((groups (gnus-group-process-prefix n)) |
| 3605 | (ret (if (numberp n) (- n (length groups)) 0)) | 3601 | (ret (if (numberp n) (- n (length groups)) 0)) |
diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el index 2363c2705cb..7382fa7a090 100644 --- a/lisp/gnus/gnus-int.el +++ b/lisp/gnus/gnus-int.el | |||
| @@ -33,6 +33,7 @@ | |||
| 33 | (require 'gnus-range) | 33 | (require 'gnus-range) |
| 34 | 34 | ||
| 35 | (autoload 'gnus-agent-expire "gnus-agent") | 35 | (autoload 'gnus-agent-expire "gnus-agent") |
| 36 | (autoload 'gnus-agent-regenerate-group "gnus-agent") | ||
| 36 | (autoload 'gnus-agent-read-servers-validate-native "gnus-agent") | 37 | (autoload 'gnus-agent-read-servers-validate-native "gnus-agent") |
| 37 | 38 | ||
| 38 | (defcustom gnus-open-server-hook nil | 39 | (defcustom gnus-open-server-hook nil |
| @@ -176,7 +177,7 @@ If it is down, start it up (again)." | |||
| 176 | (setq method (gnus-server-to-method method))) | 177 | (setq method (gnus-server-to-method method))) |
| 177 | ;; Check cache of constructed names. | 178 | ;; Check cache of constructed names. |
| 178 | (let* ((method-sym (if gnus-agent | 179 | (let* ((method-sym (if gnus-agent |
| 179 | (gnus-agent-get-function method) | 180 | (inline (gnus-agent-get-function method)) |
| 180 | (car method))) | 181 | (car method))) |
| 181 | (method-fns (get method-sym 'gnus-method-functions)) | 182 | (method-fns (get method-sym 'gnus-method-functions)) |
| 182 | (func (let ((method-fnlist-elt (assq function method-fns))) | 183 | (func (let ((method-fnlist-elt (assq function method-fns))) |
| @@ -570,7 +571,7 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned." | |||
| 570 | (nth 1 gnus-command-method) accept-function last))) | 571 | (nth 1 gnus-command-method) accept-function last))) |
| 571 | (when (and result gnus-agent | 572 | (when (and result gnus-agent |
| 572 | (gnus-agent-method-p gnus-command-method)) | 573 | (gnus-agent-method-p gnus-command-method)) |
| 573 | (gnus-agent-expire (list article) group 'force)) | 574 | (gnus-agent-unfetch-articles group (list article))) |
| 574 | result)) | 575 | result)) |
| 575 | 576 | ||
| 576 | (defun gnus-request-accept-article (group &optional gnus-command-method last | 577 | (defun gnus-request-accept-article (group &optional gnus-command-method last |
| @@ -580,7 +581,8 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned." | |||
| 580 | (setq gnus-command-method (gnus-server-to-method gnus-command-method))) | 581 | (setq gnus-command-method (gnus-server-to-method gnus-command-method))) |
| 581 | (when (and (not gnus-command-method) | 582 | (when (and (not gnus-command-method) |
| 582 | (stringp group)) | 583 | (stringp group)) |
| 583 | (setq gnus-command-method (gnus-group-name-to-method group))) | 584 | (setq gnus-command-method (or (gnus-find-method-for-group group) |
| 585 | (gnus-group-name-to-method group)))) | ||
| 584 | (goto-char (point-max)) | 586 | (goto-char (point-max)) |
| 585 | (unless (bolp) | 587 | (unless (bolp) |
| 586 | (insert "\n")) | 588 | (insert "\n")) |
| @@ -592,12 +594,17 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned." | |||
| 592 | (let ((mail-parse-charset message-default-charset)) | 594 | (let ((mail-parse-charset message-default-charset)) |
| 593 | (mail-encode-encoded-word-buffer))) | 595 | (mail-encode-encoded-word-buffer))) |
| 594 | (message-encode-message-body))) | 596 | (message-encode-message-body))) |
| 595 | (let ((gnus-command-method (or gnus-command-method | 597 | (let ((gnus-command-method (or gnus-command-method |
| 596 | (gnus-find-method-for-group group)))) | 598 | (gnus-find-method-for-group group))) |
| 597 | (funcall (gnus-get-function gnus-command-method 'request-accept-article) | 599 | (result |
| 598 | (if (stringp group) (gnus-group-real-name group) group) | 600 | (funcall |
| 599 | (cadr gnus-command-method) | 601 | (gnus-get-function gnus-command-method 'request-accept-article) |
| 600 | last))) | 602 | (if (stringp group) (gnus-group-real-name group) group) |
| 603 | (cadr gnus-command-method) | ||
| 604 | last))) | ||
| 605 | (when (and gnus-agent (gnus-agent-method-p gnus-command-method)) | ||
| 606 | (gnus-agent-regenerate-group group (list (cdr result)))) | ||
| 607 | result)) | ||
| 601 | 608 | ||
| 602 | (defun gnus-request-replace-article (article group buffer &optional no-encode) | 609 | (defun gnus-request-replace-article (article group buffer &optional no-encode) |
| 603 | (unless no-encode | 610 | (unless no-encode |
| @@ -608,9 +615,12 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned." | |||
| 608 | (let ((mail-parse-charset message-default-charset)) | 615 | (let ((mail-parse-charset message-default-charset)) |
| 609 | (mail-encode-encoded-word-buffer))) | 616 | (mail-encode-encoded-word-buffer))) |
| 610 | (message-encode-message-body))) | 617 | (message-encode-message-body))) |
| 611 | (let ((func (car (gnus-group-name-to-method group)))) | 618 | (let* ((func (car (gnus-group-name-to-method group))) |
| 612 | (funcall (intern (format "%s-request-replace-article" func)) | 619 | (result (funcall (intern (format "%s-request-replace-article" func)) |
| 613 | article (gnus-group-real-name group) buffer))) | 620 | article (gnus-group-real-name group) buffer))) |
| 621 | (when (and gnus-agent (gnus-agent-method-p gnus-command-method)) | ||
| 622 | (gnus-agent-regenerate-group group (list article))) | ||
| 623 | result)) | ||
| 614 | 624 | ||
| 615 | (defun gnus-request-associate-buffer (group) | 625 | (defun gnus-request-associate-buffer (group) |
| 616 | (let ((gnus-command-method (gnus-find-method-for-group group))) | 626 | (let ((gnus-command-method (gnus-find-method-for-group group))) |
| @@ -633,15 +643,25 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned." | |||
| 633 | (gnus-group-real-name group) (nth 1 gnus-command-method) args))) | 643 | (gnus-group-real-name group) (nth 1 gnus-command-method) args))) |
| 634 | 644 | ||
| 635 | (defun gnus-request-delete-group (group &optional force) | 645 | (defun gnus-request-delete-group (group &optional force) |
| 636 | (let ((gnus-command-method (gnus-find-method-for-group group))) | 646 | (let* ((gnus-command-method (gnus-find-method-for-group group)) |
| 637 | (funcall (gnus-get-function gnus-command-method 'request-delete-group) | 647 | (result |
| 638 | (gnus-group-real-name group) force (nth 1 gnus-command-method)))) | 648 | (funcall (gnus-get-function gnus-command-method 'request-delete-group) |
| 649 | (gnus-group-real-name group) force (nth 1 gnus-command-method)))) | ||
| 650 | (when result | ||
| 651 | (gnus-cache-delete-group group) | ||
| 652 | (gnus-agent-delete-group group)) | ||
| 653 | result)) | ||
| 639 | 654 | ||
| 640 | (defun gnus-request-rename-group (group new-name) | 655 | (defun gnus-request-rename-group (group new-name) |
| 641 | (let ((gnus-command-method (gnus-find-method-for-group group))) | 656 | (let* ((gnus-command-method (gnus-find-method-for-group group)) |
| 642 | (funcall (gnus-get-function gnus-command-method 'request-rename-group) | 657 | (result |
| 643 | (gnus-group-real-name group) | 658 | (funcall (gnus-get-function gnus-command-method 'request-rename-group) |
| 644 | (gnus-group-real-name new-name) (nth 1 gnus-command-method)))) | 659 | (gnus-group-real-name group) |
| 660 | (gnus-group-real-name new-name) (nth 1 gnus-command-method)))) | ||
| 661 | (when result | ||
| 662 | (gnus-cache-rename-group group new-name) | ||
| 663 | (gnus-agent-rename-group group new-name)) | ||
| 664 | result)) | ||
| 645 | 665 | ||
| 646 | (defun gnus-close-backends () | 666 | (defun gnus-close-backends () |
| 647 | ;; Send a close request to all backends that support such a request. | 667 | ;; Send a close request to all backends that support such a request. |
diff --git a/lisp/gnus/gnus-range.el b/lisp/gnus/gnus-range.el index 56a1b569418..d2442c63a42 100644 --- a/lisp/gnus/gnus-range.el +++ b/lisp/gnus/gnus-range.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; gnus-range.el --- range and sequence functions for Gnus | 1 | ;;; gnus-range.el --- range and sequence functions for Gnus |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 | 3 | ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2004 |
| 4 | ;; Free Software Foundation, Inc. | 4 | ;; Free Software Foundation, Inc. |
| 5 | 5 | ||
| 6 | ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> | 6 | ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
| @@ -184,6 +184,58 @@ LIST1 and LIST2 have to be sorted over <." | |||
| 184 | (nreverse out))) | 184 | (nreverse out))) |
| 185 | 185 | ||
| 186 | ;;;###autoload | 186 | ;;;###autoload |
| 187 | (defun gnus-sorted-range-intersection (range1 range2) | ||
| 188 | "Return intersection of RANGE1 and RANGE2. | ||
| 189 | RANGE1 and RANGE2 have to be sorted over <." | ||
| 190 | (let* (out | ||
| 191 | (min1 (car range1)) | ||
| 192 | (max1 (if (numberp min1) | ||
| 193 | (if (numberp (cdr range1)) | ||
| 194 | (prog1 (cdr range1) | ||
| 195 | (setq range1 nil)) min1) | ||
| 196 | (prog1 (cdr min1) | ||
| 197 | (setq min1 (car min1))))) | ||
| 198 | (min2 (car range2)) | ||
| 199 | (max2 (if (numberp min2) | ||
| 200 | (if (numberp (cdr range2)) | ||
| 201 | (prog1 (cdr range2) | ||
| 202 | (setq range2 nil)) min2) | ||
| 203 | (prog1 (cdr min2) | ||
| 204 | (setq min2 (car min2)))))) | ||
| 205 | (setq range1 (cdr range1) | ||
| 206 | range2 (cdr range2)) | ||
| 207 | (while (and min1 min2) | ||
| 208 | (cond ((< max1 min2) ; range1 preceeds range2 | ||
| 209 | (setq range1 (cdr range1) | ||
| 210 | min1 nil)) | ||
| 211 | ((< max2 min1) ; range2 preceeds range1 | ||
| 212 | (setq range2 (cdr range2) | ||
| 213 | min2 nil)) | ||
| 214 | (t ; some sort of overlap is occurring | ||
| 215 | (let ((min (max min1 min2)) | ||
| 216 | (max (min max1 max2))) | ||
| 217 | (setq out (if (= min max) | ||
| 218 | (cons min out) | ||
| 219 | (cons (cons min max) out)))) | ||
| 220 | (if (< max1 max2) ; range1 ends before range2 | ||
| 221 | (setq min1 nil) ; incr range1 | ||
| 222 | (setq min2 nil)))) ; incr range2 | ||
| 223 | (unless min1 | ||
| 224 | (setq min1 (car range1) | ||
| 225 | max1 (if (numberp min1) min1 (prog1 (cdr min1) (setq min1 (car min1)))) | ||
| 226 | range1 (cdr range1))) | ||
| 227 | (unless min2 | ||
| 228 | (setq min2 (car range2) | ||
| 229 | max2 (if (numberp min2) min2 (prog1 (cdr min2) (setq min2 (car min2)))) | ||
| 230 | range2 (cdr range2)))) | ||
| 231 | (cond ((cdr out) | ||
| 232 | (nreverse out)) | ||
| 233 | ((numberp (car out)) | ||
| 234 | out) | ||
| 235 | (t | ||
| 236 | (car out))))) | ||
| 237 | |||
| 238 | ;;;###autoload | ||
| 187 | (defalias 'gnus-set-sorted-intersection 'gnus-sorted-nintersection) | 239 | (defalias 'gnus-set-sorted-intersection 'gnus-sorted-nintersection) |
| 188 | 240 | ||
| 189 | ;;;###autoload | 241 | ;;;###autoload |
| @@ -589,6 +641,19 @@ LIST is a sorted list." | |||
| 589 | (setcdr prev (cons num list))) | 641 | (setcdr prev (cons num list))) |
| 590 | (cdr top))) | 642 | (cdr top))) |
| 591 | 643 | ||
| 644 | (defun gnus-range-map (func range) | ||
| 645 | "Apply FUNC to each value contained by RANGE." | ||
| 646 | (setq range (gnus-range-normalize range)) | ||
| 647 | (while range | ||
| 648 | (let ((span (pop range))) | ||
| 649 | (if (numberp span) | ||
| 650 | (funcall func span) | ||
| 651 | (let ((first (car span)) | ||
| 652 | (last (cdr span))) | ||
| 653 | (while (<= first last) | ||
| 654 | (funcall func first) | ||
| 655 | (setq first (1+ first)))))))) | ||
| 656 | |||
| 592 | (provide 'gnus-range) | 657 | (provide 'gnus-range) |
| 593 | 658 | ||
| 594 | ;;; arch-tag: 4780bdd8-5a15-4aff-be28-18727895b6ad | 659 | ;;; arch-tag: 4780bdd8-5a15-4aff-be28-18727895b6ad |
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index 33238ef4552..841f0057566 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el | |||
| @@ -693,6 +693,8 @@ Returns the first place where the trail finds a group name." | |||
| 693 | 693 | ||
| 694 | (remove-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids)) | 694 | (remove-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids)) |
| 695 | 695 | ||
| 696 | (add-hook 'gnus-registry-unload-hook 'gnus-registry-unload-hook) | ||
| 697 | |||
| 696 | (when gnus-registry-install | 698 | (when gnus-registry-install |
| 697 | (gnus-registry-install-hooks) | 699 | (gnus-registry-install-hooks) |
| 698 | (gnus-registry-read)) | 700 | (gnus-registry-read)) |
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index 18641b3a37f..dda03b864b1 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el | |||
| @@ -1,5 +1,5 @@ | |||
| 1 | ;;; gnus-start.el --- startup functions for Gnus | 1 | ;;; gnus-start.el --- startup functions for Gnus |
| 2 | ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 | 2 | ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 |
| 3 | ;; Free Software Foundation, Inc. | 3 | ;; Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> | 5 | ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
| @@ -34,8 +34,15 @@ | |||
| 34 | (require 'gnus-util) | 34 | (require 'gnus-util) |
| 35 | (autoload 'message-make-date "message") | 35 | (autoload 'message-make-date "message") |
| 36 | (autoload 'gnus-agent-read-servers-validate "gnus-agent") | 36 | (autoload 'gnus-agent-read-servers-validate "gnus-agent") |
| 37 | (autoload 'gnus-agent-save-local "gnus-agent") | ||
| 37 | (autoload 'gnus-agent-possibly-alter-active "gnus-agent") | 38 | (autoload 'gnus-agent-possibly-alter-active "gnus-agent") |
| 38 | (eval-when-compile (require 'cl)) | 39 | |
| 40 | (eval-when-compile | ||
| 41 | (require 'cl) | ||
| 42 | |||
| 43 | (defvar gnus-agent-covered-methods nil) | ||
| 44 | (defvar gnus-agent-file-loading-local nil) | ||
| 45 | (defvar gnus-agent-file-loading-cache nil)) | ||
| 39 | 46 | ||
| 40 | (defcustom gnus-startup-file (nnheader-concat gnus-home-directory ".newsrc") | 47 | (defcustom gnus-startup-file (nnheader-concat gnus-home-directory ".newsrc") |
| 41 | "Your `.newsrc' file. | 48 | "Your `.newsrc' file. |
| @@ -665,6 +672,8 @@ the first newsgroup." | |||
| 665 | (setq gnus-list-of-killed-groups nil | 672 | (setq gnus-list-of-killed-groups nil |
| 666 | gnus-have-read-active-file nil | 673 | gnus-have-read-active-file nil |
| 667 | gnus-agent-covered-methods nil | 674 | gnus-agent-covered-methods nil |
| 675 | gnus-agent-file-loading-local nil | ||
| 676 | gnus-agent-file-loading-cache nil | ||
| 668 | gnus-server-method-cache nil | 677 | gnus-server-method-cache nil |
| 669 | gnus-newsrc-alist nil | 678 | gnus-newsrc-alist nil |
| 670 | gnus-newsrc-hashtb nil | 679 | gnus-newsrc-hashtb nil |
| @@ -1481,8 +1490,8 @@ newsgroup." | |||
| 1481 | (setcdr active (cdr cache-active)))))))) | 1490 | (setcdr active (cdr cache-active)))))))) |
| 1482 | 1491 | ||
| 1483 | (defun gnus-activate-group (group &optional scan dont-check method) | 1492 | (defun gnus-activate-group (group &optional scan dont-check method) |
| 1484 | ;; Check whether a group has been activated or not. | 1493 | "Check whether a group has been activated or not. |
| 1485 | ;; If SCAN, request a scan of that group as well. | 1494 | If SCAN, request a scan of that group as well." |
| 1486 | (let ((method (or method (inline (gnus-find-method-for-group group)))) | 1495 | (let ((method (or method (inline (gnus-find-method-for-group group)))) |
| 1487 | active) | 1496 | active) |
| 1488 | (and (inline (gnus-check-server method)) | 1497 | (and (inline (gnus-check-server method)) |
| @@ -1513,12 +1522,21 @@ newsgroup." | |||
| 1513 | (gnus-active group)) | 1522 | (gnus-active group)) |
| 1514 | (gnus-active group) | 1523 | (gnus-active group) |
| 1515 | 1524 | ||
| 1525 | ;; If a cache is present, we may have to alter the active info. | ||
| 1526 | (when gnus-use-cache | ||
| 1527 | (inline (gnus-cache-possibly-alter-active | ||
| 1528 | group active))) | ||
| 1529 | |||
| 1530 | ;; If the agent is enabled, we may have to alter the active info. | ||
| 1531 | (when gnus-agent | ||
| 1532 | (gnus-agent-possibly-alter-active group active)) | ||
| 1533 | |||
| 1516 | (gnus-set-active group active) | 1534 | (gnus-set-active group active) |
| 1517 | ;; Return the new active info. | 1535 | ;; Return the new active info. |
| 1518 | active))))) | 1536 | active))))) |
| 1519 | 1537 | ||
| 1520 | (defun gnus-get-unread-articles-in-group (info active &optional update) | 1538 | (defun gnus-get-unread-articles-in-group (info active &optional update) |
| 1521 | (when active | 1539 | (when (and info active) |
| 1522 | ;; Allow the backend to update the info in the group. | 1540 | ;; Allow the backend to update the info in the group. |
| 1523 | (when (and update | 1541 | (when (and update |
| 1524 | (gnus-request-update-info | 1542 | (gnus-request-update-info |
| @@ -1528,6 +1546,10 @@ newsgroup." | |||
| 1528 | 1546 | ||
| 1529 | (let* ((range (gnus-info-read info)) | 1547 | (let* ((range (gnus-info-read info)) |
| 1530 | (num 0)) | 1548 | (num 0)) |
| 1549 | |||
| 1550 | ;; These checks are present in gnus-activate-group but skipped | ||
| 1551 | ;; due to setting dont-check in the preceeding call. | ||
| 1552 | |||
| 1531 | ;; If a cache is present, we may have to alter the active info. | 1553 | ;; If a cache is present, we may have to alter the active info. |
| 1532 | (when (and gnus-use-cache info) | 1554 | (when (and gnus-use-cache info) |
| 1533 | (inline (gnus-cache-possibly-alter-active | 1555 | (inline (gnus-cache-possibly-alter-active |
| @@ -1535,8 +1557,7 @@ newsgroup." | |||
| 1535 | 1557 | ||
| 1536 | ;; If the agent is enabled, we may have to alter the active info. | 1558 | ;; If the agent is enabled, we may have to alter the active info. |
| 1537 | (when (and gnus-agent info) | 1559 | (when (and gnus-agent info) |
| 1538 | (gnus-agent-possibly-alter-active | 1560 | (gnus-agent-possibly-alter-active (gnus-info-group info) active info)) |
| 1539 | (gnus-info-group info) active)) | ||
| 1540 | 1561 | ||
| 1541 | ;; Modify the list of read articles according to what articles | 1562 | ;; Modify the list of read articles according to what articles |
| 1542 | ;; are available; then tally the unread articles and add the | 1563 | ;; are available; then tally the unread articles and add the |
| @@ -1632,7 +1653,7 @@ newsgroup." | |||
| 1632 | 1653 | ||
| 1633 | (while newsrc | 1654 | (while newsrc |
| 1634 | (setq active (gnus-active (setq group (gnus-info-group | 1655 | (setq active (gnus-active (setq group (gnus-info-group |
| 1635 | (setq info (pop newsrc)))))) | 1656 | (setq info (pop newsrc)))))) |
| 1636 | 1657 | ||
| 1637 | ;; Check newsgroups. If the user doesn't want to check them, or | 1658 | ;; Check newsgroups. If the user doesn't want to check them, or |
| 1638 | ;; they can't be checked (for instance, if the news server can't | 1659 | ;; they can't be checked (for instance, if the news server can't |
| @@ -1655,61 +1676,60 @@ newsgroup." | |||
| 1655 | (when (and method | 1676 | (when (and method |
| 1656 | (not (setq method-type (cdr (assoc method type-cache))))) | 1677 | (not (setq method-type (cdr (assoc method type-cache))))) |
| 1657 | (setq method-type | 1678 | (setq method-type |
| 1658 | (cond | 1679 | (cond |
| 1659 | ((gnus-secondary-method-p method) | 1680 | ((gnus-secondary-method-p method) |
| 1660 | 'secondary) | 1681 | 'secondary) |
| 1661 | ((inline (gnus-server-equal gnus-select-method method)) | 1682 | ((inline (gnus-server-equal gnus-select-method method)) |
| 1662 | 'primary) | 1683 | 'primary) |
| 1663 | (t | 1684 | (t |
| 1664 | 'foreign))) | 1685 | 'foreign))) |
| 1665 | (push (cons method method-type) type-cache)) | 1686 | (push (cons method method-type) type-cache)) |
| 1666 | (if (and method | 1687 | |
| 1667 | (eq method-type 'foreign)) | 1688 | (cond ((and method (eq method-type 'foreign)) |
| 1668 | ;; These groups are foreign. Check the level. | 1689 | ;; These groups are foreign. Check the level. |
| 1669 | (when (and (<= (gnus-info-level info) foreign-level) | 1690 | (when (and (<= (gnus-info-level info) foreign-level) |
| 1670 | (setq active (gnus-activate-group group 'scan))) | 1691 | (setq active (gnus-activate-group group 'scan))) |
| 1671 | ;; Let the Gnus agent save the active file. | 1692 | ;; Let the Gnus agent save the active file. |
| 1672 | (when (and gnus-agent active (gnus-online method)) | 1693 | (when (and gnus-agent active (gnus-online method)) |
| 1673 | (gnus-agent-save-group-info | 1694 | (gnus-agent-save-group-info |
| 1674 | method (gnus-group-real-name group) active)) | 1695 | method (gnus-group-real-name group) active)) |
| 1675 | (unless (inline (gnus-virtual-group-p group)) | 1696 | (unless (inline (gnus-virtual-group-p group)) |
| 1676 | (inline (gnus-close-group group))) | 1697 | (inline (gnus-close-group group))) |
| 1677 | (when (fboundp (intern (concat (symbol-name (car method)) | 1698 | (when (fboundp (intern (concat (symbol-name (car method)) |
| 1678 | "-request-update-info"))) | 1699 | "-request-update-info"))) |
| 1679 | (inline (gnus-request-update-info info method)))) | 1700 | (inline (gnus-request-update-info info method))))) |
| 1680 | ;; These groups are native or secondary. | 1701 | ;; These groups are native or secondary. |
| 1681 | (cond | 1702 | ((> (gnus-info-level info) level) |
| 1682 | ;; We don't want these groups. | 1703 | ;; We don't want these groups. |
| 1683 | ((> (gnus-info-level info) level) | 1704 | (setq active 'ignore)) |
| 1684 | (setq active 'ignore)) | 1705 | ;; Activate groups. |
| 1685 | ;; Activate groups. | 1706 | ((not gnus-read-active-file) |
| 1686 | ((not gnus-read-active-file) | 1707 | (if (gnus-check-backend-function 'retrieve-groups group) |
| 1687 | (if (gnus-check-backend-function 'retrieve-groups group) | 1708 | ;; if server support gnus-retrieve-groups we push |
| 1688 | ;; if server support gnus-retrieve-groups we push | 1709 | ;; the group onto retrievegroups for later checking |
| 1689 | ;; the group onto retrievegroups for later checking | 1710 | (if (assoc method retrieve-groups) |
| 1690 | (if (assoc method retrieve-groups) | 1711 | (setcdr (assoc method retrieve-groups) |
| 1691 | (setcdr (assoc method retrieve-groups) | 1712 | (cons group (cdr (assoc method retrieve-groups)))) |
| 1692 | (cons group (cdr (assoc method retrieve-groups)))) | 1713 | (push (list method group) retrieve-groups)) |
| 1693 | (push (list method group) retrieve-groups)) | 1714 | ;; hack: `nnmail-get-new-mail' changes the mail-source depending |
| 1694 | ;; hack: `nnmail-get-new-mail' changes the mail-source depending | 1715 | ;; on the group, so we must perform a scan for every group |
| 1695 | ;; on the group, so we must perform a scan for every group | 1716 | ;; if the users has any directory mail sources. |
| 1696 | ;; if the users has any directory mail sources. | 1717 | ;; hack: if `nnmail-scan-directory-mail-source-once' is non-nil, |
| 1697 | ;; hack: if `nnmail-scan-directory-mail-source-once' is non-nil, | 1718 | ;; for it scan all spool files even when the groups are |
| 1698 | ;; for it scan all spool files even when the groups are | 1719 | ;; not required. |
| 1699 | ;; not required. | 1720 | (if (and |
| 1700 | (if (and | 1721 | (or nnmail-scan-directory-mail-source-once |
| 1701 | (or nnmail-scan-directory-mail-source-once | 1722 | (null (assq 'directory |
| 1702 | (null (assq 'directory | 1723 | (or mail-sources |
| 1703 | (or mail-sources | 1724 | (if (listp nnmail-spool-file) |
| 1704 | (if (listp nnmail-spool-file) | 1725 | nnmail-spool-file |
| 1705 | nnmail-spool-file | 1726 | (list nnmail-spool-file)))))) |
| 1706 | (list nnmail-spool-file)))))) | 1727 | (member method scanned-methods)) |
| 1707 | (member method scanned-methods)) | 1728 | (setq active (gnus-activate-group group)) |
| 1708 | (setq active (gnus-activate-group group)) | 1729 | (setq active (gnus-activate-group group 'scan)) |
| 1709 | (setq active (gnus-activate-group group 'scan)) | 1730 | (push method scanned-methods)) |
| 1710 | (push method scanned-methods)) | 1731 | (when active |
| 1711 | (when active | 1732 | (gnus-close-group group))))) |
| 1712 | (gnus-close-group group)))))) | ||
| 1713 | 1733 | ||
| 1714 | ;; Get the number of unread articles in the group. | 1734 | ;; Get the number of unread articles in the group. |
| 1715 | (cond | 1735 | (cond |
| @@ -1736,8 +1756,8 @@ newsgroup." | |||
| 1736 | (when (gnus-check-backend-function 'request-scan (car method)) | 1756 | (when (gnus-check-backend-function 'request-scan (car method)) |
| 1737 | (gnus-request-scan nil method)) | 1757 | (gnus-request-scan nil method)) |
| 1738 | (gnus-read-active-file-2 | 1758 | (gnus-read-active-file-2 |
| 1739 | (mapcar (lambda (group) (gnus-group-real-name group)) groups) | 1759 | (mapcar (lambda (group) (gnus-group-real-name group)) groups) |
| 1740 | method) | 1760 | method) |
| 1741 | (dolist (group groups) | 1761 | (dolist (group groups) |
| 1742 | (cond | 1762 | (cond |
| 1743 | ((setq active (gnus-active (gnus-info-group | 1763 | ((setq active (gnus-active (gnus-info-group |
| @@ -1982,10 +2002,10 @@ newsgroup." | |||
| 1982 | (while (setq info (pop newsrc)) | 2002 | (while (setq info (pop newsrc)) |
| 1983 | (when (inline | 2003 | (when (inline |
| 1984 | (gnus-server-equal | 2004 | (gnus-server-equal |
| 1985 | (inline | 2005 | (inline |
| 1986 | (gnus-find-method-for-group | 2006 | (gnus-find-method-for-group |
| 1987 | (gnus-info-group info) info)) | 2007 | (gnus-info-group info) info)) |
| 1988 | gmethod)) | 2008 | gmethod)) |
| 1989 | (push (gnus-group-real-name (gnus-info-group info)) | 2009 | (push (gnus-group-real-name (gnus-info-group info)) |
| 1990 | groups))) | 2010 | groups))) |
| 1991 | (gnus-read-active-file-2 groups method))) | 2011 | (gnus-read-active-file-2 groups method))) |
| @@ -2129,7 +2149,7 @@ newsgroup." | |||
| 2129 | (gnus-online method) | 2149 | (gnus-online method) |
| 2130 | (gnus-agent-method-p method)) | 2150 | (gnus-agent-method-p method)) |
| 2131 | (progn | 2151 | (progn |
| 2132 | (gnus-agent-save-groups method) | 2152 | (gnus-agent-save-active method) |
| 2133 | (gnus-active-to-gnus-format method hashtb nil real-active)) | 2153 | (gnus-active-to-gnus-format method hashtb nil real-active)) |
| 2134 | 2154 | ||
| 2135 | (goto-char (point-min)) | 2155 | (goto-char (point-min)) |
| @@ -2205,17 +2225,94 @@ If FORCE is non-nil, the .newsrc file is read." | |||
| 2205 | (gnus-convert-old-newsrc)))) | 2225 | (gnus-convert-old-newsrc)))) |
| 2206 | 2226 | ||
| 2207 | (defun gnus-convert-old-newsrc () | 2227 | (defun gnus-convert-old-newsrc () |
| 2208 | "Convert old newsrc into the new format, if needed." | 2228 | "Convert old newsrc formats into the current format, if needed." |
| 2209 | (let ((fcv (and gnus-newsrc-file-version | 2229 | (let ((fcv (and gnus-newsrc-file-version |
| 2210 | (gnus-continuum-version gnus-newsrc-file-version)))) | 2230 | (gnus-continuum-version gnus-newsrc-file-version)))) |
| 2211 | (cond | 2231 | (when fcv |
| 2212 | ;; No .newsrc.eld file was loaded. | 2232 | ;; A newsrc file was loaded. |
| 2213 | ((null fcv) nil) | 2233 | (let (prompt-displayed |
| 2214 | ;; Gnus 5 .newsrc.eld was loaded. | 2234 | (converters |
| 2215 | ((< fcv (gnus-continuum-version "September Gnus v0.1")) | 2235 | (sort |
| 2216 | (gnus-convert-old-ticks))))) | 2236 | (mapcar (lambda (date-func) |
| 2217 | 2237 | (cons (gnus-continuum-version (car date-func)) | |
| 2218 | (defun gnus-convert-old-ticks () | 2238 | date-func)) |
| 2239 | ;; This is a list of converters that must be run | ||
| 2240 | ;; to bring the newsrc file up to the current | ||
| 2241 | ;; version. If you create an incompatibility | ||
| 2242 | ;; with older versions, you should create an | ||
| 2243 | ;; entry here. The entry should consist of the | ||
| 2244 | ;; current gnus version (hardcoded so that it | ||
| 2245 | ;; doesn't change with each release) and the | ||
| 2246 | ;; function that must be applied to convert the | ||
| 2247 | ;; previous version into the current version. | ||
| 2248 | '(("September Gnus v0.1" nil | ||
| 2249 | gnus-convert-old-ticks) | ||
| 2250 | ("Oort Gnus v0.08" "legacy-gnus-agent" | ||
| 2251 | gnus-agent-convert-to-compressed-agentview) | ||
| 2252 | ("Gnus v5.11" "legacy-gnus-agent" | ||
| 2253 | gnus-agent-unlist-expire-days) | ||
| 2254 | ("Gnus v5.11" "legacy-gnus-agent" | ||
| 2255 | gnus-agent-unhook-expire-days))) | ||
| 2256 | #'car-less-than-car))) | ||
| 2257 | ;; Skip converters older than the file version | ||
| 2258 | (while (and converters (>= fcv (caar converters))) | ||
| 2259 | (pop converters)) | ||
| 2260 | |||
| 2261 | ;; Perform converters to bring older version up to date. | ||
| 2262 | (when (and converters (< fcv (caar converters))) | ||
| 2263 | (while (and converters (< fcv (caar converters)) | ||
| 2264 | (<= (caar converters) gnus-version)) | ||
| 2265 | (let* ((converter-spec (pop converters)) | ||
| 2266 | (convert-to (nth 1 converter-spec)) | ||
| 2267 | (load-from (nth 2 converter-spec)) | ||
| 2268 | (func (nth 3 converter-spec))) | ||
| 2269 | (when (and load-from | ||
| 2270 | (not (fboundp func))) | ||
| 2271 | (load load-from t)) | ||
| 2272 | |||
| 2273 | (or prompt-displayed | ||
| 2274 | (not (gnus-convert-converter-needs-prompt func)) | ||
| 2275 | (while (let (c | ||
| 2276 | (cursor-in-echo-area t) | ||
| 2277 | (echo-keystrokes 0)) | ||
| 2278 | (message "Convert gnus from version '%s' to '%s'? (n/y/?)" | ||
| 2279 | gnus-newsrc-file-version gnus-version) | ||
| 2280 | (setq c (read-char-exclusive)) | ||
| 2281 | |||
| 2282 | (cond ((or (eq c ?n) (eq c ?N)) | ||
| 2283 | (error "Can not start gnus without converting")) | ||
| 2284 | ((or (eq c ?y) (eq c ?Y)) | ||
| 2285 | (setq prompt-displayed t) | ||
| 2286 | nil) | ||
| 2287 | ((eq c ?\?) | ||
| 2288 | (message "This conversion is irreversible. \ | ||
| 2289 | To be safe, you should backup your files before proceeding.") | ||
| 2290 | (sit-for 5) | ||
| 2291 | t) | ||
| 2292 | (t | ||
| 2293 | (gnus-message 3 "Ignoring unexpected input") | ||
| 2294 | (sit-for 3) | ||
| 2295 | t))))) | ||
| 2296 | |||
| 2297 | (funcall func convert-to))) | ||
| 2298 | (gnus-dribble-enter | ||
| 2299 | (format ";Converted gnus from version '%s' to '%s'." | ||
| 2300 | gnus-newsrc-file-version gnus-version))))))) | ||
| 2301 | |||
| 2302 | (defun gnus-convert-mark-converter-prompt (converter no-prompt) | ||
| 2303 | "Indicate whether CONVERTER requires gnus-convert-old-newsrc to | ||
| 2304 | display the conversion prompt. NO-PROMPT may be nil (prompt), | ||
| 2305 | t (no prompt), or any form that can be called as a function. | ||
| 2306 | The form should return either t or nil." | ||
| 2307 | (put converter 'gnus-convert-no-prompt no-prompt)) | ||
| 2308 | |||
| 2309 | (defun gnus-convert-converter-needs-prompt (converter) | ||
| 2310 | (let ((no-prompt (get converter 'gnus-convert-no-prompt))) | ||
| 2311 | (not (if (memq no-prompt '(t nil)) | ||
| 2312 | no-prompt | ||
| 2313 | (funcall no-prompt))))) | ||
| 2314 | |||
| 2315 | (defun gnus-convert-old-ticks (converting-to) | ||
| 2219 | (let ((newsrc (cdr gnus-newsrc-alist)) | 2316 | (let ((newsrc (cdr gnus-newsrc-alist)) |
| 2220 | marks info dormant ticked) | 2317 | marks info dormant ticked) |
| 2221 | (while (setq info (pop newsrc)) | 2318 | (while (setq info (pop newsrc)) |
| @@ -2594,6 +2691,10 @@ If FORCE is non-nil, the .newsrc file is read." | |||
| 2594 | ;; from the variable gnus-newsrc-alist. | 2691 | ;; from the variable gnus-newsrc-alist. |
| 2595 | (when (and (or gnus-newsrc-alist gnus-killed-list) | 2692 | (when (and (or gnus-newsrc-alist gnus-killed-list) |
| 2596 | gnus-current-startup-file) | 2693 | gnus-current-startup-file) |
| 2694 | ;; Save agent range limits for the currently active method. | ||
| 2695 | (when gnus-agent | ||
| 2696 | (gnus-agent-save-local force)) | ||
| 2697 | |||
| 2597 | (save-excursion | 2698 | (save-excursion |
| 2598 | (if (and (or gnus-use-dribble-file gnus-slave) | 2699 | (if (and (or gnus-use-dribble-file gnus-slave) |
| 2599 | (not force) | 2700 | (not force) |
| @@ -2611,6 +2712,7 @@ If FORCE is non-nil, the .newsrc file is read." | |||
| 2611 | (gnus-message 8 "Saving %s..." gnus-current-startup-file) | 2712 | (gnus-message 8 "Saving %s..." gnus-current-startup-file) |
| 2612 | (gnus-gnus-to-newsrc-format) | 2713 | (gnus-gnus-to-newsrc-format) |
| 2613 | (gnus-message 8 "Saving %s...done" gnus-current-startup-file)) | 2714 | (gnus-message 8 "Saving %s...done" gnus-current-startup-file)) |
| 2715 | |||
| 2614 | ;; Save .newsrc.eld. | 2716 | ;; Save .newsrc.eld. |
| 2615 | (set-buffer (gnus-get-buffer-create " *Gnus-newsrc*")) | 2717 | (set-buffer (gnus-get-buffer-create " *Gnus-newsrc*")) |
| 2616 | (make-local-variable 'version-control) | 2718 | (make-local-variable 'version-control) |
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 42c699ef552..68f40b3a7bb 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el | |||
| @@ -44,6 +44,7 @@ | |||
| 44 | (autoload 'gnus-cache-write-active "gnus-cache") | 44 | (autoload 'gnus-cache-write-active "gnus-cache") |
| 45 | (autoload 'gnus-mailing-list-insinuate "gnus-ml" nil t) | 45 | (autoload 'gnus-mailing-list-insinuate "gnus-ml" nil t) |
| 46 | (autoload 'turn-on-gnus-mailing-list-mode "gnus-ml" nil t) | 46 | (autoload 'turn-on-gnus-mailing-list-mode "gnus-ml" nil t) |
| 47 | (autoload 'gnus-pick-line-number "gnus-salt" nil t) | ||
| 47 | (autoload 'mm-uu-dissect "mm-uu") | 48 | (autoload 'mm-uu-dissect "mm-uu") |
| 48 | (autoload 'gnus-article-outlook-deuglify-article "deuglify" | 49 | (autoload 'gnus-article-outlook-deuglify-article "deuglify" |
| 49 | "Deuglify broken Outlook (Express) articles and redisplay." | 50 | "Deuglify broken Outlook (Express) articles and redisplay." |
| @@ -2238,8 +2239,12 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) | |||
| 2238 | ["Pipe through a filter..." gnus-summary-pipe-output t] | 2239 | ["Pipe through a filter..." gnus-summary-pipe-output t] |
| 2239 | ["Add to SOUP packet" gnus-soup-add-article t] | 2240 | ["Add to SOUP packet" gnus-soup-add-article t] |
| 2240 | ["Print with Muttprint..." gnus-summary-muttprint t] | 2241 | ["Print with Muttprint..." gnus-summary-muttprint t] |
| 2241 | ["Print" gnus-summary-print-article t]) | 2242 | ["Print" gnus-summary-print-article |
| 2242 | ("Backend" | 2243 | ,@(if (featurep 'xemacs) '(t) |
| 2244 | '(:help "Generate and print a PostScript image"))]) | ||
| 2245 | ("Copy, move,... (Backend)" | ||
| 2246 | ,@(if (featurep 'xemacs) '(t) | ||
| 2247 | '(:help "Copying, moving, expiring articles...")) | ||
| 2243 | ["Respool article..." gnus-summary-respool-article t] | 2248 | ["Respool article..." gnus-summary-respool-article t] |
| 2244 | ["Move article..." gnus-summary-move-article | 2249 | ["Move article..." gnus-summary-move-article |
| 2245 | (gnus-check-backend-function | 2250 | (gnus-check-backend-function |
| @@ -2330,7 +2335,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) | |||
| 2330 | `("Post" | 2335 | `("Post" |
| 2331 | ["Send a message (mail or news)" gnus-summary-post-news | 2336 | ["Send a message (mail or news)" gnus-summary-post-news |
| 2332 | ,@(if (featurep 'xemacs) '(t) | 2337 | ,@(if (featurep 'xemacs) '(t) |
| 2333 | '(:help "Post an article"))] | 2338 | '(:help "Compose a new message (mail or news)"))] |
| 2334 | ["Followup" gnus-summary-followup | 2339 | ["Followup" gnus-summary-followup |
| 2335 | ,@(if (featurep 'xemacs) '(t) | 2340 | ,@(if (featurep 'xemacs) '(t) |
| 2336 | '(:help "Post followup to this article"))] | 2341 | '(:help "Post followup to this article"))] |
| @@ -3229,28 +3234,34 @@ buffer that was in action when the last article was fetched." | |||
| 3229 | (save-excursion | 3234 | (save-excursion |
| 3230 | (gnus-set-work-buffer) | 3235 | (gnus-set-work-buffer) |
| 3231 | (let ((gnus-summary-line-format-spec spec) | 3236 | (let ((gnus-summary-line-format-spec spec) |
| 3232 | (gnus-newsgroup-downloadable '(0))) | 3237 | (gnus-newsgroup-downloadable '(0)) |
| 3238 | marks) | ||
| 3239 | (insert ?\200 "\200" ?\201 "\201" ?\202 "\202" ?\203 "\203") | ||
| 3240 | (while (not (bobp)) | ||
| 3241 | (push (buffer-substring (1- (point)) (point)) marks) | ||
| 3242 | (backward-char)) | ||
| 3243 | (erase-buffer) | ||
| 3233 | (gnus-summary-insert-line | 3244 | (gnus-summary-insert-line |
| 3234 | [0 "" "" "05 Apr 2001 23:33:09 +0400" "" "" 0 0 "" nil] | 3245 | [0 "" "" "05 Apr 2001 23:33:09 +0400" "" "" 0 0 "" nil] |
| 3235 | 0 nil t 128 t nil "" nil 1) | 3246 | 0 nil t 128 t nil "" nil 1) |
| 3236 | (goto-char (point-min)) | 3247 | (goto-char (point-min)) |
| 3237 | (setq pos (list (cons 'unread | 3248 | (setq pos (list (cons 'unread |
| 3238 | (and (search-forward | 3249 | (and (or (search-forward (nth 0 marks) nil t) |
| 3239 | (mm-string-as-multibyte "\200") nil t) | 3250 | (search-forward (nth 1 marks) nil t)) |
| 3240 | (- (point) (point-min) 1))))) | 3251 | (- (point) (point-min) 1))))) |
| 3241 | (goto-char (point-min)) | 3252 | (goto-char (point-min)) |
| 3242 | (push (cons 'replied (and (search-forward | 3253 | (push (cons 'replied (and (or (search-forward (nth 2 marks) nil t) |
| 3243 | (mm-string-as-multibyte "\201") nil t) | 3254 | (search-forward (nth 3 marks) nil t)) |
| 3244 | (- (point) (point-min) 1))) | 3255 | (- (point) (point-min) 1))) |
| 3245 | pos) | 3256 | pos) |
| 3246 | (goto-char (point-min)) | 3257 | (goto-char (point-min)) |
| 3247 | (push (cons 'score (and (search-forward | 3258 | (push (cons 'score (and (or (search-forward (nth 4 marks) nil t) |
| 3248 | (mm-string-as-multibyte "\202") nil t) | 3259 | (search-forward (nth 5 marks) nil t)) |
| 3249 | (- (point) (point-min) 1))) | 3260 | (- (point) (point-min) 1))) |
| 3250 | pos) | 3261 | pos) |
| 3251 | (goto-char (point-min)) | 3262 | (goto-char (point-min)) |
| 3252 | (push (cons 'download (and (search-forward | 3263 | (push (cons 'download (and (or (search-forward (nth 6 marks) nil t) |
| 3253 | (mm-string-as-multibyte "\203") nil t) | 3264 | (search-forward (nth 7 marks) nil t)) |
| 3254 | (- (point) (point-min) 1))) | 3265 | (- (point) (point-min) 1))) |
| 3255 | pos))) | 3266 | pos))) |
| 3256 | (setq gnus-summary-mark-positions pos)))) | 3267 | (setq gnus-summary-mark-positions pos)))) |
| @@ -5065,17 +5076,8 @@ If SELECT-ARTICLES, only select those articles from GROUP." | |||
| 5065 | group (gnus-status-message group))) | 5076 | group (gnus-status-message group))) |
| 5066 | 5077 | ||
| 5067 | (when gnus-agent | 5078 | (when gnus-agent |
| 5068 | ;; The agent may be storing articles that are no longer in the | 5079 | (gnus-agent-possibly-alter-active group (gnus-active group) info) |
| 5069 | ;; server's active range. If that is the case, the active range | 5080 | |
| 5070 | ;; needs to be expanded such that the agent's articles can be | ||
| 5071 | ;; included in the summary. | ||
| 5072 | (let* ((gnus-command-method (gnus-find-method-for-group group)) | ||
| 5073 | (alist (gnus-agent-load-alist group)) | ||
| 5074 | (active (gnus-active group))) | ||
| 5075 | (if (and (car alist) | ||
| 5076 | (< (caar alist) (car active))) | ||
| 5077 | (gnus-set-active group (cons (caar alist) (cdr active))))) | ||
| 5078 | |||
| 5079 | (setq gnus-summary-use-undownloaded-faces | 5081 | (setq gnus-summary-use-undownloaded-faces |
| 5080 | (gnus-agent-find-parameter | 5082 | (gnus-agent-find-parameter |
| 5081 | group | 5083 | group |
| @@ -5404,7 +5406,8 @@ If SELECT-ARTICLES, only select those articles from GROUP." | |||
| 5404 | (min (car active)) | 5406 | (min (car active)) |
| 5405 | (max (cdr active)) | 5407 | (max (cdr active)) |
| 5406 | (types gnus-article-mark-lists) | 5408 | (types gnus-article-mark-lists) |
| 5407 | marks var articles article mark mark-type) | 5409 | marks var articles article mark mark-type |
| 5410 | bgn end) | ||
| 5408 | 5411 | ||
| 5409 | (dolist (marks marked-lists) | 5412 | (dolist (marks marked-lists) |
| 5410 | (setq mark (car marks) | 5413 | (setq mark (car marks) |
| @@ -5414,13 +5417,30 @@ If SELECT-ARTICLES, only select those articles from GROUP." | |||
| 5414 | ;; We set the variable according to the type of the marks list, | 5417 | ;; We set the variable according to the type of the marks list, |
| 5415 | ;; and then adjust the marks to a subset of the active articles. | 5418 | ;; and then adjust the marks to a subset of the active articles. |
| 5416 | (cond | 5419 | (cond |
| 5417 | ;; Adjust "simple" lists. | 5420 | ;; Adjust "simple" lists - compressed yet unsorted |
| 5418 | ((eq mark-type 'list) | 5421 | ((eq mark-type 'list) |
| 5419 | (set var (setq articles (gnus-uncompress-range (cdr marks)))) | 5422 | ;; Simultaneously uncompress and clip to active range |
| 5420 | (when (memq mark '(tick dormant expire reply save)) | 5423 | ;; See gnus-uncompress-range for a description of possible marks |
| 5421 | (while articles | 5424 | (let (l lh) |
| 5422 | (when (or (< (setq article (pop articles)) min) (> article max)) | 5425 | (if (not (cadr marks)) |
| 5423 | (set var (delq article (symbol-value var))))))) | 5426 | (set var nil) |
| 5427 | (setq articles (if (numberp (cddr marks)) | ||
| 5428 | (list (cdr marks)) | ||
| 5429 | (cdr marks)) | ||
| 5430 | lh (cons nil nil) | ||
| 5431 | l lh) | ||
| 5432 | |||
| 5433 | (while (setq article (pop articles)) | ||
| 5434 | (cond ((consp article) | ||
| 5435 | (setq bgn (max (car article) min) | ||
| 5436 | end (min (cdr article) max)) | ||
| 5437 | (while (<= bgn end) | ||
| 5438 | (setq l (setcdr l (cons bgn nil)) | ||
| 5439 | bgn (1+ bgn)))) | ||
| 5440 | ((and (<= min article) | ||
| 5441 | (>= max article)) | ||
| 5442 | (setq l (setcdr l (cons article nil)))))) | ||
| 5443 | (set var (cdr lh))))) | ||
| 5424 | ;; Adjust assocs. | 5444 | ;; Adjust assocs. |
| 5425 | ((eq mark-type 'tuple) | 5445 | ((eq mark-type 'tuple) |
| 5426 | (set var (setq articles (cdr marks))) | 5446 | (set var (setq articles (cdr marks))) |
| @@ -6353,15 +6373,15 @@ displayed, no centering will be performed." | |||
| 6353 | (while read | 6373 | (while read |
| 6354 | (when first | 6374 | (when first |
| 6355 | (while (< first nlast) | 6375 | (while (< first nlast) |
| 6356 | (push first unread) | 6376 | (setq unread (cons first unread) |
| 6357 | (setq first (1+ first)))) | 6377 | first (1+ first)))) |
| 6358 | (setq first (1+ (if (atom (car read)) (car read) (cdar read)))) | 6378 | (setq first (1+ (if (atom (car read)) (car read) (cdar read)))) |
| 6359 | (setq nlast (if (atom (cadr read)) (cadr read) (caadr read))) | 6379 | (setq nlast (if (atom (cadr read)) (cadr read) (caadr read))) |
| 6360 | (setq read (cdr read))))) | 6380 | (setq read (cdr read))))) |
| 6361 | ;; And add the last unread articles. | 6381 | ;; And add the last unread articles. |
| 6362 | (while (<= first last) | 6382 | (while (<= first last) |
| 6363 | (push first unread) | 6383 | (setq unread (cons first unread) |
| 6364 | (setq first (1+ first))) | 6384 | first (1+ first))) |
| 6365 | ;; Return the list of unread articles. | 6385 | ;; Return the list of unread articles. |
| 6366 | (delq 0 (nreverse unread)))) | 6386 | (delq 0 (nreverse unread)))) |
| 6367 | 6387 | ||
| @@ -6379,6 +6399,44 @@ displayed, no centering will be performed." | |||
| 6379 | (cdr (assq 'dormant marked))) | 6399 | (cdr (assq 'dormant marked))) |
| 6380 | (cdr (assq 'tick marked)))))) | 6400 | (cdr (assq 'tick marked)))))) |
| 6381 | 6401 | ||
| 6402 | ;; This function returns a sequence of article numbers based on the | ||
| 6403 | ;; difference between the ranges of read articles in this group and | ||
| 6404 | ;; the range of active articles. | ||
| 6405 | (defun gnus-sequence-of-unread-articles (group) | ||
| 6406 | (let* ((read (gnus-info-read (gnus-get-info group))) | ||
| 6407 | (active (or (gnus-active group) (gnus-activate-group group))) | ||
| 6408 | (last (cdr active)) | ||
| 6409 | first nlast unread) | ||
| 6410 | ;; If none are read, then all are unread. | ||
| 6411 | (if (not read) | ||
| 6412 | (setq first (car active)) | ||
| 6413 | ;; If the range of read articles is a single range, then the | ||
| 6414 | ;; first unread article is the article after the last read | ||
| 6415 | ;; article. Sounds logical, doesn't it? | ||
| 6416 | (if (and (not (listp (cdr read))) | ||
| 6417 | (or (< (car read) (car active)) | ||
| 6418 | (progn (setq read (list read)) | ||
| 6419 | nil))) | ||
| 6420 | (setq first (max (car active) (1+ (cdr read)))) | ||
| 6421 | ;; `read' is a list of ranges. | ||
| 6422 | (when (/= (setq nlast (or (and (numberp (car read)) (car read)) | ||
| 6423 | (caar read))) | ||
| 6424 | 1) | ||
| 6425 | (setq first (car active))) | ||
| 6426 | (while read | ||
| 6427 | (when first | ||
| 6428 | (push (cons first nlast) unread)) | ||
| 6429 | (setq first (1+ (if (atom (car read)) (car read) (cdar read)))) | ||
| 6430 | (setq nlast (if (atom (cadr read)) (cadr read) (caadr read))) | ||
| 6431 | (setq read (cdr read))))) | ||
| 6432 | ;; And add the last unread articles. | ||
| 6433 | (cond ((< first last) | ||
| 6434 | (push (cons first last) unread)) | ||
| 6435 | ((= first last) | ||
| 6436 | (push first unread))) | ||
| 6437 | ;; Return the sequence of unread articles. | ||
| 6438 | (delq 0 (nreverse unread)))) | ||
| 6439 | |||
| 6382 | ;; Various summary commands | 6440 | ;; Various summary commands |
| 6383 | 6441 | ||
| 6384 | (defun gnus-summary-select-article-buffer () | 6442 | (defun gnus-summary-select-article-buffer () |
| @@ -11305,7 +11363,8 @@ If REVERSE, save parts that do not match TYPE." | |||
| 11305 | (default-high gnus-summary-default-high-score) | 11363 | (default-high gnus-summary-default-high-score) |
| 11306 | (default-low gnus-summary-default-low-score) | 11364 | (default-low gnus-summary-default-low-score) |
| 11307 | (uncached (and gnus-summary-use-undownloaded-faces | 11365 | (uncached (and gnus-summary-use-undownloaded-faces |
| 11308 | (memq article gnus-newsgroup-undownloaded)))) | 11366 | (memq article gnus-newsgroup-undownloaded) |
| 11367 | (not (memq article gnus-newsgroup-cached))))) | ||
| 11309 | (let ((face (funcall (gnus-summary-highlight-line-0)))) | 11368 | (let ((face (funcall (gnus-summary-highlight-line-0)))) |
| 11310 | (unless (eq face (get-text-property beg 'face)) | 11369 | (unless (eq face (get-text-property beg 'face)) |
| 11311 | (gnus-put-text-property-excluding-characters-with-faces | 11370 | (gnus-put-text-property-excluding-characters-with-faces |
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index 22db7ecd6d1..4b71e252f6e 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el | |||
| @@ -38,7 +38,11 @@ | |||
| 38 | (eval-when-compile | 38 | (eval-when-compile |
| 39 | (require 'cl) | 39 | (require 'cl) |
| 40 | ;; Fixme: this should be a gnus variable, not nnmail-. | 40 | ;; Fixme: this should be a gnus variable, not nnmail-. |
| 41 | (defvar nnmail-pathname-coding-system)) | 41 | (defvar nnmail-pathname-coding-system) |
| 42 | |||
| 43 | ;; Inappropriate references to other parts of Gnus. | ||
| 44 | (defvar gnus-emphasize-whitespace-regexp) | ||
| 45 | ) | ||
| 42 | (require 'time-date) | 46 | (require 'time-date) |
| 43 | (require 'netrc) | 47 | (require 'netrc) |
| 44 | 48 | ||
| @@ -1186,7 +1190,7 @@ is run." | |||
| 1186 | "Delete by side effect any elements of LIST whose car is `equal' to KEY. | 1190 | "Delete by side effect any elements of LIST whose car is `equal' to KEY. |
| 1187 | The modified LIST is returned. If the first member | 1191 | The modified LIST is returned. If the first member |
| 1188 | of LIST has a car that is `equal' to KEY, there is no way to remove it | 1192 | of LIST has a car that is `equal' to KEY, there is no way to remove it |
| 1189 | by side effect; therefore, write `(setq foo (remassoc key foo))' to be | 1193 | by side effect; therefore, write `(setq foo (gnus-remassoc key foo))' to be |
| 1190 | sure of changing the value of `foo'." | 1194 | sure of changing the value of `foo'." |
| 1191 | (when alist | 1195 | (when alist |
| 1192 | (if (equal key (caar alist)) | 1196 | (if (equal key (caar alist)) |
| @@ -1512,6 +1516,28 @@ predicate on the elements." | |||
| 1512 | ""))) | 1516 | ""))) |
| 1513 | (t emacs-version)))) | 1517 | (t emacs-version)))) |
| 1514 | 1518 | ||
| 1519 | (defun gnus-rename-file (old-path new-path &optional trim) | ||
| 1520 | "Rename OLD-PATH as NEW-PATH. If TRIM, recursively delete | ||
| 1521 | empty directories from OLD-PATH." | ||
| 1522 | (when (file-exists-p old-path) | ||
| 1523 | (let* ((old-dir (file-name-directory old-path)) | ||
| 1524 | (old-name (file-name-nondirectory old-path)) | ||
| 1525 | (new-dir (file-name-directory new-path)) | ||
| 1526 | (new-name (file-name-nondirectory new-path)) | ||
| 1527 | temp) | ||
| 1528 | (gnus-make-directory new-dir) | ||
| 1529 | (rename-file old-path new-path t) | ||
| 1530 | (when trim | ||
| 1531 | (while (progn (setq temp (directory-files old-dir)) | ||
| 1532 | (while (member (car temp) '("." "..")) | ||
| 1533 | (setq temp (cdr temp))) | ||
| 1534 | (= (length temp) 0)) | ||
| 1535 | (delete-directory old-dir) | ||
| 1536 | (setq old-dir (file-name-as-directory | ||
| 1537 | (file-truename | ||
| 1538 | (concat old-dir ".."))))))))) | ||
| 1539 | |||
| 1540 | |||
| 1515 | (provide 'gnus-util) | 1541 | (provide 'gnus-util) |
| 1516 | 1542 | ||
| 1517 | ;;; arch-tag: f94991af-d32b-4c97-8c26-ca12a934de49 | 1543 | ;;; arch-tag: f94991af-d32b-4c97-8c26-ca12a934de49 |
diff --git a/lisp/gnus/imap.el b/lisp/gnus/imap.el index 326c998c5d9..6ef8dfa5fe2 100644 --- a/lisp/gnus/imap.el +++ b/lisp/gnus/imap.el | |||
| @@ -270,6 +270,11 @@ Shorter values mean quicker response, but is more CPU intensive." | |||
| 270 | :type 'number | 270 | :type 'number |
| 271 | :group 'imap) | 271 | :group 'imap) |
| 272 | 272 | ||
| 273 | (defcustom imap-store-password nil | ||
| 274 | "If non-nil, store session password without promting." | ||
| 275 | :group 'imap | ||
| 276 | :type 'boolean) | ||
| 277 | |||
| 273 | ;; Various variables. | 278 | ;; Various variables. |
| 274 | 279 | ||
| 275 | (defvar imap-fetch-data-hook nil | 280 | (defvar imap-fetch-data-hook nil |
| @@ -827,9 +832,10 @@ Returns t if login was successful, nil otherwise." | |||
| 827 | (progn | 832 | (progn |
| 828 | (setq ret t | 833 | (setq ret t |
| 829 | imap-username user) | 834 | imap-username user) |
| 830 | (if (and (not imap-password) | 835 | (when (and (not imap-password) |
| 831 | (y-or-n-p "Store password for this session? ")) | 836 | (or imap-store-password |
| 832 | (setq imap-password passwd))) | 837 | (y-or-n-p "Store password for this session? "))) |
| 838 | (setq imap-password passwd))) | ||
| 833 | (message "Login failed...") | 839 | (message "Login failed...") |
| 834 | (setq passwd nil) | 840 | (setq passwd nil) |
| 835 | (setq imap-password nil) | 841 | (setq imap-password nil) |
diff --git a/lisp/gnus/legacy-gnus-agent.el b/lisp/gnus/legacy-gnus-agent.el new file mode 100644 index 00000000000..16b0cf6c89f --- /dev/null +++ b/lisp/gnus/legacy-gnus-agent.el | |||
| @@ -0,0 +1,227 @@ | |||
| 1 | (require 'gnus-start) | ||
| 2 | (require 'gnus-util) | ||
| 3 | (require 'gnus-range) | ||
| 4 | (require 'gnus-agent) | ||
| 5 | |||
| 6 | ; Oort Gnus v0.08 - This release updated agent to no longer use | ||
| 7 | ; history file and to support a compressed alist. | ||
| 8 | |||
| 9 | (defvar gnus-agent-compressed-agentview-search-only nil) | ||
| 10 | |||
| 11 | (defun gnus-agent-convert-to-compressed-agentview (converting-to) | ||
| 12 | "Iterates over all agentview files to ensure that they have been | ||
| 13 | converted to the compressed format." | ||
| 14 | |||
| 15 | (let ((search-in (list gnus-agent-directory)) | ||
| 16 | here | ||
| 17 | members | ||
| 18 | member | ||
| 19 | converted-something) | ||
| 20 | (while (setq here (pop search-in)) | ||
| 21 | (setq members (directory-files here t)) | ||
| 22 | (while (setq member (pop members)) | ||
| 23 | (cond ((string-match "/\\.\\.?$" member) | ||
| 24 | nil) | ||
| 25 | ((file-directory-p member) | ||
| 26 | (push member search-in)) | ||
| 27 | ((equal (file-name-nondirectory member) ".agentview") | ||
| 28 | (setq converted-something | ||
| 29 | (or (gnus-agent-convert-agentview member) | ||
| 30 | converted-something)))))) | ||
| 31 | |||
| 32 | (if converted-something | ||
| 33 | (gnus-message 4 "Successfully converted Gnus %s offline (agent) files to %s" gnus-newsrc-file-version converting-to)))) | ||
| 34 | |||
| 35 | (defun gnus-agent-convert-to-compressed-agentview-prompt () | ||
| 36 | (catch 'found-file-to-convert | ||
| 37 | (let ((gnus-agent-compressed-agentview-search-only t)) | ||
| 38 | (gnus-agent-convert-to-compressed-agentview nil)))) | ||
| 39 | |||
| 40 | (gnus-convert-mark-converter-prompt 'gnus-agent-convert-to-compressed-agentview 'gnus-agent-convert-to-compressed-agentview-prompt) | ||
| 41 | |||
| 42 | (defun gnus-agent-convert-agentview (file) | ||
| 43 | "Load FILE and do a `read' there." | ||
| 44 | (with-temp-buffer | ||
| 45 | (nnheader-insert-file-contents file) | ||
| 46 | (goto-char (point-min)) | ||
| 47 | (let ((inhibit-quit t) | ||
| 48 | (alist (read (current-buffer))) | ||
| 49 | (version (condition-case nil (read (current-buffer)) | ||
| 50 | (end-of-file 0))) | ||
| 51 | changed-version | ||
| 52 | history-file) | ||
| 53 | |||
| 54 | (cond | ||
| 55 | ((= version 0) | ||
| 56 | (let (entry | ||
| 57 | (gnus-command-method nil)) | ||
| 58 | (mm-disable-multibyte) ;; everything is binary | ||
| 59 | (erase-buffer) | ||
| 60 | (insert "\n") | ||
| 61 | (let ((file (concat (file-name-directory file) "/history"))) | ||
| 62 | (when (file-exists-p file) | ||
| 63 | (nnheader-insert-file-contents file) | ||
| 64 | (setq history-file file))) | ||
| 65 | |||
| 66 | (goto-char (point-min)) | ||
| 67 | (while (not (eobp)) | ||
| 68 | (if (and (looking-at | ||
| 69 | "[^\t\n]+\t\\([0-9]+\\)\t\\([^ \n]+\\) \\([0-9]+\\)") | ||
| 70 | (string= (gnus-agent-article-name ".agentview" (match-string 2)) | ||
| 71 | file) | ||
| 72 | (setq entry (assoc (string-to-number (match-string 3)) alist))) | ||
| 73 | (setcdr entry (string-to-number (match-string 1)))) | ||
| 74 | (forward-line 1)) | ||
| 75 | (setq changed-version t))) | ||
| 76 | ((= version 1) | ||
| 77 | (setq changed-version t))) | ||
| 78 | |||
| 79 | (when changed-version | ||
| 80 | (when gnus-agent-compressed-agentview-search-only | ||
| 81 | (throw 'found-file-to-convert t)) | ||
| 82 | |||
| 83 | (erase-buffer) | ||
| 84 | (let ((compressed nil)) | ||
| 85 | (mapcar (lambda (pair) | ||
| 86 | (let* ((article-id (car pair)) | ||
| 87 | (day-of-download (cdr pair)) | ||
| 88 | (comp-list (assq day-of-download compressed))) | ||
| 89 | (if comp-list | ||
| 90 | (setcdr comp-list | ||
| 91 | (cons article-id (cdr comp-list))) | ||
| 92 | (setq compressed | ||
| 93 | (cons (list day-of-download article-id) | ||
| 94 | compressed))) | ||
| 95 | nil)) alist) | ||
| 96 | (mapcar (lambda (comp-list) | ||
| 97 | (setcdr comp-list | ||
| 98 | (gnus-compress-sequence | ||
| 99 | (nreverse (cdr comp-list))))) | ||
| 100 | compressed) | ||
| 101 | (princ compressed (current-buffer))) | ||
| 102 | (insert "\n2\n") | ||
| 103 | (write-file file) | ||
| 104 | (when history-file | ||
| 105 | (delete-file history-file)) | ||
| 106 | t)))) | ||
| 107 | |||
| 108 | ;; End of Oort Gnus v0.08 updates | ||
| 109 | |||
| 110 | ;; No Gnus v0.3 - This release provides a mechanism for upgrading gnus | ||
| 111 | ;; from previous versions. Therefore, the previous | ||
| 112 | ;; hacks to handle a gnus-agent-expire-days that | ||
| 113 | ;; specifies a list of values can be removed. | ||
| 114 | |||
| 115 | (defun gnus-agent-unlist-expire-days (converting-to) | ||
| 116 | (when (listp gnus-agent-expire-days) | ||
| 117 | (let (buffer) | ||
| 118 | (unwind-protect | ||
| 119 | (save-window-excursion | ||
| 120 | (setq buffer (gnus-get-buffer-create " *Gnus agent upgrade*")) | ||
| 121 | (set-buffer buffer) | ||
| 122 | (erase-buffer) | ||
| 123 | (insert "The definition of gnus-agent-expire-days has been changed.\nYou currently have it set to the list:\n ") | ||
| 124 | (gnus-pp gnus-agent-expire-days) | ||
| 125 | |||
| 126 | (insert "\nIn order to use version '" converting-to "' of gnus, you will need to set\n") | ||
| 127 | (insert "gnus-agent-expire-days to an integer. If you still wish to set different\n") | ||
| 128 | (insert "expiration days to individual groups, you must instead set the\n") | ||
| 129 | (insert "'agent-days-until-old group and/or topic parameter.\n") | ||
| 130 | (insert "\n") | ||
| 131 | (insert "If you would like, gnus can iterate over every group comparing its name to the\n") | ||
| 132 | (insert "regular expressions that you currently have in gnus-agent-expire-days. When\n") | ||
| 133 | (insert "gnus finds a match, it will update that group's 'agent-days-until-old group\n") | ||
| 134 | (insert "parameter to the value associated with the regular expression.\n") | ||
| 135 | (insert "\n") | ||
| 136 | (insert "Whether gnus assigns group parameters, or not, gnus will terminate with an\n") | ||
| 137 | (insert "ERROR as soon as this function completes. The reason is that you must\n") | ||
| 138 | (insert "manually edit your configuration to either not set gnus-agent-expire-days or\n") | ||
| 139 | (insert "to set it to an integer before gnus can be used.\n") | ||
| 140 | (insert "\n") | ||
| 141 | (insert "Once you have successfully edited gnus-agent-expire-days, gnus will be able to\n") | ||
| 142 | (insert "execute past this function.\n") | ||
| 143 | (insert "\n") | ||
| 144 | (insert "Should gnus use gnus-agent-expire-days to assign\n") | ||
| 145 | (insert "agent-days-until-old parameters to individual groups? (Y/N)") | ||
| 146 | |||
| 147 | (switch-to-buffer buffer) | ||
| 148 | (beep) | ||
| 149 | (beep) | ||
| 150 | |||
| 151 | (let ((echo-keystrokes 0) | ||
| 152 | c) | ||
| 153 | (while (progn (setq c (read-char-exclusive)) | ||
| 154 | (cond ((or (eq c ?y) (eq c ?Y)) | ||
| 155 | (save-excursion | ||
| 156 | (let ((groups (gnus-group-listed-groups))) | ||
| 157 | (while groups | ||
| 158 | (let* ((group (pop groups)) | ||
| 159 | (days gnus-agent-expire-days) | ||
| 160 | (day (catch 'found | ||
| 161 | (while days | ||
| 162 | (when (eq 0 (string-match | ||
| 163 | (caar days) | ||
| 164 | group)) | ||
| 165 | (throw 'found (cadar days))) | ||
| 166 | (setq days (cdr days))) | ||
| 167 | nil))) | ||
| 168 | (when day | ||
| 169 | (gnus-group-set-parameter group 'agent-days-until-old | ||
| 170 | day)))))) | ||
| 171 | nil | ||
| 172 | ) | ||
| 173 | ((or (eq c ?n) (eq c ?N)) | ||
| 174 | nil) | ||
| 175 | (t | ||
| 176 | t)))))) | ||
| 177 | (kill-buffer buffer)) | ||
| 178 | (error "Change gnus-agent-expire-days to an integer for gnus to start.")))) | ||
| 179 | |||
| 180 | ;; The gnus-agent-unlist-expire-days has its own conversion prompt. | ||
| 181 | ;; Therefore, hide the default prompt. | ||
| 182 | (gnus-convert-mark-converter-prompt 'gnus-agent-unlist-expire-days t) | ||
| 183 | |||
| 184 | (defun gnus-agent-unhook-expire-days (converting-to) | ||
| 185 | "Remove every lambda from gnus-group-prepare-hook that mention the | ||
| 186 | symbol gnus-agent-do-once in their definition. This should NOT be | ||
| 187 | necessary as gnus-agent.el no longer adds them. However, it is | ||
| 188 | possible that the hook was persistently saved." | ||
| 189 | (let ((h t)) ; iterate from bgn of hook | ||
| 190 | (while h | ||
| 191 | (let ((func (progn (when (eq h t) | ||
| 192 | ;; init h to list of functions | ||
| 193 | (setq h (cond ((listp gnus-group-prepare-hook) | ||
| 194 | gnus-group-prepare-hook) | ||
| 195 | ((boundp 'gnus-group-prepare-hook) | ||
| 196 | (list gnus-group-prepare-hook))))) | ||
| 197 | (pop h)))) | ||
| 198 | |||
| 199 | (when (cond ((eq (type-of func) 'compiled-function) | ||
| 200 | ;; Search def. of compiled function for gnus-agent-do-once string | ||
| 201 | (let* (definition | ||
| 202 | print-level | ||
| 203 | print-length | ||
| 204 | (standard-output | ||
| 205 | (lambda (char) | ||
| 206 | (setq definition (cons char definition))))) | ||
| 207 | (princ func) ; populates definition with reversed list of characters | ||
| 208 | (let* ((i (length definition)) | ||
| 209 | (s (make-string i 0))) | ||
| 210 | (while definition | ||
| 211 | (aset s (setq i (1- i)) (pop definition))) | ||
| 212 | |||
| 213 | (string-match "\\bgnus-agent-do-once\\b" s)))) | ||
| 214 | ((listp func) | ||
| 215 | (eq (cadr (nth 2 func)) 'gnus-agent-do-once) ; handles eval'd lambda | ||
| 216 | )) | ||
| 217 | |||
| 218 | (remove-hook 'gnus-group-prepare-hook func) | ||
| 219 | ;; I don't what remove-hook is going to actually do to the | ||
| 220 | ;; hook list so start over from the beginning. | ||
| 221 | (setq h t)))))) | ||
| 222 | |||
| 223 | ;; gnus-agent-unhook-expire-days is safe in that it does not modify | ||
| 224 | ;; the .newsrc.eld file. | ||
| 225 | (gnus-convert-mark-converter-prompt 'gnus-agent-unhook-expire-days t) | ||
| 226 | |||
| 227 | ;;; arch-tag: 845c7b8a-88f7-4468-b8d7-94e8fc72cf1a | ||
diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el index b35cd1d0448..740f4c9c3a3 100644 --- a/lisp/gnus/mail-source.el +++ b/lisp/gnus/mail-source.el | |||
| @@ -257,7 +257,7 @@ If non-nil, this maildrop will be checked periodically for new mail." | |||
| 257 | :type 'file) | 257 | :type 'file) |
| 258 | 258 | ||
| 259 | (defcustom mail-source-directory message-directory | 259 | (defcustom mail-source-directory message-directory |
| 260 | "Directory where files (if any) will be stored." | 260 | "Directory where incoming mail source files (if any) will be stored." |
| 261 | :group 'mail-source | 261 | :group 'mail-source |
| 262 | :type 'directory) | 262 | :type 'directory) |
| 263 | 263 | ||
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index c9d05d1a0fe..585a72af549 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el | |||
| @@ -255,7 +255,12 @@ included. Organization and User-Agent are optional." | |||
| 255 | :group 'message-news | 255 | :group 'message-news |
| 256 | :group 'message-headers | 256 | :group 'message-headers |
| 257 | :link '(custom-manual "(message)Message Headers") | 257 | :link '(custom-manual "(message)Message Headers") |
| 258 | :type 'regexp) | 258 | :type '(repeat :value-to-internal (lambda (widget value) |
| 259 | (custom-split-regexp-maybe value)) | ||
| 260 | :match (lambda (widget value) | ||
| 261 | (or (stringp value) | ||
| 262 | (widget-editable-list-match widget value))) | ||
| 263 | regexp)) | ||
| 259 | 264 | ||
| 260 | (defcustom message-ignored-mail-headers | 265 | (defcustom message-ignored-mail-headers |
| 261 | "^[GF]cc:\\|^Resent-Fcc:\\|^Xref:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:" | 266 | "^[GF]cc:\\|^Resent-Fcc:\\|^Xref:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:" |
| @@ -271,7 +276,12 @@ It's best to delete old Path and Date headers before posting to avoid | |||
| 271 | any confusion." | 276 | any confusion." |
| 272 | :group 'message-interface | 277 | :group 'message-interface |
| 273 | :link '(custom-manual "(message)Superseding") | 278 | :link '(custom-manual "(message)Superseding") |
| 274 | :type 'regexp) | 279 | :type '(repeat :value-to-internal (lambda (widget value) |
| 280 | (custom-split-regexp-maybe value)) | ||
| 281 | :match (lambda (widget value) | ||
| 282 | (or (stringp value) | ||
| 283 | (widget-editable-list-match widget value))) | ||
| 284 | regexp)) | ||
| 275 | 285 | ||
| 276 | (defcustom message-subject-re-regexp | 286 | (defcustom message-subject-re-regexp |
| 277 | "^[ \t]*\\([Rr][Ee]\\(\\[[0-9]*\\]\\)*:[ \t]*\\)*[ \t]*" | 287 | "^[ \t]*\\([Rr][Ee]\\(\\[[0-9]*\\]\\)*:[ \t]*\\)*[ \t]*" |
| @@ -534,13 +544,22 @@ Done before generating the new subject of a forward." | |||
| 534 | "*All headers that match this regexp will be deleted when resending a message." | 544 | "*All headers that match this regexp will be deleted when resending a message." |
| 535 | :group 'message-interface | 545 | :group 'message-interface |
| 536 | :link '(custom-manual "(message)Resending") | 546 | :link '(custom-manual "(message)Resending") |
| 537 | :type 'regexp) | 547 | :type '(repeat :value-to-internal (lambda (widget value) |
| 548 | (custom-split-regexp-maybe value)) | ||
| 549 | :match (lambda (widget value) | ||
| 550 | (or (stringp value) | ||
| 551 | (widget-editable-list-match widget value))) | ||
| 552 | regexp)) | ||
| 538 | 553 | ||
| 539 | (defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus" | 554 | (defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus" |
| 540 | "*All headers that match this regexp will be deleted when forwarding a message." | 555 | "*All headers that match this regexp will be deleted when forwarding a message." |
| 541 | :version "21.1" | 556 | :version "21.1" |
| 542 | :group 'message-forwarding | 557 | :group 'message-forwarding |
| 543 | :type '(choice (const :tag "None" nil) | 558 | :type '(repeat :value-to-internal (lambda (widget value) |
| 559 | (custom-split-regexp-maybe value)) | ||
| 560 | :match (lambda (widget value) | ||
| 561 | (or (stringp value) | ||
| 562 | (widget-editable-list-match widget value))) | ||
| 544 | regexp)) | 563 | regexp)) |
| 545 | 564 | ||
| 546 | (defcustom message-ignored-cited-headers "." | 565 | (defcustom message-ignored-cited-headers "." |
| @@ -2610,7 +2629,7 @@ M-RET `message-newline-and-reformat' (break the line and reformat)." | |||
| 2610 | (defun message-goto-mail-followup-to () | 2629 | (defun message-goto-mail-followup-to () |
| 2611 | "Move point to the Mail-Followup-To header." | 2630 | "Move point to the Mail-Followup-To header." |
| 2612 | (interactive) | 2631 | (interactive) |
| 2613 | (message-position-on-field "Mail-Followup-To" "From")) | 2632 | (message-position-on-field "Mail-Followup-To" "To")) |
| 2614 | 2633 | ||
| 2615 | (defun message-goto-keywords () | 2634 | (defun message-goto-keywords () |
| 2616 | "Move point to the Keywords header." | 2635 | "Move point to the Keywords header." |
| @@ -2720,6 +2739,7 @@ or in the synonym headers, defined by `message-header-synonyms'." | |||
| 2720 | ;; FIXME: Should compare only the address and not the full name. Comparison | 2739 | ;; FIXME: Should compare only the address and not the full name. Comparison |
| 2721 | ;; should be done case-folded (and with `string=' rather than | 2740 | ;; should be done case-folded (and with `string=' rather than |
| 2722 | ;; `string-match'). | 2741 | ;; `string-match'). |
| 2742 | ;; (mail-strip-quoted-names "Foo Bar <foo@bar>, bla@fasel (Bla Fasel)") | ||
| 2723 | (dolist (header headers) | 2743 | (dolist (header headers) |
| 2724 | (let* ((header-name (symbol-name (car header))) | 2744 | (let* ((header-name (symbol-name (car header))) |
| 2725 | (new-header (cdr header)) | 2745 | (new-header (cdr header)) |
diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index c0ed098fa6f..2b58d103ade 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el | |||
| @@ -199,13 +199,14 @@ | |||
| 199 | (setq w3m-display-inline-images mm-inline-text-html-with-images)) | 199 | (setq w3m-display-inline-images mm-inline-text-html-with-images)) |
| 200 | 200 | ||
| 201 | (defun mm-w3m-cid-retrieve-1 (url handle) | 201 | (defun mm-w3m-cid-retrieve-1 (url handle) |
| 202 | (if (mm-multiple-handles handle) | 202 | (dolist (elem handle) |
| 203 | (dolist (elem handle) | 203 | (when (listp elem) |
| 204 | (mm-w3m-cid-retrieve-1 url elem)) | 204 | (if (equal url (mm-handle-id elem)) |
| 205 | (when (and (listp handle) | 205 | (progn |
| 206 | (equal url (mm-handle-id handle))) | 206 | (mm-insert-part elem) |
| 207 | (mm-insert-part handle) | 207 | (throw 'found-handle (mm-handle-media-type elem)))) |
| 208 | (throw 'found-handle (mm-handle-media-type handle))))) | 208 | (if (equal "multipart" (mm-handle-media-supertype elem)) |
| 209 | (mm-w3m-cid-retrieve-1 url elem))))) | ||
| 209 | 210 | ||
| 210 | (defun mm-w3m-cid-retrieve (url &rest args) | 211 | (defun mm-w3m-cid-retrieve (url &rest args) |
| 211 | "Insert a content pointed by URL if it has the cid: scheme." | 212 | "Insert a content pointed by URL if it has the cid: scheme." |
| @@ -465,8 +466,12 @@ | |||
| 465 | (progn | 466 | (progn |
| 466 | (buffer-disable-undo) | 467 | (buffer-disable-undo) |
| 467 | (mm-insert-part handle) | 468 | (mm-insert-part handle) |
| 468 | (funcall mode) | ||
| 469 | (require 'font-lock) | 469 | (require 'font-lock) |
| 470 | ;; Inhibit font-lock this time (*-mode-hook might run | ||
| 471 | ;; `turn-on-font-lock') so that jit-lock may not turn off | ||
| 472 | ;; font-lock immediately after this. | ||
| 473 | (let ((font-lock-mode t)) | ||
| 474 | (funcall mode)) | ||
| 470 | (let ((font-lock-verbose nil)) | 475 | (let ((font-lock-verbose nil)) |
| 471 | ;; I find font-lock a bit too verbose. | 476 | ;; I find font-lock a bit too verbose. |
| 472 | (font-lock-fontify-buffer)) | 477 | (font-lock-fontify-buffer)) |
diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index 221e1712611..d88f6318159 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el | |||
| @@ -1076,9 +1076,9 @@ If RAW, don't highlight the article." | |||
| 1076 | (message-fetch-field "Newsgroups"))) | 1076 | (message-fetch-field "Newsgroups"))) |
| 1077 | message-posting-charset))) | 1077 | message-posting-charset))) |
| 1078 | (message-options-set-recipient) | 1078 | (message-options-set-recipient) |
| 1079 | (switch-to-buffer (generate-new-buffer | 1079 | (pop-to-buffer (generate-new-buffer |
| 1080 | (concat (if raw "*Raw MIME preview of " | 1080 | (concat (if raw "*Raw MIME preview of " |
| 1081 | "*MIME preview of ") (buffer-name)))) | 1081 | "*MIME preview of ") (buffer-name)))) |
| 1082 | (when (boundp 'gnus-buffers) | 1082 | (when (boundp 'gnus-buffers) |
| 1083 | (push (current-buffer) gnus-buffers)) | 1083 | (push (current-buffer) gnus-buffers)) |
| 1084 | (erase-buffer) | 1084 | (erase-buffer) |
diff --git a/lisp/gnus/nnagent.el b/lisp/gnus/nnagent.el index 669aa6904dd..a17e92ce001 100644 --- a/lisp/gnus/nnagent.el +++ b/lisp/gnus/nnagent.el | |||
| @@ -103,7 +103,7 @@ | |||
| 103 | 103 | ||
| 104 | (defun nnagent-request-type (group article) | 104 | (defun nnagent-request-type (group article) |
| 105 | (unless (stringp article) | 105 | (unless (stringp article) |
| 106 | (let ((gnus-plugged t)) | 106 | (let ((gnus-agent nil)) |
| 107 | (if (not (gnus-check-backend-function | 107 | (if (not (gnus-check-backend-function |
| 108 | 'request-type (car gnus-command-method))) | 108 | 'request-type (car gnus-command-method))) |
| 109 | 'unknown | 109 | 'unknown |
| @@ -122,9 +122,14 @@ | |||
| 122 | 122 | ||
| 123 | (deffoo nnagent-request-set-mark (group action server) | 123 | (deffoo nnagent-request-set-mark (group action server) |
| 124 | (with-temp-buffer | 124 | (with-temp-buffer |
| 125 | (insert (format "(%s-request-set-mark \"%s\" '%s \"%s\")\n" | 125 | (insert "(gnus-agent-synchronize-group-flags \"" |
| 126 | (nth 0 gnus-command-method) group action | 126 | group |
| 127 | (or server (nth 1 gnus-command-method)))) | 127 | "\" '") |
| 128 | (gnus-pp action) | ||
| 129 | (insert " \"" | ||
| 130 | (gnus-method-to-server gnus-command-method) | ||
| 131 | "\"") | ||
| 132 | (insert ")\n") | ||
| 128 | (append-to-file (point-min) (point-max) (gnus-agent-lib-file "flags"))) | 133 | (append-to-file (point-min) (point-max) (gnus-agent-lib-file "flags"))) |
| 129 | nil) | 134 | nil) |
| 130 | 135 | ||
diff --git a/lisp/gnus/nnspool.el b/lisp/gnus/nnspool.el index eaf5159be8f..9a08cdfe71c 100644 --- a/lisp/gnus/nnspool.el +++ b/lisp/gnus/nnspool.el | |||
| @@ -44,7 +44,7 @@ This is most commonly `inews' or `injnews'.") | |||
| 44 | "Switches for nnspool-request-post to pass to `inews' for posting news. | 44 | "Switches for nnspool-request-post to pass to `inews' for posting news. |
| 45 | If you are using Cnews, you probably should set this variable to nil.") | 45 | If you are using Cnews, you probably should set this variable to nil.") |
| 46 | 46 | ||
| 47 | (defvoo nnspool-spool-directory (file-name-as-directory news-path) | 47 | (defvoo nnspool-spool-directory (file-name-as-directory news-directory) |
| 48 | "Local news spool directory.") | 48 | "Local news spool directory.") |
| 49 | 49 | ||
| 50 | (defvoo nnspool-nov-directory (concat nnspool-spool-directory "over.view/") | 50 | (defvoo nnspool-nov-directory (concat nnspool-spool-directory "over.view/") |
diff --git a/lisp/gnus/pop3.el b/lisp/gnus/pop3.el index e288f6cace2..db8753057d6 100644 --- a/lisp/gnus/pop3.el +++ b/lisp/gnus/pop3.el | |||
| @@ -83,7 +83,14 @@ values are 'apop." | |||
| 83 | :group 'pop3) | 83 | :group 'pop3) |
| 84 | 84 | ||
| 85 | (defcustom pop3-leave-mail-on-server nil | 85 | (defcustom pop3-leave-mail-on-server nil |
| 86 | "*Non-nil if the mail is to be left on the POP server after fetching." | 86 | "*Non-nil if the mail is to be left on the POP server after fetching. |
| 87 | |||
| 88 | If the `pop3-leave-mail-on-server' is non-`nil' the mail is to be | ||
| 89 | left on the POP server after fetching. Note that POP servers | ||
| 90 | maintain no state information between sessions, so what the | ||
| 91 | client believes is there and what is actually there may not match | ||
| 92 | up. If they do not, then the whole thing can fall apart and | ||
| 93 | leave you with a corrupt mailbox." | ||
| 87 | :version "21.4" ;; Oort Gnus | 94 | :version "21.4" ;; Oort Gnus |
| 88 | :type 'boolean | 95 | :type 'boolean |
| 89 | :group 'pop3) | 96 | :group 'pop3) |
| @@ -95,6 +102,32 @@ Used for APOP authentication.") | |||
| 95 | (defvar pop3-read-point nil) | 102 | (defvar pop3-read-point nil) |
| 96 | (defvar pop3-debug nil) | 103 | (defvar pop3-debug nil) |
| 97 | 104 | ||
| 105 | ;; Borrowed from nnheader-accept-process-output in nnheader.el. | ||
| 106 | (defvar pop3-read-timeout | ||
| 107 | (if (string-match "windows-nt\\|os/2\\|emx\\|cygwin" | ||
| 108 | (symbol-name system-type)) | ||
| 109 | ;; http://thread.gmane.org/v9655t3pjo.fsf@marauder.physik.uni-ulm.de | ||
| 110 | ;; | ||
| 111 | ;; IIRC, values lower than 1.0 didn't/don't work on Windows/DOS. | ||
| 112 | ;; | ||
| 113 | ;; There should probably be a runtime test to determine the timing | ||
| 114 | ;; resolution, or a primitive to report it. I don't know off-hand | ||
| 115 | ;; what's possible. Perhaps better, maybe the Windows/DOS primitive | ||
| 116 | ;; could round up non-zero timeouts to a minimum of 1.0? | ||
| 117 | 1.0 | ||
| 118 | 0.1) | ||
| 119 | "How long pop3 should wait between checking for the end of output. | ||
| 120 | Shorter values mean quicker response, but are more CPU intensive.") | ||
| 121 | |||
| 122 | ;; Borrowed from nnheader-accept-process-output in nnheader.el. | ||
| 123 | (defun pop3-accept-process-output (process) | ||
| 124 | (accept-process-output | ||
| 125 | process | ||
| 126 | (truncate pop3-read-timeout) | ||
| 127 | (truncate (* (- pop3-read-timeout | ||
| 128 | (truncate pop3-read-timeout)) | ||
| 129 | 1000)))) | ||
| 130 | |||
| 98 | (defun pop3-movemail (&optional crashbox) | 131 | (defun pop3-movemail (&optional crashbox) |
| 99 | "Transfer contents of a maildrop to the specified CRASHBOX." | 132 | "Transfer contents of a maildrop to the specified CRASHBOX." |
| 100 | (or crashbox (setq crashbox (expand-file-name "~/.crashbox"))) | 133 | (or crashbox (setq crashbox (expand-file-name "~/.crashbox"))) |
| @@ -207,7 +240,7 @@ Return the response string if optional second argument is non-nil." | |||
| 207 | (goto-char pop3-read-point) | 240 | (goto-char pop3-read-point) |
| 208 | (while (and (memq (process-status process) '(open run)) | 241 | (while (and (memq (process-status process) '(open run)) |
| 209 | (not (search-forward "\r\n" nil t))) | 242 | (not (search-forward "\r\n" nil t))) |
| 210 | (nnheader-accept-process-output process) | 243 | (pop3-accept-process-output process) |
| 211 | (goto-char pop3-read-point)) | 244 | (goto-char pop3-read-point)) |
| 212 | (setq match-end (point)) | 245 | (setq match-end (point)) |
| 213 | (goto-char pop3-read-point) | 246 | (goto-char pop3-read-point) |
| @@ -381,8 +414,7 @@ This function currently does nothing.") | |||
| 381 | (save-excursion | 414 | (save-excursion |
| 382 | (set-buffer (process-buffer process)) | 415 | (set-buffer (process-buffer process)) |
| 383 | (while (not (re-search-forward "^\\.\r\n" nil t)) | 416 | (while (not (re-search-forward "^\\.\r\n" nil t)) |
| 384 | ;; Fixme: Shouldn't depend on nnheader. | 417 | (pop3-accept-process-output process) |
| 385 | (nnheader-accept-process-output process) | ||
| 386 | (goto-char start)) | 418 | (goto-char start)) |
| 387 | (setq pop3-read-point (point-marker)) | 419 | (setq pop3-read-point (point-marker)) |
| 388 | ;; this code does not seem to work for some POP servers... | 420 | ;; this code does not seem to work for some POP servers... |
diff --git a/lisp/gnus/spam-stat.el b/lisp/gnus/spam-stat.el index 9e20a51b127..f197d165cdd 100644 --- a/lisp/gnus/spam-stat.el +++ b/lisp/gnus/spam-stat.el | |||
| @@ -594,6 +594,8 @@ COUNT defaults to 5" | |||
| 594 | (remove-hook 'gnus-select-article-hook | 594 | (remove-hook 'gnus-select-article-hook |
| 595 | 'spam-stat-store-gnus-article-buffer)) | 595 | 'spam-stat-store-gnus-article-buffer)) |
| 596 | 596 | ||
| 597 | (add-hook 'spam-stat-unload-hook 'spam-stat-unload-hook) | ||
| 598 | |||
| 597 | (provide 'spam-stat) | 599 | (provide 'spam-stat) |
| 598 | 600 | ||
| 599 | ;;; arch-tag: ff1d2200-8ddb-42fb-bb7b-1b5e20448554 | 601 | ;;; arch-tag: ff1d2200-8ddb-42fb-bb7b-1b5e20448554 |
diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el index 85534f3828c..1dc9058dd1f 100644 --- a/lisp/gnus/spam.el +++ b/lisp/gnus/spam.el | |||
| @@ -78,7 +78,7 @@ | |||
| 78 | (defgroup spam nil | 78 | (defgroup spam nil |
| 79 | "Spam configuration.") | 79 | "Spam configuration.") |
| 80 | 80 | ||
| 81 | (defcustom spam-directory "~/News/spam/" | 81 | (defcustom spam-directory (nnheader-concat gnus-directory "spam/") |
| 82 | "Directory for spam whitelists and blacklists." | 82 | "Directory for spam whitelists and blacklists." |
| 83 | :type 'directory | 83 | :type 'directory |
| 84 | :group 'spam) | 84 | :group 'spam) |
| @@ -1814,14 +1814,12 @@ REMOVE not nil, remove the ADDRESSES." | |||
| 1814 | (remove-hook 'gnus-get-new-news-hook 'spam-setup-widening) | 1814 | (remove-hook 'gnus-get-new-news-hook 'spam-setup-widening) |
| 1815 | (remove-hook 'gnus-summary-prepare-hook 'spam-find-spam)) | 1815 | (remove-hook 'gnus-summary-prepare-hook 'spam-find-spam)) |
| 1816 | 1816 | ||
| 1817 | (add-hook 'spam-unload-hook 'spam-unload-hook) | ||
| 1818 | |||
| 1817 | (when spam-install-hooks | 1819 | (when spam-install-hooks |
| 1818 | (spam-initialize)) | 1820 | (spam-initialize)) |
| 1819 | 1821 | ||
| 1820 | (provide 'spam) | 1822 | (provide 'spam) |
| 1821 | 1823 | ||
| 1822 | ;;; spam.el ends here. | ||
| 1823 | |||
| 1824 | (provide 'spam) | ||
| 1825 | |||
| 1826 | ;;; arch-tag: 07e6e0ca-ab0a-4412-b445-1f6c72a4f27f | 1824 | ;;; arch-tag: 07e6e0ca-ab0a-4412-b445-1f6c72a4f27f |
| 1827 | ;;; spam.el ends here | 1825 | ;;; spam.el ends here |
diff --git a/lisp/help-at-pt.el b/lisp/help-at-pt.el index ad1f2b3a96a..d6ac6ec3fdc 100644 --- a/lisp/help-at-pt.el +++ b/lisp/help-at-pt.el | |||
| @@ -348,8 +348,7 @@ different regions. With numeric argument ARG, behaves like | |||
| 348 | (interactive "p") | 348 | (interactive "p") |
| 349 | (scan-buf-move-to-region 'help-echo (- arg) 'scan-buf-move-hook)) | 349 | (scan-buf-move-to-region 'help-echo (- arg) 'scan-buf-move-hook)) |
| 350 | 350 | ||
| 351 | (defvar help-at-pt-unload-hook '(help-at-pt-cancel-timer) | 351 | (add-hook 'help-at-pt-unload-hook 'help-at-pt-cancel-timer) |
| 352 | "Normal hook run when `help-at-pt' is unloaded.") | ||
| 353 | 352 | ||
| 354 | (provide 'help-at-pt) | 353 | (provide 'help-at-pt) |
| 355 | 354 | ||
diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index f013f8e3c72..12f29bdac63 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el | |||
| @@ -213,12 +213,20 @@ If a regexp, then it will be matched against the buffer's name. | |||
| 213 | If a function, it will be called with the buffer as an argument, and | 213 | If a function, it will be called with the buffer as an argument, and |
| 214 | should return non-nil if this buffer should be shown. | 214 | should return non-nil if this buffer should be shown. |
| 215 | 215 | ||
| 216 | Viewing of buffers hidden because of these predicates is enabled by | 216 | Viewing of buffers hidden because of these predicates may be customized |
| 217 | giving a non-nil prefix argument to `ibuffer-update'. Note that this | 217 | via `ibuffer-default-display-maybe-show-predicates' and is toggled by |
| 218 | specialized filtering occurs before real filtering." | 218 | giving a non-nil prefix argument to `ibuffer-update'. |
| 219 | Note that this specialized filtering occurs before real filtering." | ||
| 219 | :type '(repeat (choice regexp function)) | 220 | :type '(repeat (choice regexp function)) |
| 220 | :group 'ibuffer) | 221 | :group 'ibuffer) |
| 221 | 222 | ||
| 223 | (defcustom ibuffer-default-display-maybe-show-predicates nil | ||
| 224 | "Non-nil means show buffers that match `ibuffer-maybe-show-predicates'." | ||
| 225 | :type 'boolean | ||
| 226 | :group 'ibuffer) | ||
| 227 | |||
| 228 | (defvar ibuffer-display-maybe-show-predicates nil) | ||
| 229 | |||
| 222 | (defvar ibuffer-current-format nil) | 230 | (defvar ibuffer-current-format nil) |
| 223 | 231 | ||
| 224 | (defcustom ibuffer-movement-cycle t | 232 | (defcustom ibuffer-movement-cycle t |
| @@ -2069,11 +2077,15 @@ If optional arg SILENT is non-nil, do not display progress messages." | |||
| 2069 | 2077 | ||
| 2070 | (defun ibuffer-update (arg &optional silent) | 2078 | (defun ibuffer-update (arg &optional silent) |
| 2071 | "Regenerate the list of all buffers. | 2079 | "Regenerate the list of all buffers. |
| 2072 | Display buffers whose name matches one of `ibuffer-maybe-show-predicates' | 2080 | |
| 2073 | iff arg ARG is non-nil. | 2081 | Prefix arg non-nil means to toggle whether buffers that match |
| 2082 | `ibuffer-maybe-show-predicates' should be displayed. | ||
| 2074 | 2083 | ||
| 2075 | If optional arg SILENT is non-nil, do not display progress messages." | 2084 | If optional arg SILENT is non-nil, do not display progress messages." |
| 2076 | (interactive "P") | 2085 | (interactive "P") |
| 2086 | (if arg | ||
| 2087 | (setq ibuffer-display-maybe-show-predicates | ||
| 2088 | (not ibuffer-display-maybe-show-predicates))) | ||
| 2077 | (ibuffer-forward-line 0) | 2089 | (ibuffer-forward-line 0) |
| 2078 | (let* ((bufs (buffer-list)) | 2090 | (let* ((bufs (buffer-list)) |
| 2079 | (blist (ibuffer-filter-buffers | 2091 | (blist (ibuffer-filter-buffers |
| @@ -2086,7 +2098,7 @@ If optional arg SILENT is non-nil, do not display progress messages." | |||
| 2086 | (caddr bufs) | 2098 | (caddr bufs) |
| 2087 | (cadr bufs)) | 2099 | (cadr bufs)) |
| 2088 | (ibuffer-current-buffers-with-marks bufs) | 2100 | (ibuffer-current-buffers-with-marks bufs) |
| 2089 | arg))) | 2101 | ibuffer-display-maybe-show-predicates))) |
| 2090 | (when (null blist) | 2102 | (when (null blist) |
| 2091 | (if (and (featurep 'ibuf-ext) | 2103 | (if (and (featurep 'ibuf-ext) |
| 2092 | ibuffer-filtering-qualifiers) | 2104 | ibuffer-filtering-qualifiers) |
| @@ -2148,7 +2160,7 @@ If optional arg SILENT is non-nil, do not display progress messages." | |||
| 2148 | 'ibuffer-filter-group | 2160 | 'ibuffer-filter-group |
| 2149 | name))) | 2161 | name))) |
| 2150 | 2162 | ||
| 2151 | (defun ibuffer-redisplay-engine (bmarklist &optional all) | 2163 | (defun ibuffer-redisplay-engine (bmarklist &optional ignore) |
| 2152 | (assert (eq major-mode 'ibuffer-mode)) | 2164 | (assert (eq major-mode 'ibuffer-mode)) |
| 2153 | (let* ((--ibuffer-insert-buffers-and-marks-format | 2165 | (let* ((--ibuffer-insert-buffers-and-marks-format |
| 2154 | (ibuffer-current-format)) | 2166 | (ibuffer-current-format)) |
| @@ -2475,6 +2487,8 @@ will be inserted before the group at point." | |||
| 2475 | ibuffer-default-sorting-reversep) | 2487 | ibuffer-default-sorting-reversep) |
| 2476 | (set (make-local-variable 'ibuffer-shrink-to-minimum-size) | 2488 | (set (make-local-variable 'ibuffer-shrink-to-minimum-size) |
| 2477 | ibuffer-default-shrink-to-minimum-size) | 2489 | ibuffer-default-shrink-to-minimum-size) |
| 2490 | (set (make-local-variable 'ibuffer-display-maybe-show-predicates) | ||
| 2491 | ibuffer-default-display-maybe-show-predicates) | ||
| 2478 | (set (make-local-variable 'ibuffer-filtering-qualifiers) nil) | 2492 | (set (make-local-variable 'ibuffer-filtering-qualifiers) nil) |
| 2479 | (set (make-local-variable 'ibuffer-filter-groups) nil) | 2493 | (set (make-local-variable 'ibuffer-filter-groups) nil) |
| 2480 | (set (make-local-variable 'ibuffer-filter-group-kill-ring) nil) | 2494 | (set (make-local-variable 'ibuffer-filter-group-kill-ring) nil) |
diff --git a/lisp/info.el b/lisp/info.el index 386f5b612ec..17905c6d738 100644 --- a/lisp/info.el +++ b/lisp/info.el | |||
| @@ -3445,7 +3445,8 @@ Preserve text properties." | |||
| 3445 | (fontify-visited-p ; visited nodes need to be re-fontified | 3445 | (fontify-visited-p ; visited nodes need to be re-fontified |
| 3446 | (and Info-fontify-visited-nodes | 3446 | (and Info-fontify-visited-nodes |
| 3447 | ;; Don't take time to refontify visited nodes in huge nodes | 3447 | ;; Don't take time to refontify visited nodes in huge nodes |
| 3448 | (< (- (point-max) (point-min)) Info-fontify-maximum-menu-size)))) | 3448 | (< (- (point-max) (point-min)) Info-fontify-maximum-menu-size))) |
| 3449 | rbeg rend) | ||
| 3449 | 3450 | ||
| 3450 | ;; Fontify header line | 3451 | ;; Fontify header line |
| 3451 | (goto-char (point-min)) | 3452 | (goto-char (point-min)) |
| @@ -3570,39 +3571,48 @@ Preserve text properties." | |||
| 3570 | "mouse-2: go to this node") | 3571 | "mouse-2: go to this node") |
| 3571 | 'mouse-face 'highlight))) | 3572 | 'mouse-face 'highlight))) |
| 3572 | (when (or not-fontified-p fontify-visited-p) | 3573 | (when (or not-fontified-p fontify-visited-p) |
| 3573 | (add-text-properties | 3574 | (setq rbeg (match-beginning 2) |
| 3574 | (match-beginning 2) (match-end 2) | 3575 | rend (match-end 2)) |
| 3575 | (list | 3576 | (put-text-property |
| 3576 | 'font-lock-face | 3577 | rbeg rend |
| 3577 | ;; Display visited nodes in a different face | 3578 | 'font-lock-face |
| 3578 | (if (and Info-fontify-visited-nodes | 3579 | ;; Display visited nodes in a different face |
| 3579 | (save-match-data | 3580 | (if (and Info-fontify-visited-nodes |
| 3580 | (let* ((node (replace-regexp-in-string | 3581 | (save-match-data |
| 3581 | "^[ \t]+" "" | 3582 | (let* ((node (replace-regexp-in-string |
| 3582 | (replace-regexp-in-string | 3583 | "^[ \t]+" "" |
| 3583 | "[ \t\n]+" " " | 3584 | (replace-regexp-in-string |
| 3584 | (or (match-string 5) | 3585 | "[ \t\n]+" " " |
| 3585 | (and (not (equal (match-string 4) "")) | 3586 | (or (match-string 5) |
| 3586 | (match-string 4)) | 3587 | (and (not (equal (match-string 4) "")) |
| 3587 | (match-string 2))))) | 3588 | (match-string 4)) |
| 3588 | (file (file-name-nondirectory | 3589 | (match-string 2))))) |
| 3589 | Info-current-file)) | 3590 | (file (file-name-nondirectory |
| 3590 | (hl Info-history-list) | 3591 | Info-current-file)) |
| 3591 | res) | 3592 | (hl Info-history-list) |
| 3592 | (if (string-match "(\\([^)]+\\))\\([^)]*\\)" node) | 3593 | res) |
| 3593 | (setq file (file-name-nondirectory | 3594 | (if (string-match "(\\([^)]+\\))\\([^)]*\\)" node) |
| 3594 | (match-string 1 node)) | 3595 | (setq file (file-name-nondirectory |
| 3595 | node (if (equal (match-string 2 node) "") | 3596 | (match-string 1 node)) |
| 3596 | "Top" | 3597 | node (if (equal (match-string 2 node) "") |
| 3597 | (match-string 2 node)))) | 3598 | "Top" |
| 3598 | (while hl | 3599 | (match-string 2 node)))) |
| 3599 | (if (and (string-equal node (nth 1 (car hl))) | 3600 | (while hl |
| 3600 | (string-equal file | 3601 | (if (and (string-equal node (nth 1 (car hl))) |
| 3601 | (file-name-nondirectory | 3602 | (string-equal file |
| 3602 | (nth 0 (car hl))))) | 3603 | (file-name-nondirectory |
| 3603 | (setq res (car hl) hl nil) | 3604 | (nth 0 (car hl))))) |
| 3604 | (setq hl (cdr hl)))) | 3605 | (setq res (car hl) hl nil) |
| 3605 | res))) 'info-xref-visited 'info-xref)))) | 3606 | (setq hl (cdr hl)))) |
| 3607 | res))) 'info-xref-visited 'info-xref)) | ||
| 3608 | ;; For multiline ref, unfontify newline and surrounding whitespace | ||
| 3609 | (save-excursion | ||
| 3610 | (goto-char rbeg) | ||
| 3611 | (save-match-data | ||
| 3612 | (while (re-search-forward "\\s-*\n\\s-*" rend t nil) | ||
| 3613 | (remove-text-properties (match-beginning 0) | ||
| 3614 | (match-end 0) | ||
| 3615 | '(font-lock-face t)))))) | ||
| 3606 | (when not-fontified-p | 3616 | (when not-fontified-p |
| 3607 | (when (memq Info-hide-note-references '(t hide)) | 3617 | (when (memq Info-hide-note-references '(t hide)) |
| 3608 | (add-text-properties (match-beginning 3) (match-end 3) | 3618 | (add-text-properties (match-beginning 3) (match-end 3) |
diff --git a/lisp/language/indian.el b/lisp/language/indian.el index a15df9c45aa..e868718bfda 100644 --- a/lisp/language/indian.el +++ b/lisp/language/indian.el | |||
| @@ -45,6 +45,15 @@ | |||
| 45 | Currently supported foundries are `cdac' and `akruti'.") | 45 | Currently supported foundries are `cdac' and `akruti'.") |
| 46 | 46 | ||
| 47 | (defvar indian-script-language-alist | 47 | (defvar indian-script-language-alist |
| 48 | '((devanagari (hindi sanskrit) nil) | ||
| 49 | (bengali (bengali assamese) nil) | ||
| 50 | (gurmukhi (punjabi) nil) | ||
| 51 | (gujarati (gujarati) nil) | ||
| 52 | (oriya (oriya) nil) | ||
| 53 | (tamil (tamil) nil) | ||
| 54 | (telugu (telugu) nil) | ||
| 55 | (kannada (kannada) nil) | ||
| 56 | (malayalam (malayalam) nil)) | ||
| 48 | "Alist of Indian scripts vs the corresponding language list and font foundry. | 57 | "Alist of Indian scripts vs the corresponding language list and font foundry. |
| 49 | Each element has this form: | 58 | Each element has this form: |
| 50 | 59 | ||
| @@ -57,16 +66,7 @@ The list is in the priority order. | |||
| 57 | 66 | ||
| 58 | FONT-FOUNDRY is a font foundry representing a group of Indian | 67 | FONT-FOUNDRY is a font foundry representing a group of Indian |
| 59 | fonts. If the value is nil, the value of `indian-font-foundry' | 68 | fonts. If the value is nil, the value of `indian-font-foundry' |
| 60 | is used." | 69 | is used.") |
| 61 | '((devanagari (hindi sanskrit) nil) | ||
| 62 | (bengali (bengali assamese) nil) | ||
| 63 | (gurmukhi (punjabi) nil) | ||
| 64 | (gujarati (gujarati) nil) | ||
| 65 | (oriya (oriya) nil) | ||
| 66 | (tamil (tamil) nil) | ||
| 67 | (telugu (telugu) nil) | ||
| 68 | (kannada (kannada) nil) | ||
| 69 | (malayalam (malayalam) nil))) | ||
| 70 | 70 | ||
| 71 | (defconst indian-font-char-index-table | 71 | (defconst indian-font-char-index-table |
| 72 | '( ; for which language(s) | 72 | '( ; for which language(s) |
| @@ -94,14 +94,14 @@ is used." | |||
| 94 | (#x1200 . akruti:knd) ; kannada | 94 | (#x1200 . akruti:knd) ; kannada |
| 95 | (#x1300 . akruti:mal) ; malayalam | 95 | (#x1300 . akruti:mal) ; malayalam |
| 96 | ) | 96 | ) |
| 97 | "Aliat of indices of `indian-glyph' character vs Indian font identifiers. | 97 | "Alist of indices of `indian-glyph' character vs Indian font identifiers. |
| 98 | Each element has this form: (INDEX . FONT-IDENTIFIER) | 98 | Each element has this form: (INDEX . FONT-IDENTIFIER) |
| 99 | 99 | ||
| 100 | INDEX is an index number of the first character in the charset | 100 | INDEX is an index number of the first character in the charset |
| 101 | `indian-glyph' assigned for glyphs in the font specified by | 101 | `indian-glyph' assigned for glyphs in the font specified by |
| 102 | FONT-IDENTIFIER. Currently FONT-IDENTIFIERs are defined for CDAC | 102 | FONT-IDENTIFIER. Currently FONT-IDENTIFIERs are defined for CDAC |
| 103 | and AKRUTI font groups.") | 103 | and AKRUTI font groups.") |
| 104 | 104 | ||
| 105 | (defun indian-font-char (index font-identifier) | 105 | (defun indian-font-char (index font-identifier) |
| 106 | "Return character of charset `indian-glyph' made from glyph index INDEX. | 106 | "Return character of charset `indian-glyph' made from glyph index INDEX. |
| 107 | FONT-IDENTIFIER is an identifier of an Indian font listed in the | 107 | FONT-IDENTIFIER is an identifier of an Indian font listed in the |
| @@ -122,7 +122,7 @@ font INDEX is for." | |||
| 122 | (defun indian-font-char-range (font-identifier) | 122 | (defun indian-font-char-range (font-identifier) |
| 123 | (cons (indian-font-char 0 font-identifier) | 123 | (cons (indian-font-char 0 font-identifier) |
| 124 | (indian-font-char 255 font-identifier))) | 124 | (indian-font-char 255 font-identifier))) |
| 125 | 125 | ||
| 126 | (defvar indian-script-table | 126 | (defvar indian-script-table |
| 127 | '[ | 127 | '[ |
| 128 | devanagari | 128 | devanagari |
diff --git a/lisp/mouse.el b/lisp/mouse.el index b73967b99dc..abf62a97836 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el | |||
| @@ -338,6 +338,17 @@ shrink the window or windows above it to make room." | |||
| 338 | (select-window window) | 338 | (select-window window) |
| 339 | (enlarge-window growth nil (> growth 0)))) | 339 | (enlarge-window growth nil (> growth 0)))) |
| 340 | 340 | ||
| 341 | (defsubst mouse-drag-move-window-top (window growth) | ||
| 342 | "Move the top of WINDOW up or down by GROWTH lines. | ||
| 343 | Move it down if GROWTH is positive, or up if GROWTH is negative. | ||
| 344 | If this would make WINDOW too short, shrink the window or windows | ||
| 345 | above it to make room." | ||
| 346 | ;; Moving the top of WINDOW is actually moving the bottom of the | ||
| 347 | ;; window above. | ||
| 348 | (let ((window-above (mouse-drag-window-above window))) | ||
| 349 | (and window-above | ||
| 350 | (mouse-drag-move-window-bottom window-above (- growth))))) | ||
| 351 | |||
| 341 | (defun mouse-drag-mode-line-1 (start-event mode-line-p) | 352 | (defun mouse-drag-mode-line-1 (start-event mode-line-p) |
| 342 | "Change the height of a window by dragging on the mode or header line. | 353 | "Change the height of a window by dragging on the mode or header line. |
| 343 | START-EVENT is the starting mouse-event of the drag action. | 354 | START-EVENT is the starting mouse-event of the drag action. |
| @@ -444,7 +455,9 @@ MODE-LINE-P non-nil means dragging a mode line; nil means a header line." | |||
| 444 | (select-window start-event-window)) | 455 | (select-window start-event-window)) |
| 445 | ;; no. grow/shrink the selected window | 456 | ;; no. grow/shrink the selected window |
| 446 | ;(message "growth = %d" growth) | 457 | ;(message "growth = %d" growth) |
| 447 | (mouse-drag-move-window-bottom start-event-window growth)) | 458 | (if mode-line-p |
| 459 | (mouse-drag-move-window-bottom start-event-window growth) | ||
| 460 | (mouse-drag-move-window-top start-event-window growth))) | ||
| 448 | 461 | ||
| 449 | ;; if this window's growth caused another | 462 | ;; if this window's growth caused another |
| 450 | ;; window to be deleted because it was too | 463 | ;; window to be deleted because it was too |
| @@ -1097,7 +1110,7 @@ and set mark at the beginning. | |||
| 1097 | Prefix arguments are interpreted as with \\[yank]. | 1110 | Prefix arguments are interpreted as with \\[yank]. |
| 1098 | If `mouse-yank-at-point' is non-nil, insert at point | 1111 | If `mouse-yank-at-point' is non-nil, insert at point |
| 1099 | regardless of where you click." | 1112 | regardless of where you click." |
| 1100 | (interactive "e\nP") | 1113 | (interactive "*e\nP") |
| 1101 | ;; Give temporary modes such as isearch a chance to turn off. | 1114 | ;; Give temporary modes such as isearch a chance to turn off. |
| 1102 | (run-hooks 'mouse-leave-buffer-hook) | 1115 | (run-hooks 'mouse-leave-buffer-hook) |
| 1103 | (or mouse-yank-at-point (mouse-set-point click)) | 1116 | (or mouse-yank-at-point (mouse-set-point click)) |
| @@ -1399,7 +1412,7 @@ The function returns a non-nil value if it creates a secondary selection." | |||
| 1399 | Move point to the end of the inserted text. | 1412 | Move point to the end of the inserted text. |
| 1400 | If `mouse-yank-at-point' is non-nil, insert at point | 1413 | If `mouse-yank-at-point' is non-nil, insert at point |
| 1401 | regardless of where you click." | 1414 | regardless of where you click." |
| 1402 | (interactive "e") | 1415 | (interactive "*e") |
| 1403 | ;; Give temporary modes such as isearch a chance to turn off. | 1416 | ;; Give temporary modes such as isearch a chance to turn off. |
| 1404 | (run-hooks 'mouse-leave-buffer-hook) | 1417 | (run-hooks 'mouse-leave-buffer-hook) |
| 1405 | (or mouse-yank-at-point (mouse-set-point click)) | 1418 | (or mouse-yank-at-point (mouse-set-point click)) |
diff --git a/lisp/msb.el b/lisp/msb.el index e352150a57d..2ab7fe5491d 100644 --- a/lisp/msb.el +++ b/lisp/msb.el | |||
| @@ -1153,6 +1153,7 @@ different buffer menu using the function `msb'." | |||
| 1153 | 1153 | ||
| 1154 | (defun msb-unload-hook () | 1154 | (defun msb-unload-hook () |
| 1155 | (msb-mode 0)) | 1155 | (msb-mode 0)) |
| 1156 | (add-hook 'msb-unload-hook 'msb-unload-hook) | ||
| 1156 | 1157 | ||
| 1157 | (provide 'msb) | 1158 | (provide 'msb) |
| 1158 | (eval-after-load "msb" '(run-hooks 'msb-after-load-hook 'msb-after-load-hooks)) | 1159 | (eval-after-load "msb" '(run-hooks 'msb-after-load-hook 'msb-after-load-hooks)) |
diff --git a/lisp/net/password.el b/lisp/net/password.el new file mode 100644 index 00000000000..e8be612ecca --- /dev/null +++ b/lisp/net/password.el | |||
| @@ -0,0 +1,128 @@ | |||
| 1 | ;;; password.el --- Read passwords from user, possibly using a password cache. | ||
| 2 | |||
| 3 | ;; Copyright (C) 1999, 2000, 2003, 2004 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Simon Josefsson <simon@josefsson.org> | ||
| 6 | ;; Created: 2003-12-21 | ||
| 7 | ;; Keywords: password cache passphrase key | ||
| 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 2, or (at your option) | ||
| 14 | ;; 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; see the file COPYING. If not, write to the | ||
| 23 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | ||
| 24 | ;; Boston, MA 02111-1307, USA. | ||
| 25 | |||
| 26 | ;;; Commentary: | ||
| 27 | |||
| 28 | ;; Greatly influenced by pgg.el written by Daiki Ueno, with timer | ||
| 29 | ;; fixes for XEmacs by Katsumi Yamaoka. In fact, this is mostly just | ||
| 30 | ;; a rip-off. | ||
| 31 | ;; | ||
| 32 | ;; (password-read "Password? " "test") | ||
| 33 | ;; ;; Minibuffer prompt for password. | ||
| 34 | ;; => "foo" | ||
| 35 | ;; | ||
| 36 | ;; (password-cache-add "test" "foo") | ||
| 37 | ;; => nil | ||
| 38 | |||
| 39 | ;; Note the previous two can be replaced with: | ||
| 40 | ;; (password-read-and-add "Password? " "test") | ||
| 41 | ;; ;; Minibuffer prompt for password. | ||
| 42 | ;; => "foo" | ||
| 43 | ;; ;; "foo" is now cached with key "test" | ||
| 44 | |||
| 45 | |||
| 46 | ;; (password-read "Password? " "test") | ||
| 47 | ;; ;; No minibuffer prompt | ||
| 48 | ;; => "foo" | ||
| 49 | ;; | ||
| 50 | ;; (password-read "Password? " "test") | ||
| 51 | ;; ;; No minibuffer prompt | ||
| 52 | ;; => "foo" | ||
| 53 | ;; | ||
| 54 | ;; ;; Wait `password-cache-expiry' seconds. | ||
| 55 | ;; | ||
| 56 | ;; (password-read "Password? " "test") | ||
| 57 | ;; ;; Minibuffer prompt for password is back. | ||
| 58 | ;; => "foo" | ||
| 59 | |||
| 60 | ;;; Code: | ||
| 61 | |||
| 62 | (when (featurep 'xemacs) | ||
| 63 | (require 'run-at-time)) | ||
| 64 | |||
| 65 | (eval-when-compile | ||
| 66 | (require 'cl)) | ||
| 67 | |||
| 68 | (defcustom password-cache t | ||
| 69 | "Whether to cache passwords." | ||
| 70 | :group 'password | ||
| 71 | :type 'boolean) | ||
| 72 | |||
| 73 | (defcustom password-cache-expiry 16 | ||
| 74 | "How many seconds passwords are cached, or nil to disable expiring. | ||
| 75 | Whether passwords are cached at all is controlled by `password-cache'." | ||
| 76 | :group 'password | ||
| 77 | :type '(choice (const :tag "Never" nil) | ||
| 78 | (integer :tag "Seconds"))) | ||
| 79 | |||
| 80 | (defvar password-data (make-vector 7 0)) | ||
| 81 | |||
| 82 | (defun password-read (prompt &optional key) | ||
| 83 | "Read password, for use with KEY, from user, or from cache if wanted. | ||
| 84 | KEY indicate the purpose of the password, so the cache can | ||
| 85 | separate passwords. The cache is not used if KEY is nil. It is | ||
| 86 | typically a string. | ||
| 87 | The variable `password-cache' control whether the cache is used." | ||
| 88 | (or (and password-cache | ||
| 89 | key | ||
| 90 | (symbol-value (intern-soft key password-data))) | ||
| 91 | (read-passwd prompt))) | ||
| 92 | |||
| 93 | (defun password-read-and-add (prompt &optional key) | ||
| 94 | "Read password, for use with KEY, from user, or from cache if wanted. | ||
| 95 | Then store the password in the cache. Uses `password-read' and | ||
| 96 | `password-cache-add'." | ||
| 97 | (let ((password (password-read prompt key))) | ||
| 98 | (when (and password key) | ||
| 99 | (password-cache-add key password)) | ||
| 100 | password)) | ||
| 101 | |||
| 102 | (defun password-cache-remove (key) | ||
| 103 | "Remove password indexed by KEY from password cache. | ||
| 104 | This is typically run be a timer setup from `password-cache-add', | ||
| 105 | but can be invoked at any time to forcefully remove passwords | ||
| 106 | from the cache. This may be useful when it has been detected | ||
| 107 | that a password is invalid, so that `password-read' query the | ||
| 108 | user again." | ||
| 109 | (let ((password (symbol-value (intern-soft key password-data)))) | ||
| 110 | (when password | ||
| 111 | (fillarray password ?_) | ||
| 112 | (unintern key password-data)))) | ||
| 113 | |||
| 114 | (defun password-cache-add (key password) | ||
| 115 | "Add password to cache. | ||
| 116 | The password is removed by a timer after `password-cache-expiry' | ||
| 117 | seconds." | ||
| 118 | (set (intern key password-data) password) | ||
| 119 | (when password-cache-expiry | ||
| 120 | (run-at-time password-cache-expiry nil | ||
| 121 | #'password-cache-remove | ||
| 122 | key)) | ||
| 123 | nil) | ||
| 124 | |||
| 125 | (provide 'password) | ||
| 126 | |||
| 127 | ;;; arch-tag: ab160494-16c8-4c68-a4a1-73eebf6686e5 | ||
| 128 | ;;; password.el ends here | ||
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index a30280dbd4f..582ae8ee207 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el | |||
| @@ -2337,45 +2337,46 @@ If it doesn't exist, generate a new one." | |||
| 2337 | ;; This function makes the same assumption as | 2337 | ;; This function makes the same assumption as |
| 2338 | ;; `tramp-handle-set-visited-file-modtime'. | 2338 | ;; `tramp-handle-set-visited-file-modtime'. |
| 2339 | (defun tramp-handle-verify-visited-file-modtime (buf) | 2339 | (defun tramp-handle-verify-visited-file-modtime (buf) |
| 2340 | "Like `verify-visited-file-modtime' for tramp files. | 2340 | "Like `verify-visited-file-modtime' for tramp files." |
| 2341 | At the time `verify-visited-file-modtime' calls this function, we | ||
| 2342 | already know that the buffer is visiting a file and that | ||
| 2343 | `visited-file-modtime' does not return 0. Do not call this | ||
| 2344 | function directly, unless those two cases are already taken care | ||
| 2345 | of." | ||
| 2346 | (with-current-buffer buf | 2341 | (with-current-buffer buf |
| 2347 | (let ((f (buffer-file-name))) | 2342 | ;; There is no file visiting the buffer, or the buffer has no |
| 2348 | (with-parsed-tramp-file-name f nil | 2343 | ;; recorded last modification time. |
| 2349 | (let* ((attr (file-attributes f)) | 2344 | (if (or (not (buffer-file-name)) |
| 2350 | (modtime (nth 5 attr))) | 2345 | (eq (visited-file-modtime) 0)) |
| 2351 | (cond ((and attr (not (equal modtime '(0 0)))) | 2346 | t |
| 2352 | ;; Why does `file-attributes' return a list (HIGH | 2347 | (let ((f (buffer-file-name))) |
| 2353 | ;; LOW), but `visited-file-modtime' returns a cons | 2348 | (with-parsed-tramp-file-name f nil |
| 2354 | ;; (HIGH . LOW)? | 2349 | (let* ((attr (file-attributes f)) |
| 2355 | (let ((mt (visited-file-modtime))) | 2350 | (modtime (nth 5 attr)) |
| 2356 | (< (abs (tramp-time-diff | 2351 | (mt (visited-file-modtime))) |
| 2357 | modtime | 2352 | |
| 2358 | ;; For compatibility, deal with both the old | 2353 | (cond |
| 2359 | ;; (HIGH . LOW) and the new (HIGH LOW) | 2354 | ;; file exists, and has a known modtime. |
| 2360 | ;; return values of `visited-file-modtime'. | 2355 | ((and attr (not (equal modtime '(0 0)))) |
| 2361 | (if (atom (cdr mt)) | 2356 | (< (abs (tramp-time-diff |
| 2362 | (list (car mt) (cdr mt)) | 2357 | modtime |
| 2363 | mt))) | 2358 | ;; For compatibility, deal with both the old |
| 2364 | 2))) | 2359 | ;; (HIGH . LOW) and the new (HIGH LOW) |
| 2365 | (attr | 2360 | ;; return values of `visited-file-modtime'. |
| 2366 | (save-excursion | 2361 | (if (atom (cdr mt)) |
| 2367 | (tramp-send-command | 2362 | (list (car mt) (cdr mt)) |
| 2368 | multi-method method user host | 2363 | mt))) |
| 2369 | (format "%s -ild %s" | 2364 | 2)) |
| 2370 | (tramp-get-ls-command multi-method method | 2365 | ;; modtime has the don't know value. |
| 2371 | user host) | 2366 | (attr |
| 2372 | (tramp-shell-quote-argument localname))) | 2367 | (save-excursion |
| 2373 | (tramp-wait-for-output) | 2368 | (tramp-send-command |
| 2374 | (setq attr (buffer-substring | 2369 | multi-method method user host |
| 2375 | (point) (progn (end-of-line) (point))))) | 2370 | (format "%s -ild %s" |
| 2376 | (equal tramp-buffer-file-attributes attr)) | 2371 | (tramp-get-ls-command multi-method method user host) |
| 2377 | ;; If file does not exist, say it is not modified. | 2372 | (tramp-shell-quote-argument localname))) |
| 2378 | (t nil))))))) | 2373 | (tramp-wait-for-output) |
| 2374 | (setq attr (buffer-substring | ||
| 2375 | (point) (progn (end-of-line) (point))))) | ||
| 2376 | (equal tramp-buffer-file-attributes attr)) | ||
| 2377 | ;; If file does not exist, say it is not modified | ||
| 2378 | ;; if and only if that agrees with the buffer's record. | ||
| 2379 | (t (equal mt '(-1 65535)))))))))) | ||
| 2379 | 2380 | ||
| 2380 | (defadvice clear-visited-file-modtime (after tramp activate) | 2381 | (defadvice clear-visited-file-modtime (after tramp activate) |
| 2381 | "Set `tramp-buffer-file-attributes' back to nil. | 2382 | "Set `tramp-buffer-file-attributes' back to nil. |
diff --git a/lisp/newcomment.el b/lisp/newcomment.el index 5711e7903ad..5a7b7666e89 100644 --- a/lisp/newcomment.el +++ b/lisp/newcomment.el | |||
| @@ -1087,6 +1087,7 @@ Else, call `comment-indent'." | |||
| 1087 | (insert (comment-padleft comment-end add))) | 1087 | (insert (comment-padleft comment-end add))) |
| 1088 | (indent-according-to-mode)))))) | 1088 | (indent-according-to-mode)))))) |
| 1089 | 1089 | ||
| 1090 | ;;;###autoload | ||
| 1090 | (defcustom comment-auto-fill-only-comments nil | 1091 | (defcustom comment-auto-fill-only-comments nil |
| 1091 | "Non-nil means to only auto-fill inside comments. | 1092 | "Non-nil means to only auto-fill inside comments. |
| 1092 | This has no effect in modes that do not define a comment syntax." | 1093 | This has no effect in modes that do not define a comment syntax." |
diff --git a/lisp/outline.el b/lisp/outline.el index 0f7d3b627b0..2d2663b12f2 100644 --- a/lisp/outline.el +++ b/lisp/outline.el | |||
| @@ -808,7 +808,7 @@ Show the heading too, if it is currently invisible." | |||
| 808 | (save-excursion | 808 | (save-excursion |
| 809 | (outline-back-to-heading t) | 809 | (outline-back-to-heading t) |
| 810 | (show-entry) | 810 | (show-entry) |
| 811 | (while (condition-case nil (progn (outline-up-heading 1) (not (bobp))) | 811 | (while (condition-case nil (progn (outline-up-heading 1 t) (not (bobp))) |
| 812 | (error nil)) | 812 | (error nil)) |
| 813 | (outline-flag-region (1- (point)) | 813 | (outline-flag-region (1- (point)) |
| 814 | (save-excursion (forward-line 1) (point)) | 814 | (save-excursion (forward-line 1) (point)) |
diff --git a/lisp/paths.el b/lisp/paths.el index 925dbb06e97..e3fac711b43 100644 --- a/lisp/paths.el +++ b/lisp/paths.el | |||
| @@ -101,11 +101,12 @@ This variable `Info-default-directory-list' is used as the default | |||
| 101 | for initializing `Info-directory-list' when Info is started, unless | 101 | for initializing `Info-directory-list' when Info is started, unless |
| 102 | the environment variable INFOPATH is set.") | 102 | the environment variable INFOPATH is set.") |
| 103 | 103 | ||
| 104 | (defvar news-path | 104 | (defvar news-directory |
| 105 | (if (file-exists-p "/usr/spool/news/") | 105 | (if (file-exists-p "/usr/spool/news/") |
| 106 | "/usr/spool/news/" | 106 | "/usr/spool/news/" |
| 107 | "/var/spool/news/") | 107 | "/var/spool/news/") |
| 108 | "The root directory below which all news files are stored.") | 108 | "The root directory below which all news files are stored.") |
| 109 | (defvaralias 'news-path 'news-directory) | ||
| 109 | 110 | ||
| 110 | (defvar news-inews-program | 111 | (defvar news-inews-program |
| 111 | (cond ((file-exists-p "/usr/bin/inews") "/usr/bin/inews") | 112 | (cond ((file-exists-p "/usr/bin/inews") "/usr/bin/inews") |
| @@ -136,7 +137,7 @@ The `ORGANIZATION' environment variable is used instead if defined.") | |||
| 136 | :group 'rmail | 137 | :group 'rmail |
| 137 | :version "21.1") | 138 | :version "21.1") |
| 138 | 139 | ||
| 139 | (defconst rmail-spool-directory | 140 | (defvar rmail-spool-directory |
| 140 | (cond ((string-match "^[^-]+-[^-]+-sco3.2v4" system-configuration) | 141 | (cond ((string-match "^[^-]+-[^-]+-sco3.2v4" system-configuration) |
| 141 | "/usr/spool/mail/") | 142 | "/usr/spool/mail/") |
| 142 | ;; On The Bull DPX/2 /usr/spool/mail is used although | 143 | ;; On The Bull DPX/2 /usr/spool/mail is used although |
| @@ -157,15 +158,17 @@ The `ORGANIZATION' environment variable is used instead if defined.") | |||
| 157 | "Name of directory used by system mailer for delivering new mail. | 158 | "Name of directory used by system mailer for delivering new mail. |
| 158 | Its name should end with a slash.") | 159 | Its name should end with a slash.") |
| 159 | 160 | ||
| 160 | (defconst sendmail-program | 161 | (defcustom sendmail-program |
| 161 | (cond | 162 | (cond |
| 162 | ((file-exists-p "/usr/sbin/sendmail") "/usr/sbin/sendmail") | 163 | ((file-exists-p "/usr/sbin/sendmail") "/usr/sbin/sendmail") |
| 163 | ((file-exists-p "/usr/lib/sendmail") "/usr/lib/sendmail") | 164 | ((file-exists-p "/usr/lib/sendmail") "/usr/lib/sendmail") |
| 164 | ((file-exists-p "/usr/ucblib/sendmail") "/usr/ucblib/sendmail") | 165 | ((file-exists-p "/usr/ucblib/sendmail") "/usr/ucblib/sendmail") |
| 165 | (t "fakemail")) ;In ../etc, to interface to /bin/mail. | 166 | (t "fakemail")) ;In ../etc, to interface to /bin/mail. |
| 166 | "Program used to send messages.") | 167 | "Program used to send messages." |
| 168 | :group 'mail | ||
| 169 | :type 'file) | ||
| 167 | 170 | ||
| 168 | (defconst remote-shell-program | 171 | (defcustom remote-shell-program |
| 169 | (cond | 172 | (cond |
| 170 | ;; Some systems use rsh for the remote shell; others use that name for the | 173 | ;; Some systems use rsh for the remote shell; others use that name for the |
| 171 | ;; restricted shell and use remsh for the remote shell. Let's try to guess | 174 | ;; restricted shell and use remsh for the remote shell. Let's try to guess |
| @@ -186,14 +189,16 @@ Its name should end with a slash.") | |||
| 186 | ((file-exists-p "/bin/rsh") "/bin/rsh") | 189 | ((file-exists-p "/bin/rsh") "/bin/rsh") |
| 187 | ((file-exists-p "/usr/bin/rsh") "/usr/bin/rsh") | 190 | ((file-exists-p "/usr/bin/rsh") "/usr/bin/rsh") |
| 188 | (t "rsh")) | 191 | (t "rsh")) |
| 189 | "File name for remote-shell program (often rsh or remsh).") | 192 | "File name for remote-shell program (often rsh or remsh)." |
| 193 | :group 'environment | ||
| 194 | :type 'file) | ||
| 190 | 195 | ||
| 191 | (defconst term-file-prefix (if (eq system-type 'vax-vms) "[.term]" "term/") "\ | 196 | (defvar term-file-prefix (if (eq system-type 'vax-vms) "[.term]" "term/") "\ |
| 192 | If non-nil, Emacs startup does (load (concat term-file-prefix (getenv \"TERM\"))) | 197 | If non-nil, Emacs startup does (load (concat term-file-prefix (getenv \"TERM\"))) |
| 193 | You may set this variable to nil in your `.emacs' file if you do not wish | 198 | You may set this variable to nil in your `.emacs' file if you do not wish |
| 194 | the terminal-initialization file to be loaded.") | 199 | the terminal-initialization file to be loaded.") |
| 195 | 200 | ||
| 196 | (defconst abbrev-file-name | 201 | (defvar abbrev-file-name |
| 197 | (if (eq system-type 'vax-vms) | 202 | (if (eq system-type 'vax-vms) |
| 198 | "~/abbrev.def" | 203 | "~/abbrev.def" |
| 199 | (convert-standard-filename "~/.abbrev_defs")) | 204 | (convert-standard-filename "~/.abbrev_defs")) |
diff --git a/lisp/pcvs-defs.el b/lisp/pcvs-defs.el index cd379afab77..6bdd6bb6dd8 100644 --- a/lisp/pcvs-defs.el +++ b/lisp/pcvs-defs.el | |||
| @@ -374,7 +374,7 @@ This variable is buffer local and only used in the *cvs* buffer.") | |||
| 374 | ("r" . cvs-mode-remove) | 374 | ("r" . cvs-mode-remove) |
| 375 | ("s" . cvs-mode-status) | 375 | ("s" . cvs-mode-status) |
| 376 | ("t" . cvs-mode-tag) | 376 | ("t" . cvs-mode-tag) |
| 377 | ;;("v" . cvs-mode-diff-vendor) | 377 | ("v" . cvs-mode-view-file) |
| 378 | ("x" . cvs-mode-remove-handled) | 378 | ("x" . cvs-mode-remove-handled) |
| 379 | ;; cvstree bindings | 379 | ;; cvstree bindings |
| 380 | ("+" . cvs-mode-tree) | 380 | ("+" . cvs-mode-tree) |
diff --git a/lisp/pcvs-util.el b/lisp/pcvs-util.el index 5d9d0d215af..a4eda95e23e 100644 --- a/lisp/pcvs-util.el +++ b/lisp/pcvs-util.el | |||
| @@ -104,11 +104,12 @@ BUF is assumed to be a temporary buffer used from the buffer MAINBUF." | |||
| 104 | (condition-case () | 104 | (condition-case () |
| 105 | (delete-window win) | 105 | (delete-window win) |
| 106 | (error (iconify-frame (window-frame win)))) | 106 | (error (iconify-frame (window-frame win)))) |
| 107 | (if (and mainbuf (get-buffer-window mainbuf)) | 107 | ;;; (if (and mainbuf (get-buffer-window mainbuf)) |
| 108 | ;; FIXME: if the buffer popped into a pre-existing window, | 108 | ;;; ;; FIXME: if the buffer popped into a pre-existing window, |
| 109 | ;; we don't want to delete that window. | 109 | ;;; ;; we don't want to delete that window. |
| 110 | t ;;(delete-window win) | 110 | ;;; t ;;(delete-window win) |
| 111 | )))) | 111 | ;;; ) |
| 112 | ))) | ||
| 112 | (with-current-buffer buf | 113 | (with-current-buffer buf |
| 113 | (bury-buffer (unless (and (eq buf (window-buffer (selected-window))) | 114 | (bury-buffer (unless (and (eq buf (window-buffer (selected-window))) |
| 114 | (not (window-dedicated-p (selected-window)))) | 115 | (not (window-dedicated-p (selected-window)))) |
diff --git a/lisp/pcvs.el b/lisp/pcvs.el index 120acbbc2bc..0a666927c52 100644 --- a/lisp/pcvs.el +++ b/lisp/pcvs.el | |||
| @@ -1925,6 +1925,18 @@ to hear about anymore." | |||
| 1925 | (cvs-mode-find-file e 'dont-select)) | 1925 | (cvs-mode-find-file e 'dont-select)) |
| 1926 | 1926 | ||
| 1927 | 1927 | ||
| 1928 | (defun cvs-mode-view-file (e) | ||
| 1929 | "View the file." | ||
| 1930 | (interactive (list last-input-event)) | ||
| 1931 | (cvs-mode-find-file e nil t)) | ||
| 1932 | |||
| 1933 | |||
| 1934 | (defun cvs-mode-view-file-other-window (e) | ||
| 1935 | "View the file." | ||
| 1936 | (interactive (list last-input-event)) | ||
| 1937 | (cvs-mode-find-file e t t)) | ||
| 1938 | |||
| 1939 | |||
| 1928 | (defun cvs-find-modif (fi) | 1940 | (defun cvs-find-modif (fi) |
| 1929 | (with-temp-buffer | 1941 | (with-temp-buffer |
| 1930 | (call-process cvs-program nil (current-buffer) nil | 1942 | (call-process cvs-program nil (current-buffer) nil |
| @@ -1935,7 +1947,7 @@ to hear about anymore." | |||
| 1935 | 1))) | 1947 | 1))) |
| 1936 | 1948 | ||
| 1937 | 1949 | ||
| 1938 | (defun cvs-mode-find-file (e &optional other) | 1950 | (defun cvs-mode-find-file (e &optional other view) |
| 1939 | "Select a buffer containing the file. | 1951 | "Select a buffer containing the file. |
| 1940 | With a prefix, opens the buffer in an OTHER window." | 1952 | With a prefix, opens the buffer in an OTHER window." |
| 1941 | (interactive (list last-input-event current-prefix-arg)) | 1953 | (interactive (list last-input-event current-prefix-arg)) |
| @@ -1963,8 +1975,10 @@ With a prefix, opens the buffer in an OTHER window." | |||
| 1963 | (let ((buf (if rev (cvs-retrieve-revision fi rev) | 1975 | (let ((buf (if rev (cvs-retrieve-revision fi rev) |
| 1964 | (find-file-noselect (cvs-fileinfo->full-path fi))))) | 1976 | (find-file-noselect (cvs-fileinfo->full-path fi))))) |
| 1965 | (funcall (cond ((eq other 'dont-select) 'display-buffer) | 1977 | (funcall (cond ((eq other 'dont-select) 'display-buffer) |
| 1966 | (other 'switch-to-buffer-other-window) | 1978 | (other |
| 1967 | (t 'switch-to-buffer)) | 1979 | (if view 'view-buffer-other-window |
| 1980 | 'switch-to-buffer-other-window)) | ||
| 1981 | (t (if view 'view-buffer 'switch-to-buffer))) | ||
| 1968 | buf) | 1982 | buf) |
| 1969 | (when (and cvs-find-file-and-jump (cvs-applicable-p fi 'diff-base)) | 1983 | (when (and cvs-find-file-and-jump (cvs-applicable-p fi 'diff-base)) |
| 1970 | (goto-line (cvs-find-modif fi))) | 1984 | (goto-line (cvs-find-modif fi))) |
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 2f910608d5c..0dc73e96664 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el | |||
| @@ -866,24 +866,7 @@ Returns the compilation buffer created." | |||
| 866 | (if (eq mode t) | 866 | (if (eq mode t) |
| 867 | (prog1 "compilation" (require 'comint)) | 867 | (prog1 "compilation" (require 'comint)) |
| 868 | (replace-regexp-in-string "-mode$" "" (symbol-name mode)))) | 868 | (replace-regexp-in-string "-mode$" "" (symbol-name mode)))) |
| 869 | (process-environment | 869 | (thisdir default-directory) |
| 870 | (append | ||
| 871 | compilation-environment | ||
| 872 | (if (if (boundp 'system-uses-terminfo) ; `if' for compiler warning | ||
| 873 | system-uses-terminfo) | ||
| 874 | (list "TERM=dumb" "TERMCAP=" | ||
| 875 | (format "COLUMNS=%d" (window-width))) | ||
| 876 | (list "TERM=emacs" | ||
| 877 | (format "TERMCAP=emacs:co#%d:tc=unknown:" | ||
| 878 | (window-width)))) | ||
| 879 | ;; Set the EMACS variable, but | ||
| 880 | ;; don't override users' setting of $EMACS. | ||
| 881 | (unless (getenv "EMACS") '("EMACS=t")) | ||
| 882 | (copy-sequence process-environment))) | ||
| 883 | cd-path ; in case process-environment contains CDPATH | ||
| 884 | (thisdir (if (string-match "^\\s *cd\\s +\\(.+?\\)\\s *[;&\n]" command) | ||
| 885 | (substitute-in-file-name (match-string 1 command)) | ||
| 886 | default-directory)) | ||
| 887 | outwin outbuf) | 870 | outwin outbuf) |
| 888 | (with-current-buffer | 871 | (with-current-buffer |
| 889 | (setq outbuf | 872 | (setq outbuf |
| @@ -903,18 +886,26 @@ Returns the compilation buffer created." | |||
| 903 | (error nil)) | 886 | (error nil)) |
| 904 | (error "Cannot have two processes in `%s' at once" | 887 | (error "Cannot have two processes in `%s' at once" |
| 905 | (buffer-name))))) | 888 | (buffer-name))))) |
| 906 | ;; Clear out the compilation buffer and make it writable. | ||
| 907 | ;; Change its default-directory to the directory where the compilation | ||
| 908 | ;; will happen, and insert a `default-directory' to indicate this. | ||
| 909 | (setq buffer-read-only nil) | ||
| 910 | (buffer-disable-undo (current-buffer)) | 889 | (buffer-disable-undo (current-buffer)) |
| 911 | (erase-buffer) | 890 | ;; first transfer directory from where M-x compile was called |
| 912 | (buffer-enable-undo (current-buffer)) | 891 | (setq default-directory thisdir) |
| 913 | (cd thisdir) | 892 | ;; Make compilation buffer read-only. The filter can still write it. |
| 914 | ;; output a mode setter, for saving and later reloading this buffer | 893 | ;; Clear out the compilation buffer. |
| 915 | (insert "-*- mode: " name-of-mode | 894 | (let ((inhibit-read-only t) |
| 916 | "; default-directory: " (prin1-to-string default-directory) | 895 | (default-directory thisdir)) |
| 917 | " -*-\n" command "\n") | 896 | ;; Then evaluate a cd command if any, but don't perform it yet, else start-command |
| 897 | ;; would do it again through the shell: (cd "..") AND sh -c "cd ..; make" | ||
| 898 | (cd (if (string-match "^\\s *cd\\(?:\\s +\\(\\S +?\\)\\)?\\s *[;&\n]" command) | ||
| 899 | (if (match-end 1) | ||
| 900 | (match-string 1 command) | ||
| 901 | "~") | ||
| 902 | default-directory)) | ||
| 903 | (erase-buffer) | ||
| 904 | ;; output a mode setter, for saving and later reloading this buffer | ||
| 905 | (insert "-*- mode: " name-of-mode | ||
| 906 | "; default-directory: " (prin1-to-string default-directory) | ||
| 907 | " -*-\n" command "\n") | ||
| 908 | (setq thisdir default-directory)) | ||
| 918 | (set-buffer-modified-p nil)) | 909 | (set-buffer-modified-p nil)) |
| 919 | ;; If we're already in the compilation buffer, go to the end | 910 | ;; If we're already in the compilation buffer, go to the end |
| 920 | ;; of the buffer, so point will track the compilation output. | 911 | ;; of the buffer, so point will track the compilation output. |
| @@ -923,70 +914,85 @@ Returns the compilation buffer created." | |||
| 923 | ;; Pop up the compilation buffer. | 914 | ;; Pop up the compilation buffer. |
| 924 | (setq outwin (display-buffer outbuf nil t)) | 915 | (setq outwin (display-buffer outbuf nil t)) |
| 925 | (with-current-buffer outbuf | 916 | (with-current-buffer outbuf |
| 926 | (if (not (eq mode t)) | 917 | (let ((process-environment |
| 927 | (funcall mode) | 918 | (append |
| 928 | (with-no-warnings (comint-mode)) | 919 | compilation-environment |
| 929 | (compilation-shell-minor-mode)) | 920 | (if (if (boundp 'system-uses-terminfo) ; `if' for compiler warning |
| 930 | ;; In what way is it non-ergonomic ? -stef | 921 | system-uses-terminfo) |
| 931 | ;; (toggle-read-only 1) ;;; Non-ergonomic. | 922 | (list "TERM=dumb" "TERMCAP=" |
| 932 | (if highlight-regexp | 923 | (format "COLUMNS=%d" (window-width))) |
| 933 | (set (make-local-variable 'compilation-highlight-regexp) | 924 | (list "TERM=emacs" |
| 934 | highlight-regexp)) | 925 | (format "TERMCAP=emacs:co#%d:tc=unknown:" |
| 935 | (set (make-local-variable 'compilation-arguments) | 926 | (window-width)))) |
| 936 | (list command mode name-function highlight-regexp)) | 927 | ;; Set the EMACS variable, but |
| 937 | (set (make-local-variable 'revert-buffer-function) | 928 | ;; don't override users' setting of $EMACS. |
| 938 | 'compilation-revert-buffer) | 929 | (unless (getenv "EMACS") '("EMACS=t")) |
| 939 | (set-window-start outwin (point-min)) | 930 | (copy-sequence process-environment)))) |
| 940 | (or (eq outwin (selected-window)) | 931 | (if (not (eq mode t)) |
| 941 | (set-window-point outwin (if compilation-scroll-output | 932 | (funcall mode) |
| 942 | (point) | 933 | (setq buffer-read-only nil) |
| 943 | (point-min)))) | 934 | (with-no-warnings (comint-mode)) |
| 944 | ;; The setup function is called before compilation-set-window-height | 935 | (compilation-shell-minor-mode)) |
| 945 | ;; so it can set the compilation-window-height buffer locally. | 936 | (if highlight-regexp |
| 946 | (if compilation-process-setup-function | 937 | (set (make-local-variable 'compilation-highlight-regexp) |
| 947 | (funcall compilation-process-setup-function)) | 938 | highlight-regexp)) |
| 948 | (compilation-set-window-height outwin) | 939 | (set (make-local-variable 'compilation-arguments) |
| 949 | ;; Start the compilation. | 940 | (list command mode name-function highlight-regexp)) |
| 950 | (if (fboundp 'start-process) | 941 | (set (make-local-variable 'revert-buffer-function) |
| 951 | (let ((proc (if (eq mode t) | 942 | 'compilation-revert-buffer) |
| 952 | (get-buffer-process | 943 | (set-window-start outwin (point-min)) |
| 953 | (with-no-warnings | 944 | (or (eq outwin (selected-window)) |
| 954 | (comint-exec outbuf (downcase mode-name) | 945 | (set-window-point outwin (if compilation-scroll-output |
| 955 | shell-file-name nil `("-c" ,command)))) | 946 | (point) |
| 956 | (start-process-shell-command (downcase mode-name) | 947 | (point-min)))) |
| 957 | outbuf command)))) | 948 | ;; The setup function is called before compilation-set-window-height |
| 958 | ;; Make the buffer's mode line show process state. | 949 | ;; so it can set the compilation-window-height buffer locally. |
| 959 | (setq mode-line-process '(":%s")) | 950 | (if compilation-process-setup-function |
| 960 | (set-process-sentinel proc 'compilation-sentinel) | 951 | (funcall compilation-process-setup-function)) |
| 961 | (set-process-filter proc 'compilation-filter) | 952 | (compilation-set-window-height outwin) |
| 962 | (set-marker (process-mark proc) (point) outbuf) | 953 | ;; Start the compilation. |
| 963 | (setq compilation-in-progress | 954 | (if (fboundp 'start-process) |
| 964 | (cons proc compilation-in-progress))) | 955 | (let ((proc (if (eq mode t) |
| 965 | ;; No asynchronous processes available. | 956 | (get-buffer-process |
| 966 | (message "Executing `%s'..." command) | 957 | (with-no-warnings |
| 967 | ;; Fake modeline display as if `start-process' were run. | 958 | (comint-exec outbuf (downcase mode-name) |
| 968 | (setq mode-line-process ":run") | 959 | shell-file-name nil `("-c" ,command)))) |
| 969 | (force-mode-line-update) | 960 | (start-process-shell-command (downcase mode-name) |
| 970 | (sit-for 0) ; Force redisplay | 961 | outbuf command)))) |
| 971 | (let ((status (call-process shell-file-name nil outbuf nil "-c" | 962 | ;; Make the buffer's mode line show process state. |
| 972 | command))) | 963 | (setq mode-line-process '(":%s")) |
| 973 | (cond ((numberp status) | 964 | (set-process-sentinel proc 'compilation-sentinel) |
| 974 | (compilation-handle-exit 'exit status | 965 | (set-process-filter proc 'compilation-filter) |
| 975 | (if (zerop status) | 966 | (set-marker (process-mark proc) (point) outbuf) |
| 976 | "finished\n" | 967 | (setq compilation-in-progress |
| 977 | (format "\ | 968 | (cons proc compilation-in-progress))) |
| 969 | ;; No asynchronous processes available. | ||
| 970 | (message "Executing `%s'..." command) | ||
| 971 | ;; Fake modeline display as if `start-process' were run. | ||
| 972 | (setq mode-line-process ":run") | ||
| 973 | (force-mode-line-update) | ||
| 974 | (sit-for 0) ; Force redisplay | ||
| 975 | (let ((status (call-process shell-file-name nil outbuf nil "-c" | ||
| 976 | command))) | ||
| 977 | (cond ((numberp status) | ||
| 978 | (compilation-handle-exit 'exit status | ||
| 979 | (if (zerop status) | ||
| 980 | "finished\n" | ||
| 981 | (format "\ | ||
| 978 | exited abnormally with code %d\n" | 982 | exited abnormally with code %d\n" |
| 979 | status)))) | 983 | status)))) |
| 980 | ((stringp status) | 984 | ((stringp status) |
| 981 | (compilation-handle-exit 'signal status | 985 | (compilation-handle-exit 'signal status |
| 982 | (concat status "\n"))) | 986 | (concat status "\n"))) |
| 983 | (t | 987 | (t |
| 984 | (compilation-handle-exit 'bizarre status status)))) | 988 | (compilation-handle-exit 'bizarre status status)))) |
| 985 | ;; Without async subprocesses, the buffer is not yet | 989 | ;; Without async subprocesses, the buffer is not yet |
| 986 | ;; fontified, so fontify it now. | 990 | ;; fontified, so fontify it now. |
| 987 | (let ((font-lock-verbose nil)) ; shut up font-lock messages | 991 | (let ((font-lock-verbose nil)) ; shut up font-lock messages |
| 988 | (font-lock-fontify-buffer)) | 992 | (font-lock-fontify-buffer)) |
| 989 | (message "Executing `%s'...done" command))) | 993 | (message "Executing `%s'...done" command))) |
| 994 | ;; Now finally cd to where the shell started make/grep/... | ||
| 995 | (setq default-directory thisdir)) | ||
| 990 | (if (buffer-local-value 'compilation-scroll-output outbuf) | 996 | (if (buffer-local-value 'compilation-scroll-output outbuf) |
| 991 | (save-selected-window | 997 | (save-selected-window |
| 992 | (select-window outwin) | 998 | (select-window outwin) |
| @@ -1108,7 +1114,7 @@ from a different message." | |||
| 1108 | :version "21.4") | 1114 | :version "21.4") |
| 1109 | 1115 | ||
| 1110 | ;;;###autoload | 1116 | ;;;###autoload |
| 1111 | (defun compilation-mode () | 1117 | (defun compilation-mode (&optional name-of-mode) |
| 1112 | "Major mode for compilation log buffers. | 1118 | "Major mode for compilation log buffers. |
| 1113 | \\<compilation-mode-map>To visit the source for a line-numbered error, | 1119 | \\<compilation-mode-map>To visit the source for a line-numbered error, |
| 1114 | move point to the error message line and type \\[compile-goto-error]. | 1120 | move point to the error message line and type \\[compile-goto-error]. |
| @@ -1121,7 +1127,7 @@ Runs `compilation-mode-hook' with `run-hooks' (which see). | |||
| 1121 | (kill-all-local-variables) | 1127 | (kill-all-local-variables) |
| 1122 | (use-local-map compilation-mode-map) | 1128 | (use-local-map compilation-mode-map) |
| 1123 | (setq major-mode 'compilation-mode | 1129 | (setq major-mode 'compilation-mode |
| 1124 | mode-name "Compilation") | 1130 | mode-name (or name-of-mode "Compilation")) |
| 1125 | (set (make-local-variable 'page-delimiter) | 1131 | (set (make-local-variable 'page-delimiter) |
| 1126 | compilation-page-delimiter) | 1132 | compilation-page-delimiter) |
| 1127 | (compilation-setup) | 1133 | (compilation-setup) |
| @@ -1187,6 +1193,8 @@ If nil, use the beginning of buffer.") | |||
| 1187 | "Prepare the buffer for the compilation parsing commands to work. | 1193 | "Prepare the buffer for the compilation parsing commands to work. |
| 1188 | Optional argument MINOR indicates this is called from | 1194 | Optional argument MINOR indicates this is called from |
| 1189 | `compilation-minor-mode'." | 1195 | `compilation-minor-mode'." |
| 1196 | (unless minor | ||
| 1197 | (setq buffer-read-only t)) | ||
| 1190 | (make-local-variable 'compilation-current-error) | 1198 | (make-local-variable 'compilation-current-error) |
| 1191 | (make-local-variable 'compilation-messages-start) | 1199 | (make-local-variable 'compilation-messages-start) |
| 1192 | (make-local-variable 'compilation-error-screen-columns) | 1200 | (make-local-variable 'compilation-error-screen-columns) |
| @@ -1248,7 +1256,7 @@ Turning the mode on runs the normal hook `compilation-minor-mode-hook'." | |||
| 1248 | 1256 | ||
| 1249 | (defun compilation-handle-exit (process-status exit-status msg) | 1257 | (defun compilation-handle-exit (process-status exit-status msg) |
| 1250 | "Write MSG in the current buffer and hack its mode-line-process." | 1258 | "Write MSG in the current buffer and hack its mode-line-process." |
| 1251 | (let ((buffer-read-only nil) | 1259 | (let ((inhibit-read-only t) |
| 1252 | (status (if compilation-exit-message-function | 1260 | (status (if compilation-exit-message-function |
| 1253 | (funcall compilation-exit-message-function | 1261 | (funcall compilation-exit-message-function |
| 1254 | process-status exit-status msg) | 1262 | process-status exit-status msg) |
diff --git a/lisp/server.el b/lisp/server.el index 3a330f07a3c..534ba9fa09e 100644 --- a/lisp/server.el +++ b/lisp/server.el | |||
| @@ -631,6 +631,8 @@ Arg NEXT-BUFFER is a suggestion; if it is a live buffer, use it." | |||
| 631 | (remove-hook 'kill-buffer-query-functions 'server-kill-buffer-query-function) | 631 | (remove-hook 'kill-buffer-query-functions 'server-kill-buffer-query-function) |
| 632 | (remove-hook 'kill-emacs-query-functions 'server-kill-emacs-query-function) | 632 | (remove-hook 'kill-emacs-query-functions 'server-kill-emacs-query-function) |
| 633 | (remove-hook 'kill-buffer-hook 'server-kill-buffer)) | 633 | (remove-hook 'kill-buffer-hook 'server-kill-buffer)) |
| 634 | |||
| 635 | (add-hook 'server-unload-hook 'server-unload-hook) | ||
| 634 | 636 | ||
| 635 | (provide 'server) | 637 | (provide 'server) |
| 636 | 638 | ||
diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el index b3427ac59e5..f047223cbae 100644 --- a/lisp/shadowfile.el +++ b/lisp/shadowfile.el | |||
| @@ -837,6 +837,8 @@ look for files that have been changed and need to be copied to other systems." | |||
| 837 | (symbol-function 'shadow-orig-save-buffers-kill-emacs))) | 837 | (symbol-function 'shadow-orig-save-buffers-kill-emacs))) |
| 838 | (remove-hook 'write-file-hooks 'shadow-add-to-todo)) | 838 | (remove-hook 'write-file-hooks 'shadow-add-to-todo)) |
| 839 | 839 | ||
| 840 | (add-hook 'shadowfile-unload-hook 'shadowfile-unload-hook) | ||
| 841 | |||
| 840 | (provide 'shadowfile) | 842 | (provide 'shadowfile) |
| 841 | 843 | ||
| 842 | ;;; arch-tag: e2f4cdd7-2bab-4def-9130-9e69b412b79e | 844 | ;;; arch-tag: e2f4cdd7-2bab-4def-9130-9e69b412b79e |
diff --git a/lisp/startup.el b/lisp/startup.el index 5e9247d483b..b08617a9fef 100644 --- a/lisp/startup.el +++ b/lisp/startup.el | |||
| @@ -1156,7 +1156,7 @@ where FACE is a valid face specification, as it can be used with | |||
| 1156 | (emacs-version) | 1156 | (emacs-version) |
| 1157 | "\n" | 1157 | "\n" |
| 1158 | :face '(variable-pitch :height 0.5) | 1158 | :face '(variable-pitch :height 0.5) |
| 1159 | "Copyright (C) 2002 Free Software Foundation, Inc.") | 1159 | "Copyright (C) 2004 Free Software Foundation, Inc.") |
| 1160 | (and auto-save-list-file-prefix | 1160 | (and auto-save-list-file-prefix |
| 1161 | ;; Don't signal an error if the | 1161 | ;; Don't signal an error if the |
| 1162 | ;; directory for auto-save-list files | 1162 | ;; directory for auto-save-list files |
| @@ -1322,7 +1322,7 @@ More Manuals / Ordering Manuals How to order printed manuals from the FSF. | |||
| 1322 | ") | 1322 | ") |
| 1323 | (insert "\n\n" (emacs-version) | 1323 | (insert "\n\n" (emacs-version) |
| 1324 | " | 1324 | " |
| 1325 | Copyright (C) 2002 Free Software Foundation, Inc.")) | 1325 | Copyright (C) 2004 Free Software Foundation, Inc.")) |
| 1326 | 1326 | ||
| 1327 | ;; No mouse menus, so give help using kbd commands. | 1327 | ;; No mouse menus, so give help using kbd commands. |
| 1328 | 1328 | ||
| @@ -1370,7 +1370,7 @@ If you have no Meta key, you may instead type ESC followed by the character.)") | |||
| 1370 | 1370 | ||
| 1371 | (insert "\n\n" (emacs-version) | 1371 | (insert "\n\n" (emacs-version) |
| 1372 | " | 1372 | " |
| 1373 | Copyright (C) 2002 Free Software Foundation, Inc.") | 1373 | Copyright (C) 2004 Free Software Foundation, Inc.") |
| 1374 | 1374 | ||
| 1375 | (if (and (eq (key-binding "\C-h\C-c") 'describe-copying) | 1375 | (if (and (eq (key-binding "\C-h\C-c") 'describe-copying) |
| 1376 | (eq (key-binding "\C-h\C-d") 'describe-distribution) | 1376 | (eq (key-binding "\C-h\C-d") 'describe-distribution) |
diff --git a/lisp/strokes.el b/lisp/strokes.el index cd3e82c4d3c..57f1e3355b2 100644 --- a/lisp/strokes.el +++ b/lisp/strokes.el | |||
| @@ -1354,7 +1354,8 @@ If STROKES-MAP is not given, `strokes-global-map' will be used instead." | |||
| 1354 | :color-symbols | 1354 | :color-symbols |
| 1355 | `(("foreground" | 1355 | `(("foreground" |
| 1356 | . ,(frame-parameter nil 'foreground-color)))))) | 1356 | . ,(frame-parameter nil 'foreground-color)))))) |
| 1357 | finally do (kill-region (1+ (point)) (point-max))) | 1357 | finally do (unless (eobp) |
| 1358 | (kill-region (1+ (point)) (point-max)))) | ||
| 1358 | (view-buffer "*Strokes List*" nil) | 1359 | (view-buffer "*Strokes List*" nil) |
| 1359 | (set (make-local-variable 'view-mode-map) | 1360 | (set (make-local-variable 'view-mode-map) |
| 1360 | (let ((map (copy-keymap view-mode-map))) | 1361 | (let ((map (copy-keymap view-mode-map))) |
| @@ -1745,6 +1746,8 @@ Store XPM in buffer BUFNAME if supplied \(default is ` *strokes-xpm*'\)" | |||
| 1745 | (strokes-mode -1) | 1746 | (strokes-mode -1) |
| 1746 | (remove-hook 'kill-emacs-query-functions 'strokes-prompt-user-save-strokes)) | 1747 | (remove-hook 'kill-emacs-query-functions 'strokes-prompt-user-save-strokes)) |
| 1747 | 1748 | ||
| 1749 | (add-hooks 'strokes-unload-hook 'strokes-unload-hook) | ||
| 1750 | |||
| 1748 | (run-hooks 'strokes-load-hook) | 1751 | (run-hooks 'strokes-load-hook) |
| 1749 | (provide 'strokes) | 1752 | (provide 'strokes) |
| 1750 | 1753 | ||
diff --git a/lisp/subr.el b/lisp/subr.el index eb4577b1a8d..5e162ef5c83 100644 --- a/lisp/subr.el +++ b/lisp/subr.el | |||
| @@ -1212,51 +1212,59 @@ any other non-digit terminates the character code and is then used as input.")) | |||
| 1212 | code)) | 1212 | code)) |
| 1213 | 1213 | ||
| 1214 | (defun read-passwd (prompt &optional confirm default) | 1214 | (defun read-passwd (prompt &optional confirm default) |
| 1215 | "Read a password, prompting with PROMPT. Echo `.' for each character typed. | 1215 | "Read a password, prompting with PROMPT, and return it. |
| 1216 | End with RET, LFD, or ESC. DEL or C-h rubs out. C-u kills line. | 1216 | If optional CONFIRM is non-nil, read the password twice to make sure. |
| 1217 | If optional CONFIRM is non-nil, read password twice to make sure. | 1217 | Optional DEFAULT is a default password to use instead of empty input. |
| 1218 | Optional DEFAULT is a default password to use instead of empty input." | 1218 | |
| 1219 | (if confirm | 1219 | This function echoes `.' for each character that the user types. |
| 1220 | (let (success) | 1220 | The user ends with RET, LFD, or ESC. DEL or C-h rubs out. C-u kills line. |
| 1221 | (while (not success) | 1221 | C-g quits; if `inhibit-quit' was non-nil around this function, |
| 1222 | (let ((first (read-passwd prompt nil default)) | 1222 | then it returns nil if the user types C-g. |
| 1223 | (second (read-passwd "Confirm password: " nil default))) | 1223 | |
| 1224 | (if (equal first second) | 1224 | Once the caller uses the password, it can erase the password |
| 1225 | (progn | 1225 | by doing (clear-string STRING)." |
| 1226 | (and (arrayp second) (clear-string second)) | 1226 | (with-local-quit |
| 1227 | (setq success first)) | 1227 | (if confirm |
| 1228 | (and (arrayp first) (clear-string first)) | 1228 | (let (success) |
| 1229 | (and (arrayp second) (clear-string second)) | 1229 | (while (not success) |
| 1230 | (message "Password not repeated accurately; please start over") | 1230 | (let ((first (read-passwd prompt nil default)) |
| 1231 | (sit-for 1)))) | 1231 | (second (read-passwd "Confirm password: " nil default))) |
| 1232 | success) | 1232 | (if (equal first second) |
| 1233 | (let ((pass nil) | 1233 | (progn |
| 1234 | (c 0) | 1234 | (and (arrayp second) (clear-string second)) |
| 1235 | (echo-keystrokes 0) | 1235 | (setq success first)) |
| 1236 | (cursor-in-echo-area t)) | 1236 | (and (arrayp first) (clear-string first)) |
| 1237 | (while (progn (message "%s%s" | 1237 | (and (arrayp second) (clear-string second)) |
| 1238 | prompt | 1238 | (message "Password not repeated accurately; please start over") |
| 1239 | (make-string (length pass) ?.)) | 1239 | (sit-for 1)))) |
| 1240 | (setq c (read-char-exclusive nil t)) | 1240 | success) |
| 1241 | (and (/= c ?\r) (/= c ?\n) (/= c ?\e))) | 1241 | (let ((pass nil) |
| 1242 | (clear-this-command-keys) | 1242 | (c 0) |
| 1243 | (if (= c ?\C-u) | 1243 | (echo-keystrokes 0) |
| 1244 | (progn | 1244 | (cursor-in-echo-area t)) |
| 1245 | (and (arrayp pass) (clear-string pass)) | 1245 | (while (progn (message "%s%s" |
| 1246 | (setq pass "")) | 1246 | prompt |
| 1247 | (if (and (/= c ?\b) (/= c ?\177)) | 1247 | (make-string (length pass) ?.)) |
| 1248 | (let* ((new-char (char-to-string c)) | 1248 | (setq c (read-char-exclusive nil t)) |
| 1249 | (new-pass (concat pass new-char))) | 1249 | (and (/= c ?\r) (/= c ?\n) (/= c ?\e))) |
| 1250 | (clear-this-command-keys) | ||
| 1251 | (if (= c ?\C-u) | ||
| 1252 | (progn | ||
| 1250 | (and (arrayp pass) (clear-string pass)) | 1253 | (and (arrayp pass) (clear-string pass)) |
| 1251 | (clear-string new-char) | 1254 | (setq pass "")) |
| 1252 | (setq c ?\0) | 1255 | (if (and (/= c ?\b) (/= c ?\177)) |
| 1253 | (setq pass new-pass)) | 1256 | (let* ((new-char (char-to-string c)) |
| 1254 | (if (> (length pass) 0) | 1257 | (new-pass (concat pass new-char))) |
| 1255 | (let ((new-pass (substring pass 0 -1))) | ||
| 1256 | (and (arrayp pass) (clear-string pass)) | 1258 | (and (arrayp pass) (clear-string pass)) |
| 1257 | (setq pass new-pass)))))) | 1259 | (clear-string new-char) |
| 1258 | (message nil) | 1260 | (setq c ?\0) |
| 1259 | (or pass default "")))) | 1261 | (setq pass new-pass)) |
| 1262 | (if (> (length pass) 0) | ||
| 1263 | (let ((new-pass (substring pass 0 -1))) | ||
| 1264 | (and (arrayp pass) (clear-string pass)) | ||
| 1265 | (setq pass new-pass)))))) | ||
| 1266 | (message nil) | ||
| 1267 | (or pass default ""))))) | ||
| 1260 | 1268 | ||
| 1261 | ;; This should be used by `call-interactively' for `n' specs. | 1269 | ;; This should be used by `call-interactively' for `n' specs. |
| 1262 | (defun read-number (prompt &optional default) | 1270 | (defun read-number (prompt &optional default) |
| @@ -1822,14 +1830,14 @@ See also `with-temp-file' and `with-output-to-string'." | |||
| 1822 | 1830 | ||
| 1823 | (defmacro with-local-quit (&rest body) | 1831 | (defmacro with-local-quit (&rest body) |
| 1824 | "Execute BODY, allowing quits to terminate BODY but not escape further. | 1832 | "Execute BODY, allowing quits to terminate BODY but not escape further. |
| 1825 | When a quit terminates BODY, `with-local-quit' requests another quit when | 1833 | When a quit terminates BODY, `with-local-quit' returns nil but |
| 1826 | it finishes. That quit will be processed in turn, the next time quitting | 1834 | requests another quit. That quit will be processed, the next time quitting |
| 1827 | is again allowed." | 1835 | is allowed once again." |
| 1828 | (declare (debug t) (indent 0)) | 1836 | (declare (debug t) (indent 0)) |
| 1829 | `(condition-case nil | 1837 | `(condition-case nil |
| 1830 | (let ((inhibit-quit nil)) | 1838 | (let ((inhibit-quit nil)) |
| 1831 | ,@body) | 1839 | ,@body) |
| 1832 | (quit (setq quit-flag t)))) | 1840 | (quit (setq quit-flag t) nil))) |
| 1833 | 1841 | ||
| 1834 | (defmacro combine-after-change-calls (&rest body) | 1842 | (defmacro combine-after-change-calls (&rest body) |
| 1835 | "Execute BODY, but don't call the after-change functions till the end. | 1843 | "Execute BODY, but don't call the after-change functions till the end. |
| @@ -2023,11 +2031,12 @@ STRING should be given if the last search was by `string-match' on STRING." | |||
| 2023 | 2031 | ||
| 2024 | (defun looking-back (regexp &optional limit) | 2032 | (defun looking-back (regexp &optional limit) |
| 2025 | "Return non-nil if text before point matches regular expression REGEXP. | 2033 | "Return non-nil if text before point matches regular expression REGEXP. |
| 2026 | Like `looking-at' except backwards and slower. | 2034 | Like `looking-at' except matches before point, and is slower. |
| 2027 | LIMIT if non-nil speeds up the search by specifying how far back the | 2035 | LIMIT if non-nil speeds up the search by specifying how far back the |
| 2028 | match can start." | 2036 | match can start." |
| 2029 | (save-excursion | 2037 | (not (null |
| 2030 | (re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t))) | 2038 | (save-excursion |
| 2039 | (re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t))))) | ||
| 2031 | 2040 | ||
| 2032 | (defconst split-string-default-separators "[ \f\t\n\r\v]+" | 2041 | (defconst split-string-default-separators "[ \f\t\n\r\v]+" |
| 2033 | "The default value of separators for `split-string'. | 2042 | "The default value of separators for `split-string'. |
diff --git a/lisp/term.el b/lisp/term.el index 07702551718..f54f1f015dd 100644 --- a/lisp/term.el +++ b/lisp/term.el | |||
| @@ -2,7 +2,8 @@ | |||
| 2 | 2 | ||
| 3 | ;;; Copyright (C) 1988, 1990, 1992, 1994, 1995, 2004 Free Software Foundation, Inc. | 3 | ;;; Copyright (C) 1988, 1990, 1992, 1994, 1995, 2004 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Per Bothner <bothner@cygnus.com> | 5 | ;; Author: Per Bothner <per@bothner.com> |
| 6 | ;; Maintainer: Dan Nicolaescu <dann@ics.uci.edu>, Per Bothner <per@bothner.com> | ||
| 6 | ;; Based on comint mode written by: Olin Shivers <shivers@cs.cmu.edu> | 7 | ;; Based on comint mode written by: Olin Shivers <shivers@cs.cmu.edu> |
| 7 | ;; Keywords: processes | 8 | ;; Keywords: processes |
| 8 | 9 | ||
diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index 43671f0f725..93a7ebd52e4 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el | |||
| @@ -452,7 +452,7 @@ See also `flyspell-duplicate-distance'." | |||
| 452 | ;;;###autoload | 452 | ;;;###autoload |
| 453 | (defun flyspell-mode (&optional arg) | 453 | (defun flyspell-mode (&optional arg) |
| 454 | "Minor mode performing on-the-fly spelling checking. | 454 | "Minor mode performing on-the-fly spelling checking. |
| 455 | Ispell is automatically spawned on background for each entered words. | 455 | This spawns a single Ispell process and checks each word. |
| 456 | The default flyspell behavior is to highlight incorrect words. | 456 | The default flyspell behavior is to highlight incorrect words. |
| 457 | With no argument, this command toggles Flyspell mode. | 457 | With no argument, this command toggles Flyspell mode. |
| 458 | With a prefix argument ARG, turn Flyspell minor mode on iff ARG is positive. | 458 | With a prefix argument ARG, turn Flyspell minor mode on iff ARG is positive. |
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index b98c9fc183d..f0547d6d596 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el | |||
| @@ -1618,10 +1618,11 @@ Global `ispell-quit' set to start location to continue spell session." | |||
| 1618 | (set-buffer (get-buffer-create ispell-choices-buffer)) | 1618 | (set-buffer (get-buffer-create ispell-choices-buffer)) |
| 1619 | (setq mode-line-format (concat "-- %b -- word: " word)) | 1619 | (setq mode-line-format (concat "-- %b -- word: " word)) |
| 1620 | ;; XEmacs: no need for horizontal scrollbar in choices window | 1620 | ;; XEmacs: no need for horizontal scrollbar in choices window |
| 1621 | (and (fboundp 'set-specifier) | 1621 | (with-no-warnings |
| 1622 | (boundp 'horizontal-scrollbar-visible-p) | 1622 | (and (fboundp 'set-specifier) |
| 1623 | (set-specifier horizontal-scrollbar-visible-p nil | 1623 | (boundp 'horizontal-scrollbar-visible-p) |
| 1624 | (cons (current-buffer) nil))) | 1624 | (set-specifier horizontal-scrollbar-visible-p nil |
| 1625 | (cons (current-buffer) nil)))) | ||
| 1625 | (erase-buffer) | 1626 | (erase-buffer) |
| 1626 | (if guess | 1627 | (if guess |
| 1627 | (progn | 1628 | (progn |
| @@ -1871,7 +1872,7 @@ Global `ispell-quit' set to start location to continue spell session." | |||
| 1871 | (if (and ispell-use-framepop-p (fboundp 'framepop-display-buffer)) | 1872 | (if (and ispell-use-framepop-p (fboundp 'framepop-display-buffer)) |
| 1872 | (progn | 1873 | (progn |
| 1873 | (framepop-display-buffer (get-buffer ispell-choices-buffer)) | 1874 | (framepop-display-buffer (get-buffer ispell-choices-buffer)) |
| 1874 | (get-buffer-window ispell-choices-buffer t) | 1875 | ;;; (get-buffer-window ispell-choices-buffer t) |
| 1875 | (select-window (previous-window))) ; *Choices* window | 1876 | (select-window (previous-window))) ; *Choices* window |
| 1876 | ;; standard selection by splitting a small buffer out of this window. | 1877 | ;; standard selection by splitting a small buffer out of this window. |
| 1877 | (let ((choices-window (get-buffer-window ispell-choices-buffer))) | 1878 | (let ((choices-window (get-buffer-window ispell-choices-buffer))) |
| @@ -2355,7 +2356,7 @@ Keeps argument list for future ispell invocations for no async support." | |||
| 2355 | (if extended-char-mode ; ~ extended character mode | 2356 | (if extended-char-mode ; ~ extended character mode |
| 2356 | (ispell-send-string (concat extended-char-mode "\n")))) | 2357 | (ispell-send-string (concat extended-char-mode "\n")))) |
| 2357 | (if ispell-async-processp | 2358 | (if ispell-async-processp |
| 2358 | (process-kill-without-query ispell-process)))) | 2359 | (set-process-query-on-exit-flag ispell-process nil)))) |
| 2359 | 2360 | ||
| 2360 | ;;;###autoload | 2361 | ;;;###autoload |
| 2361 | (defun ispell-kill-ispell (&optional no-error) | 2362 | (defun ispell-kill-ispell (&optional no-error) |
| @@ -3286,19 +3287,23 @@ You can bind this to the key C-c i in GNUS or mail by adding to | |||
| 3286 | (cond | 3287 | (cond |
| 3287 | ((functionp 'sc-cite-regexp) ; sc 3.0 | 3288 | ((functionp 'sc-cite-regexp) ; sc 3.0 |
| 3288 | (concat "\\(" (sc-cite-regexp) "\\)" "\\|" | 3289 | (concat "\\(" (sc-cite-regexp) "\\)" "\\|" |
| 3289 | (ispell-non-empty-string sc-reference-tag-string))) | 3290 | (with-no-warnings |
| 3291 | (ispell-non-empty-string sc-reference-tag-string)))) | ||
| 3290 | ((boundp 'sc-cite-regexp) ; sc 2.3 | 3292 | ((boundp 'sc-cite-regexp) ; sc 2.3 |
| 3291 | (concat "\\(" sc-cite-regexp "\\)" "\\|" | 3293 | (concat "\\(" sc-cite-regexp "\\)" "\\|" |
| 3292 | (ispell-non-empty-string sc-reference-tag-string))) | 3294 | (with-no-warnings |
| 3295 | (ispell-non-empty-string sc-reference-tag-string)))) | ||
| 3293 | ((or (equal major-mode 'news-reply-mode) ;GNUS 4 & below | 3296 | ((or (equal major-mode 'news-reply-mode) ;GNUS 4 & below |
| 3294 | (equal major-mode 'message-mode)) ;GNUS 5 | 3297 | (equal major-mode 'message-mode)) ;GNUS 5 |
| 3295 | (concat "In article <" "\\|" | 3298 | (concat "In article <" "\\|" |
| 3296 | "[^,;&+=\n]+ <[^,;&+=]+> writes:" "\\|" | 3299 | "[^,;&+=\n]+ <[^,;&+=]+> writes:" "\\|" |
| 3297 | message-cite-prefix-regexp "\\|" | 3300 | (with-no-warnings message-cite-prefix-regexp) |
| 3301 | "\\|" | ||
| 3298 | default-prefix)) | 3302 | default-prefix)) |
| 3299 | ((equal major-mode 'mh-letter-mode) ; mh mail message | 3303 | ((equal major-mode 'mh-letter-mode) ; mh mail message |
| 3300 | (concat "[^,;&+=\n]+ writes:" "\\|" | 3304 | (concat "[^,;&+=\n]+ writes:" "\\|" |
| 3301 | (ispell-non-empty-string mh-ins-buf-prefix))) | 3305 | (with-no-warnings |
| 3306 | (ispell-non-empty-string mh-ins-buf-prefix)))) | ||
| 3302 | ((not internal-messagep) ; Assume nn sent us this message. | 3307 | ((not internal-messagep) ; Assume nn sent us this message. |
| 3303 | (concat "In [a-zA-Z.]+ you write:" "\\|" | 3308 | (concat "In [a-zA-Z.]+ you write:" "\\|" |
| 3304 | "In <[^,;&+=]+> [^,;&+=]+ writes:" "\\|" | 3309 | "In <[^,;&+=]+> [^,;&+=]+ writes:" "\\|" |
diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index 5a8d0df40d1..a7ca14d1294 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el | |||
| @@ -1946,7 +1946,6 @@ since TeX does not put file names and line numbers on the same line as | |||
| 1946 | for the error messages." | 1946 | for the error messages." |
| 1947 | (require 'thingatpt) | 1947 | (require 'thingatpt) |
| 1948 | (setq compilation-error-list nil) | 1948 | (setq compilation-error-list nil) |
| 1949 | (message "Parsing error messages...") | ||
| 1950 | (let ((default-directory ; Perhaps dir has changed meanwhile. | 1949 | (let ((default-directory ; Perhaps dir has changed meanwhile. |
| 1951 | (file-name-directory (buffer-file-name tex-last-buffer-texed))) | 1950 | (file-name-directory (buffer-file-name tex-last-buffer-texed))) |
| 1952 | found-desired (num-errors-found 0) | 1951 | found-desired (num-errors-found 0) |
| @@ -2012,8 +2011,7 @@ for the error messages." | |||
| 2012 | compilation-error-list)) | 2011 | compilation-error-list)) |
| 2013 | (goto-char end-of-error))))) | 2012 | (goto-char end-of-error))))) |
| 2014 | (set-marker compilation-parsing-end (point)) | 2013 | (set-marker compilation-parsing-end (point)) |
| 2015 | (setq compilation-error-list (nreverse compilation-error-list)) | 2014 | (setq compilation-error-list (nreverse compilation-error-list))) |
| 2016 | (message "Parsing error messages...done")) | ||
| 2017 | 2015 | ||
| 2018 | ;;; The commands: | 2016 | ;;; The commands: |
| 2019 | 2017 | ||
diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index 91a6c869a21..053984fcaeb 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog | |||
| @@ -1,3 +1,62 @@ | |||
| 1 | 2004-10-20 John Paul Wallington <jpw@gnu.org> | ||
| 2 | |||
| 3 | * url-gw.el (url-gateway-nslookup-host): | ||
| 4 | Use `set-process-query-on-exit-flag'. | ||
| 5 | |||
| 6 | 2004-10-10 Lars Hansen <larsh@math.ku.dk> | ||
| 7 | |||
| 8 | * url-auth.el: Update header and footer. | ||
| 9 | |||
| 10 | * url-cache.el: Update header and footer. | ||
| 11 | |||
| 12 | * url-cid.el: Update header and footer. | ||
| 13 | |||
| 14 | * url-dired.el: Update header and footer. | ||
| 15 | |||
| 16 | * url-expand.el: Update header and footer. | ||
| 17 | |||
| 18 | * url-ftp.el: Update header and footer. | ||
| 19 | |||
| 20 | * url-gw.el: Update header and footer. | ||
| 21 | |||
| 22 | * url-imap.el: Update header and footer. | ||
| 23 | |||
| 24 | * url-irc.el: Update header and footer. | ||
| 25 | |||
| 26 | * url-misc.el: Update header and footer. | ||
| 27 | |||
| 28 | * url-news.el: Update header and footer. | ||
| 29 | |||
| 30 | * url-ns.el: Update header and footer. | ||
| 31 | |||
| 32 | * url-privacy.el: Update header and footer. | ||
| 33 | |||
| 34 | * url-proxy.el: Update header and footer. | ||
| 35 | |||
| 36 | * url-vars.el: Update header. | ||
| 37 | |||
| 38 | 2004-10-16 Richard M. Stallman <rms@gnu.org> | ||
| 39 | |||
| 40 | * url.el (url-do-setup): Don't set url-passwd-entry-func. | ||
| 41 | |||
| 42 | * url-vars.el (url-passwd-entry-func): Var deleted. | ||
| 43 | (mm-mime-mule-charset-alist): Remove compatibility code for old Gnus. | ||
| 44 | (url-weekday-alist): Renamed from weekday-alist. | ||
| 45 | (url-monthabbrev-alist): Renamed from monthabbrev-alist. | ||
| 46 | (url-vars-unload-hook): Initialize hook var to hold the function. | ||
| 47 | |||
| 48 | * url-util.el (url-get-normalized-date): Use | ||
| 49 | url-weekday-alist and url-monthabbrev-alist. | ||
| 50 | |||
| 51 | * url-misc.el: Load cl at compile time. | ||
| 52 | |||
| 53 | * url-mailto.el: Don't load cl. | ||
| 54 | (url-mailto): Fix call to `push'. | ||
| 55 | |||
| 56 | * url-gw.el (url-open-telnet): Use read-passwd. | ||
| 57 | |||
| 58 | * url-auth.el (url-basic-auth, url-digest-auth): Use read-passwd. | ||
| 59 | |||
| 1 | 2004-10-12 Simon Josefsson <jas@extundo.com> | 60 | 2004-10-12 Simon Josefsson <jas@extundo.com> |
| 2 | 61 | ||
| 3 | * url-vars.el (url-gateway-method): Add new method `tls'. | 62 | * url-vars.el (url-gateway-method): Add new method `tls'. |
diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el index 39bb730bebc..260315c5d54 100644 --- a/lisp/url/url-auth.el +++ b/lisp/url/url-auth.el | |||
| @@ -1,26 +1,27 @@ | |||
| 1 | ;;; url-auth.el --- Uniform Resource Locator authorization modules | 1 | ;;; url-auth.el --- Uniform Resource Locator authorization modules |
| 2 | |||
| 3 | ;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc. | ||
| 4 | |||
| 2 | ;; Keywords: comm, data, processes, hypermedia | 5 | ;; Keywords: comm, data, processes, hypermedia |
| 3 | 6 | ||
| 4 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 7 | ;; This file is part of GNU Emacs. |
| 5 | ;;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc. | 8 | |
| 6 | ;;; | 9 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
| 7 | ;;; This file is part of GNU Emacs. | 10 | ;; it under the terms of the GNU General Public License as published by |
| 8 | ;;; | 11 | ;; the Free Software Foundation; either version 2, or (at your option) |
| 9 | ;;; GNU Emacs is free software; you can redistribute it and/or modify | 12 | ;; any later version. |
| 10 | ;;; it under the terms of the GNU General Public License as published by | 13 | |
| 11 | ;;; the Free Software Foundation; either version 2, or (at your option) | 14 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 12 | ;;; any later version. | 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 13 | ;;; | 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 14 | ;;; GNU Emacs is distributed in the hope that it will be useful, | 17 | ;; GNU General Public License for more details. |
| 15 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | 18 | |
| 16 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | 19 | ;; You should have received a copy of the GNU General Public License |
| 17 | ;;; GNU General Public License for more details. | 20 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
| 18 | ;;; | 21 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
| 19 | ;;; You should have received a copy of the GNU General Public License | 22 | ;; Boston, MA 02111-1307, USA. |
| 20 | ;;; along with GNU Emacs; see the file COPYING. If not, write to the | 23 | |
| 21 | ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | 24 | ;;; Code: |
| 22 | ;;; Boston, MA 02111-1307, USA. | ||
| 23 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 24 | 25 | ||
| 25 | (require 'url-vars) | 26 | (require 'url-vars) |
| 26 | (require 'url-parse) | 27 | (require 'url-parse) |
| @@ -78,7 +79,7 @@ instead of the pathname inheritance method." | |||
| 78 | ((and prompt (not byserv)) | 79 | ((and prompt (not byserv)) |
| 79 | (setq user (read-string (url-auth-user-prompt url realm) | 80 | (setq user (read-string (url-auth-user-prompt url realm) |
| 80 | (user-real-login-name)) | 81 | (user-real-login-name)) |
| 81 | pass (funcall url-passwd-entry-func "Password: ")) | 82 | pass (read-passwd "Password: ")) |
| 82 | (set url-basic-auth-storage | 83 | (set url-basic-auth-storage |
| 83 | (cons (list server | 84 | (cons (list server |
| 84 | (cons path | 85 | (cons path |
| @@ -102,7 +103,7 @@ instead of the pathname inheritance method." | |||
| 102 | (progn | 103 | (progn |
| 103 | (setq user (read-string (url-auth-user-prompt url realm) | 104 | (setq user (read-string (url-auth-user-prompt url realm) |
| 104 | (user-real-login-name)) | 105 | (user-real-login-name)) |
| 105 | pass (funcall url-passwd-entry-func "Password: ") | 106 | pass (read-passwd "Password: ") |
| 106 | retval (base64-encode-string (format "%s:%s" user pass)) | 107 | retval (base64-encode-string (format "%s:%s" user pass)) |
| 107 | byserv (assoc server (symbol-value url-basic-auth-storage))) | 108 | byserv (assoc server (symbol-value url-basic-auth-storage))) |
| 108 | (setcdr byserv | 109 | (setcdr byserv |
| @@ -160,7 +161,7 @@ instead of hostname:portnum." | |||
| 160 | ((and prompt (not byserv)) | 161 | ((and prompt (not byserv)) |
| 161 | (setq user (read-string (url-auth-user-prompt url realm) | 162 | (setq user (read-string (url-auth-user-prompt url realm) |
| 162 | (user-real-login-name)) | 163 | (user-real-login-name)) |
| 163 | pass (funcall url-passwd-entry-func "Password: ") | 164 | pass (read-passwd "Password: ") |
| 164 | url-digest-auth-storage | 165 | url-digest-auth-storage |
| 165 | (cons (list server | 166 | (cons (list server |
| 166 | (cons path | 167 | (cons path |
| @@ -187,7 +188,7 @@ instead of hostname:portnum." | |||
| 187 | (progn | 188 | (progn |
| 188 | (setq user (read-string (url-auth-user-prompt url realm) | 189 | (setq user (read-string (url-auth-user-prompt url realm) |
| 189 | (user-real-login-name)) | 190 | (user-real-login-name)) |
| 190 | pass (funcall url-passwd-entry-func "Password: ") | 191 | pass (read-passwd "Password: ") |
| 191 | retval (setq retval | 192 | retval (setq retval |
| 192 | (cons user | 193 | (cons user |
| 193 | (url-digest-auth-create-key | 194 | (url-digest-auth-create-key |
| @@ -314,3 +315,4 @@ RATING a rating between 1 and 10 of the strength of the authentication. | |||
| 314 | (provide 'url-auth) | 315 | (provide 'url-auth) |
| 315 | 316 | ||
| 316 | ;;; arch-tag: 04058625-616d-44e4-9dbf-4b46b00b2a91 | 317 | ;;; arch-tag: 04058625-616d-44e4-9dbf-4b46b00b2a91 |
| 318 | ;;; url-auth.el ends here | ||
diff --git a/lisp/url/url-cache.el b/lisp/url/url-cache.el index 1e3374639e1..f27b47251e4 100644 --- a/lisp/url/url-cache.el +++ b/lisp/url/url-cache.el | |||
| @@ -1,26 +1,28 @@ | |||
| 1 | ;;; url-cache.el --- Uniform Resource Locator retrieval tool | 1 | ;;; url-cache.el --- Uniform Resource Locator retrieval tool |
| 2 | |||
| 3 | ;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc. | ||
| 4 | |||
| 2 | ;; Keywords: comm, data, processes, hypermedia | 5 | ;; Keywords: comm, data, processes, hypermedia |
| 3 | 6 | ||
| 4 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 7 | ;; This file is part of GNU Emacs. |
| 5 | ;;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc. | 8 | |
| 6 | ;;; | 9 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
| 7 | ;;; This file is part of GNU Emacs. | 10 | ;; it under the terms of the GNU General Public License as published by |
| 8 | ;;; | 11 | ;; the Free Software Foundation; either version 2, or (at your option) |
| 9 | ;;; GNU Emacs is free software; you can redistribute it and/or modify | 12 | ;; any later version. |
| 10 | ;;; it under the terms of the GNU General Public License as published by | 13 | |
| 11 | ;;; the Free Software Foundation; either version 2, or (at your option) | 14 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 12 | ;;; any later version. | 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 13 | ;;; | 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 14 | ;;; GNU Emacs is distributed in the hope that it will be useful, | 17 | ;; GNU General Public License for more details. |
| 15 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | 18 | |
| 16 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | 19 | ;; You should have received a copy of the GNU General Public License |
| 17 | ;;; GNU General Public License for more details. | 20 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
| 18 | ;;; | 21 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
| 19 | ;;; You should have received a copy of the GNU General Public License | 22 | ;; Boston, MA 02111-1307, USA. |
| 20 | ;;; along with GNU Emacs; see the file COPYING. If not, write to the | 23 | |
| 21 | ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | 24 | ;;; Code: |
| 22 | ;;; Boston, MA 02111-1307, USA. | 25 | |
| 23 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 24 | (require 'url-parse) | 26 | (require 'url-parse) |
| 25 | (require 'url-util) | 27 | (require 'url-util) |
| 26 | 28 | ||
| @@ -200,3 +202,4 @@ Very fast if you have an `md5' primitive function, suitably fast otherwise." | |||
| 200 | (provide 'url-cache) | 202 | (provide 'url-cache) |
| 201 | 203 | ||
| 202 | ;;; arch-tag: 95b050a6-8e81-4f23-8e63-191b9d1d657c | 204 | ;;; arch-tag: 95b050a6-8e81-4f23-8e63-191b9d1d657c |
| 205 | ;;; url-cache.el ends here | ||
diff --git a/lisp/url/url-cid.el b/lisp/url/url-cid.el new file mode 100644 index 00000000000..9c44835ca9f --- /dev/null +++ b/lisp/url/url-cid.el | |||
| @@ -0,0 +1,66 @@ | |||
| 1 | ;;; url-cid.el --- Content-ID URL loader | ||
| 2 | |||
| 3 | ;; Copyright (c) 1998 - 1999 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Keywords: comm, data, processes | ||
| 6 | |||
| 7 | ;; This file is part of GNU Emacs. | ||
| 8 | |||
| 9 | ;; GNU Emacs is free software; you can redistribute it and/or modify | ||
| 10 | ;; it under the terms of the GNU General Public License as published by | ||
| 11 | ;; the Free Software Foundation; either version 2, or (at your option) | ||
| 12 | ;; any later version. | ||
| 13 | |||
| 14 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 17 | ;; GNU General Public License for more details. | ||
| 18 | |||
| 19 | ;; You should have received a copy of the GNU General Public License | ||
| 20 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | ||
| 21 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | ||
| 22 | ;; Boston, MA 02111-1307, USA. | ||
| 23 | |||
| 24 | ;;; Code: | ||
| 25 | |||
| 26 | (require 'url-vars) | ||
| 27 | (require 'url-parse) | ||
| 28 | |||
| 29 | (require 'mm-decode) | ||
| 30 | |||
| 31 | (defun url-cid-gnus (cid) | ||
| 32 | (let ((content-type nil) | ||
| 33 | (encoding nil) | ||
| 34 | (part nil) | ||
| 35 | (data nil)) | ||
| 36 | (setq part (mm-get-content-id cid)) | ||
| 37 | (if (not part) | ||
| 38 | (message "Unknown CID encountered: %s" cid) | ||
| 39 | (setq data (save-excursion | ||
| 40 | (set-buffer (mm-handle-buffer part)) | ||
| 41 | (buffer-string)) | ||
| 42 | content-type (mm-handle-type part) | ||
| 43 | encoding (symbol-name (mm-handle-encoding part))) | ||
| 44 | (if (= 0 (length content-type)) (setq content-type "text/plain")) | ||
| 45 | (if (= 0 (length encoding)) (setq encoding "8bit")) | ||
| 46 | (if (listp content-type) | ||
| 47 | (setq content-type (car content-type))) | ||
| 48 | (insert (format "Content-type: %d\r\n" (length data)) | ||
| 49 | "Content-type: " content-type "\r\n" | ||
| 50 | "Content-transfer-encoding: " encoding "\r\n" | ||
| 51 | "\r\n" | ||
| 52 | (or data ""))))) | ||
| 53 | |||
| 54 | ;;;###autoload | ||
| 55 | (defun url-cid (url) | ||
| 56 | (cond | ||
| 57 | ((fboundp 'mm-get-content-id) | ||
| 58 | ;; Using Pterodactyl Gnus or later | ||
| 59 | (save-excursion | ||
| 60 | (set-buffer (generate-new-buffer " *url-cid*")) | ||
| 61 | (url-cid-gnus (url-filename url)))) | ||
| 62 | (t | ||
| 63 | (message "Unable to handle CID URL: %s" url)))) | ||
| 64 | |||
| 65 | ;;; arch-tag: 23d9ab74-fad4-4dba-b1e7-292871e8bda5 | ||
| 66 | ;;; url-cid.el ends here | ||
diff --git a/lisp/url/url-dired.el b/lisp/url/url-dired.el index 73307412e1e..41d81df677e 100644 --- a/lisp/url/url-dired.el +++ b/lisp/url/url-dired.el | |||
| @@ -1,26 +1,27 @@ | |||
| 1 | ;;; url-dired.el --- URL Dired minor mode | 1 | ;;; url-dired.el --- URL Dired minor mode |
| 2 | |||
| 3 | ;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc. | ||
| 4 | |||
| 2 | ;; Keywords: comm, files | 5 | ;; Keywords: comm, files |
| 3 | 6 | ||
| 4 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 7 | ;; This file is part of GNU Emacs. |
| 5 | ;;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc. | 8 | |
| 6 | ;;; | 9 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
| 7 | ;;; This file is part of GNU Emacs. | 10 | ;; it under the terms of the GNU General Public License as published by |
| 8 | ;;; | 11 | ;; the Free Software Foundation; either version 2, or (at your option) |
| 9 | ;;; GNU Emacs is free software; you can redistribute it and/or modify | 12 | ;; any later version. |
| 10 | ;;; it under the terms of the GNU General Public License as published by | 13 | |
| 11 | ;;; the Free Software Foundation; either version 2, or (at your option) | 14 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 12 | ;;; any later version. | 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 13 | ;;; | 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 14 | ;;; GNU Emacs is distributed in the hope that it will be useful, | 17 | ;; GNU General Public License for more details. |
| 15 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | 18 | |
| 16 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | 19 | ;; You should have received a copy of the GNU General Public License |
| 17 | ;;; GNU General Public License for more details. | 20 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
| 18 | ;;; | 21 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
| 19 | ;;; You should have received a copy of the GNU General Public License | 22 | ;; Boston, MA 02111-1307, USA. |
| 20 | ;;; along with GNU Emacs; see the file COPYING. If not, write to the | 23 | |
| 21 | ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | 24 | ;;; Code: |
| 22 | ;;; Boston, MA 02111-1307, USA. | ||
| 23 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 24 | 25 | ||
| 25 | (autoload 'w3-fetch "w3") | 26 | (autoload 'w3-fetch "w3") |
| 26 | (autoload 'w3-open-local "w3") | 27 | (autoload 'w3-open-local "w3") |
| @@ -98,3 +99,4 @@ Example: (add-minor-mode 'view-minor-mode \" View\" view-mode-map)" | |||
| 98 | (provide 'url-dired) | 99 | (provide 'url-dired) |
| 99 | 100 | ||
| 100 | ;;; arch-tag: 2694f21a-43e1-4391-b3cb-cf6e5349f15f | 101 | ;;; arch-tag: 2694f21a-43e1-4391-b3cb-cf6e5349f15f |
| 102 | ;;; url-dired.el ends here | ||
diff --git a/lisp/url/url-expand.el b/lisp/url/url-expand.el new file mode 100644 index 00000000000..a7855653103 --- /dev/null +++ b/lisp/url/url-expand.el | |||
| @@ -0,0 +1,144 @@ | |||
| 1 | ;;; url-expand.el --- expand-file-name for URLs | ||
| 2 | |||
| 3 | ;; Copyright (c) 1999 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Keywords: comm, data, processes | ||
| 6 | |||
| 7 | ;; This file is part of GNU Emacs. | ||
| 8 | |||
| 9 | ;; GNU Emacs is free software; you can redistribute it and/or modify | ||
| 10 | ;; it under the terms of the GNU General Public License as published by | ||
| 11 | ;; the Free Software Foundation; either version 2, or (at your option) | ||
| 12 | ;; any later version. | ||
| 13 | |||
| 14 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 17 | ;; GNU General Public License for more details. | ||
| 18 | |||
| 19 | ;; You should have received a copy of the GNU General Public License | ||
| 20 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | ||
| 21 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | ||
| 22 | ;; Boston, MA 02111-1307, USA. | ||
| 23 | |||
| 24 | ;;; Code: | ||
| 25 | |||
| 26 | (require 'url-methods) | ||
| 27 | (require 'url-util) | ||
| 28 | (require 'url-parse) | ||
| 29 | |||
| 30 | (defun url-expander-remove-relative-links (name) | ||
| 31 | ;; Strip . and .. from pathnames | ||
| 32 | (let ((new (if (not (string-match "^/" name)) | ||
| 33 | (concat "/" name) | ||
| 34 | name))) | ||
| 35 | |||
| 36 | ;; If it ends with a '/.' or '/..', tack on a trailing '/' sot hat | ||
| 37 | ;; the tests that follow are not too complicated in terms of | ||
| 38 | ;; looking for '..' or '../', etc. | ||
| 39 | (if (string-match "/\\.+$" new) | ||
| 40 | (setq new (concat new "/"))) | ||
| 41 | |||
| 42 | ;; Remove '/./' first | ||
| 43 | (while (string-match "/\\(\\./\\)" new) | ||
| 44 | (setq new (concat (substring new 0 (match-beginning 1)) | ||
| 45 | (substring new (match-end 1))))) | ||
| 46 | |||
| 47 | ;; Then remove '/../' | ||
| 48 | (while (string-match "/\\([^/]*/\\.\\./\\)" new) | ||
| 49 | (setq new (concat (substring new 0 (match-beginning 1)) | ||
| 50 | (substring new (match-end 1))))) | ||
| 51 | |||
| 52 | ;; Remove cruft at the beginning of the string, so people that put | ||
| 53 | ;; in extraneous '..' because they are morons won't lose. | ||
| 54 | (while (string-match "^/\\.\\.\\(/\\)" new) | ||
| 55 | (setq new (substring new (match-beginning 1) nil))) | ||
| 56 | new)) | ||
| 57 | |||
| 58 | (defun url-expand-file-name (url &optional default) | ||
| 59 | "Convert URL to a fully specified URL, and canonicalize it. | ||
| 60 | Second arg DEFAULT is a URL to start with if URL is relative. | ||
| 61 | If DEFAULT is nil or missing, the current buffer's URL is used. | ||
| 62 | Path components that are `.' are removed, and | ||
| 63 | path components followed by `..' are removed, along with the `..' itself." | ||
| 64 | (if (and url (not (string-match "^#" url))) | ||
| 65 | ;; Need to nuke newlines and spaces in the URL, or we open | ||
| 66 | ;; ourselves up to potential security holes. | ||
| 67 | (setq url (mapconcat (function (lambda (x) | ||
| 68 | (if (memq x '(? ?\n ?\r)) | ||
| 69 | "" | ||
| 70 | (char-to-string x)))) | ||
| 71 | url ""))) | ||
| 72 | |||
| 73 | ;; Need to figure out how/where to expand the fragment relative to | ||
| 74 | (setq default (cond | ||
| 75 | ((vectorp default) | ||
| 76 | ;; Default URL has already been parsed | ||
| 77 | default) | ||
| 78 | (default | ||
| 79 | ;; They gave us a default URL in non-parsed format | ||
| 80 | (url-generic-parse-url default)) | ||
| 81 | (url-current-object | ||
| 82 | ;; We are in a URL-based buffer, use the pre-parsed object | ||
| 83 | url-current-object) | ||
| 84 | ((string-match url-nonrelative-link url) | ||
| 85 | ;; The URL they gave us is absolute, go for it. | ||
| 86 | nil) | ||
| 87 | (t | ||
| 88 | ;; Hmmm - this shouldn't ever happen. | ||
| 89 | (error "url-expand-file-name confused - no default?")))) | ||
| 90 | |||
| 91 | (cond | ||
| 92 | ((= (length url) 0) ; nil or empty string | ||
| 93 | (url-recreate-url default)) | ||
| 94 | ((string-match "^#" url) ; Offset link, use it raw | ||
| 95 | url) | ||
| 96 | ((string-match url-nonrelative-link url) ; Fully-qualified URL, return it immediately | ||
| 97 | url) | ||
| 98 | (t | ||
| 99 | (let* ((urlobj (url-generic-parse-url url)) | ||
| 100 | (inhibit-file-name-handlers t) | ||
| 101 | (expander (url-scheme-get-property (url-type default) 'expand-file-name))) | ||
| 102 | (if (string-match "^//" url) | ||
| 103 | (setq urlobj (url-generic-parse-url (concat (url-type default) ":" | ||
| 104 | url)))) | ||
| 105 | (funcall expander urlobj default) | ||
| 106 | (url-recreate-url urlobj))))) | ||
| 107 | |||
| 108 | (defun url-identity-expander (urlobj defobj) | ||
| 109 | (url-set-type urlobj (or (url-type urlobj) (url-type defobj)))) | ||
| 110 | |||
| 111 | (defun url-default-expander (urlobj defobj) | ||
| 112 | ;; The default expansion routine - urlobj is modified by side effect! | ||
| 113 | (if (url-type urlobj) | ||
| 114 | ;; Well, they told us the scheme, let's just go with it. | ||
| 115 | nil | ||
| 116 | (url-set-type urlobj (or (url-type urlobj) (url-type defobj))) | ||
| 117 | (url-set-port urlobj (or (url-port urlobj) | ||
| 118 | (and (string= (url-type urlobj) | ||
| 119 | (url-type defobj)) | ||
| 120 | (url-port defobj)))) | ||
| 121 | (if (not (string= "file" (url-type urlobj))) | ||
| 122 | (url-set-host urlobj (or (url-host urlobj) (url-host defobj)))) | ||
| 123 | (if (string= "ftp" (url-type urlobj)) | ||
| 124 | (url-set-user urlobj (or (url-user urlobj) (url-user defobj)))) | ||
| 125 | (if (string= (url-filename urlobj) "") | ||
| 126 | (url-set-filename urlobj "/")) | ||
| 127 | (if (string-match "^/" (url-filename urlobj)) | ||
| 128 | nil | ||
| 129 | (let ((query nil) | ||
| 130 | (file nil) | ||
| 131 | (sepchar nil)) | ||
| 132 | (if (string-match "[?#]" (url-filename urlobj)) | ||
| 133 | (setq query (substring (url-filename urlobj) (match-end 0)) | ||
| 134 | file (substring (url-filename urlobj) 0 (match-beginning 0)) | ||
| 135 | sepchar (substring (url-filename urlobj) (match-beginning 0) (match-end 0))) | ||
| 136 | (setq file (url-filename urlobj))) | ||
| 137 | (setq file (url-expander-remove-relative-links | ||
| 138 | (concat (url-basepath (url-filename defobj)) file))) | ||
| 139 | (url-set-filename urlobj (if query (concat file sepchar query) file)))))) | ||
| 140 | |||
| 141 | (provide 'url-expand) | ||
| 142 | |||
| 143 | ;;; arch-tag: 7b5f744b-b721-49da-be47-484631680a5a | ||
| 144 | ;;; url-expand.el ends here | ||
diff --git a/lisp/url/url-ftp.el b/lisp/url/url-ftp.el index 4346f3910b1..7f9c9de608d 100644 --- a/lisp/url/url-ftp.el +++ b/lisp/url/url-ftp.el | |||
| @@ -1,26 +1,27 @@ | |||
| 1 | ;;; url-ftp.el --- FTP wrapper | 1 | ;;; url-ftp.el --- FTP wrapper |
| 2 | |||
| 3 | ;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc. | ||
| 4 | |||
| 2 | ;; Keywords: comm, data, processes | 5 | ;; Keywords: comm, data, processes |
| 3 | 6 | ||
| 4 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 7 | ;; This file is part of GNU Emacs. |
| 5 | ;;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc. | 8 | |
| 6 | ;;; | 9 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
| 7 | ;;; This file is part of GNU Emacs. | 10 | ;; it under the terms of the GNU General Public License as published by |
| 8 | ;;; | 11 | ;; the Free Software Foundation; either version 2, or (at your option) |
| 9 | ;;; GNU Emacs is free software; you can redistribute it and/or modify | 12 | ;; any later version. |
| 10 | ;;; it under the terms of the GNU General Public License as published by | 13 | |
| 11 | ;;; the Free Software Foundation; either version 2, or (at your option) | 14 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 12 | ;;; any later version. | 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 13 | ;;; | 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 14 | ;;; GNU Emacs is distributed in the hope that it will be useful, | 17 | ;; GNU General Public License for more details. |
| 15 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | 18 | |
| 16 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | 19 | ;; You should have received a copy of the GNU General Public License |
| 17 | ;;; GNU General Public License for more details. | 20 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
| 18 | ;;; | 21 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
| 19 | ;;; You should have received a copy of the GNU General Public License | 22 | ;; Boston, MA 02111-1307, USA. |
| 20 | ;;; along with GNU Emacs; see the file COPYING. If not, write to the | 23 | |
| 21 | ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | 24 | ;;; Commentary: |
| 22 | ;;; Boston, MA 02111-1307, USA. | ||
| 23 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 24 | 25 | ||
| 25 | ;; We knew not what we did when we overloaded 'file' to mean 'file' | 26 | ;; We knew not what we did when we overloaded 'file' to mean 'file' |
| 26 | ;; and 'ftp' back in the dark ages of the web. | 27 | ;; and 'ftp' back in the dark ages of the web. |
| @@ -29,6 +30,8 @@ | |||
| 29 | ;; in url-methods.el and just maps everything onto the code in | 30 | ;; in url-methods.el and just maps everything onto the code in |
| 30 | ;; url-file. | 31 | ;; url-file. |
| 31 | 32 | ||
| 33 | ;;; Code: | ||
| 34 | |||
| 32 | (require 'url-parse) | 35 | (require 'url-parse) |
| 33 | (require 'url-file) | 36 | (require 'url-file) |
| 34 | 37 | ||
| @@ -40,3 +43,4 @@ | |||
| 40 | (provide 'url-ftp) | 43 | (provide 'url-ftp) |
| 41 | 44 | ||
| 42 | ;;; arch-tag: 9c3e70c4-350f-4d4a-bb51-a1e9b459e7dc | 45 | ;;; arch-tag: 9c3e70c4-350f-4d4a-bb51-a1e9b459e7dc |
| 46 | ;;; url-ftp.el ends here | ||
diff --git a/lisp/url/url-gw.el b/lisp/url/url-gw.el index 608827d7cee..b5701668f83 100644 --- a/lisp/url/url-gw.el +++ b/lisp/url/url-gw.el | |||
| @@ -1,27 +1,29 @@ | |||
| 1 | ;;; url-gw.el --- Gateway munging for URL loading | 1 | ;;; url-gw.el --- Gateway munging for URL loading |
| 2 | |||
| 3 | ;; Copyright (c) 1997, 1998, 2004 Free Software Foundation, Inc. | ||
| 4 | |||
| 2 | ;; Author: Bill Perry <wmperry@gnu.org> | 5 | ;; Author: Bill Perry <wmperry@gnu.org> |
| 3 | ;; Keywords: comm, data, processes | 6 | ;; Keywords: comm, data, processes |
| 4 | 7 | ||
| 5 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 8 | ;; This file is part of GNU Emacs. |
| 6 | ;;; Copyright (c) 1997, 1998, 2004 Free Software Foundation, Inc. | 9 | |
| 7 | ;;; | 10 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
| 8 | ;;; This file is part of GNU Emacs. | 11 | ;; it under the terms of the GNU General Public License as published by |
| 9 | ;;; | 12 | ;; the Free Software Foundation; either version 2, or (at your option) |
| 10 | ;;; GNU Emacs is free software; you can redistribute it and/or modify | 13 | ;; any later version. |
| 11 | ;;; it under the terms of the GNU General Public License as published by | 14 | |
| 12 | ;;; the Free Software Foundation; either version 2, or (at your option) | 15 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 13 | ;;; any later version. | 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 14 | ;;; | 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 15 | ;;; GNU Emacs is distributed in the hope that it will be useful, | 18 | ;; GNU General Public License for more details. |
| 16 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | 19 | |
| 17 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | 20 | ;; You should have received a copy of the GNU General Public License |
| 18 | ;;; GNU General Public License for more details. | 21 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
| 19 | ;;; | 22 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
| 20 | ;;; You should have received a copy of the GNU General Public License | 23 | ;; Boston, MA 02111-1307, USA. |
| 21 | ;;; along with GNU Emacs; see the file COPYING. If not, write to the | 24 | |
| 22 | ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | 25 | ;;; Code: |
| 23 | ;;; Boston, MA 02111-1307, USA. | 26 | |
| 24 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 25 | (eval-when-compile (require 'cl)) | 27 | (eval-when-compile (require 'cl)) |
| 26 | (require 'url-vars) | 28 | (require 'url-vars) |
| 27 | 29 | ||
| @@ -115,7 +117,7 @@ linked Emacs under SunOS 4.x" | |||
| 115 | (let ((proc (start-process " *nslookup*" " *nslookup*" | 117 | (let ((proc (start-process " *nslookup*" " *nslookup*" |
| 116 | url-gateway-nslookup-program host)) | 118 | url-gateway-nslookup-program host)) |
| 117 | (res host)) | 119 | (res host)) |
| 118 | (process-kill-without-query proc) | 120 | (set-process-query-on-exit-flag proc nil) |
| 119 | (save-excursion | 121 | (save-excursion |
| 120 | (set-buffer (process-buffer proc)) | 122 | (set-buffer (process-buffer proc)) |
| 121 | (while (memq (process-status proc) '(run open)) | 123 | (while (memq (process-status proc) '(run open)) |
| @@ -186,7 +188,7 @@ linked Emacs under SunOS 4.x" | |||
| 186 | proc (concat | 188 | proc (concat |
| 187 | (or url-gateway-telnet-password | 189 | (or url-gateway-telnet-password |
| 188 | (setq url-gateway-telnet-password | 190 | (setq url-gateway-telnet-password |
| 189 | (funcall url-passwd-entry-func "Password: "))) | 191 | (read-passwd "Password: "))) |
| 190 | "\n")) | 192 | "\n")) |
| 191 | (erase-buffer) | 193 | (erase-buffer) |
| 192 | (url-wait-for-string url-gateway-prompt-pattern proc) | 194 | (url-wait-for-string url-gateway-prompt-pattern proc) |
| @@ -266,3 +268,4 @@ Will not make a connexion if `url-gateway-unplugged' is non-nil." | |||
| 266 | (provide 'url-gw) | 268 | (provide 'url-gw) |
| 267 | 269 | ||
| 268 | ;;; arch-tag: 1c4c0317-6d03-45b8-b3f3-838bd8f9d838 | 270 | ;;; arch-tag: 1c4c0317-6d03-45b8-b3f3-838bd8f9d838 |
| 271 | ;;; url-gw.el ends here | ||
diff --git a/lisp/url/url-imap.el b/lisp/url/url-imap.el new file mode 100644 index 00000000000..79b53e5d012 --- /dev/null +++ b/lisp/url/url-imap.el | |||
| @@ -0,0 +1,85 @@ | |||
| 1 | ;;; url-imap.el --- IMAP retrieval routines | ||
| 2 | |||
| 3 | ;; Copyright (c) 1999 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Simon Josefsson <jas@pdc.kth.se> | ||
| 6 | ;; Keywords: comm, data, processes | ||
| 7 | |||
| 8 | ;; This file is part of GNU Emacs. | ||
| 9 | |||
| 10 | ;; GNU Emacs is free software; you can redistribute it and/or modify | ||
| 11 | ;; it under the terms of the GNU General Public License as published by | ||
| 12 | ;; the Free Software Foundation; either version 2, or (at your option) | ||
| 13 | ;; any later version. | ||
| 14 | |||
| 15 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 18 | ;; GNU General Public License for more details. | ||
| 19 | |||
| 20 | ;; You should have received a copy of the GNU General Public License | ||
| 21 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | ||
| 22 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | ||
| 23 | ;; Boston, MA 02111-1307, USA. | ||
| 24 | |||
| 25 | ;;; Commentary: | ||
| 26 | |||
| 27 | ;; Anyway, here's a teaser. It's quite broken in lots of regards, but at | ||
| 28 | ;; least it seem to work. At least a little. At least when called | ||
| 29 | ;; manually like this (I've no idea how it's supposed to be called): | ||
| 30 | |||
| 31 | ;; (url-imap (url-generic-parse-url "imap://cyrus.andrew.cmu.edu/archive.c-client;UID=1021")) | ||
| 32 | |||
| 33 | ;;; Code: | ||
| 34 | |||
| 35 | (eval-when-compile (require 'cl)) | ||
| 36 | (require 'url-util) | ||
| 37 | (require 'url-parse) | ||
| 38 | (require 'nnimap) | ||
| 39 | (require 'mm-util) | ||
| 40 | |||
| 41 | (defconst url-imap-default-port 143 "Default IMAP port") | ||
| 42 | |||
| 43 | (defun url-imap-open-host (host port user pass) | ||
| 44 | ;; xxx use user and password | ||
| 45 | (if (fboundp 'nnheader-init-server-buffer) | ||
| 46 | (nnheader-init-server-buffer)) | ||
| 47 | (let ((imap-username user) | ||
| 48 | (imap-password pass) | ||
| 49 | (authenticator (if user 'login 'anonymous))) | ||
| 50 | (if (stringp port) | ||
| 51 | (setq port (string-to-int port))) | ||
| 52 | (nnimap-open-server host | ||
| 53 | `((nnimap-server-port ,port) | ||
| 54 | (nnimap-stream 'network) | ||
| 55 | (nnimap-authenticator ,authenticator))))) | ||
| 56 | |||
| 57 | (defun url-imap (url) | ||
| 58 | (check-type url vector "Need a pre-parsed URL.") | ||
| 59 | (save-excursion | ||
| 60 | (set-buffer (generate-new-buffer " *url-imap*")) | ||
| 61 | (mm-disable-multibyte) | ||
| 62 | (let* ((host (url-host url)) | ||
| 63 | (port (url-port url)) | ||
| 64 | ;; xxx decode mailbox (see rfc2192) | ||
| 65 | (mailbox (url-filename url)) | ||
| 66 | (coding-system-for-read 'binary)) | ||
| 67 | (and (eq (string-to-char mailbox) ?/) | ||
| 68 | (setq mailbox (substring mailbox 1))) | ||
| 69 | (url-imap-open-host host port (url-user url) (url-password url)) | ||
| 70 | (cond ((assoc "TYPE" (url-attributes url)) | ||
| 71 | ;; xxx list mailboxes (start gnus?) | ||
| 72 | ) | ||
| 73 | ((assoc "UID" (url-attributes url)) | ||
| 74 | ;; fetch message part | ||
| 75 | ;; xxx handle partial fetches | ||
| 76 | (insert "Content-type: message/rfc822\n\n") | ||
| 77 | (nnimap-request-article (cdr (assoc "UID" (url-attributes url))) | ||
| 78 | mailbox host (current-buffer))) | ||
| 79 | (t | ||
| 80 | ;; xxx list messages in mailbox (start gnus?) | ||
| 81 | ))) | ||
| 82 | (current-buffer))) | ||
| 83 | |||
| 84 | ;;; arch-tag: 034991ff-5425-48ea-b911-c96c90e6f47d | ||
| 85 | ;;; url-imap.el ends here | ||
diff --git a/lisp/url/url-irc.el b/lisp/url/url-irc.el index a4b195f253f..8b54b6d9222 100644 --- a/lisp/url/url-irc.el +++ b/lisp/url/url-irc.el | |||
| @@ -1,28 +1,31 @@ | |||
| 1 | ;;; url-irc.el --- IRC URL interface | 1 | ;;; url-irc.el --- IRC URL interface |
| 2 | |||
| 3 | ;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc. | ||
| 4 | |||
| 2 | ;; Keywords: comm, data, processes | 5 | ;; Keywords: comm, data, processes |
| 3 | 6 | ||
| 4 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 7 | ;; This file is part of GNU Emacs. |
| 5 | ;;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc. | 8 | |
| 6 | ;;; | 9 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
| 7 | ;;; This file is part of GNU Emacs. | 10 | ;; it under the terms of the GNU General Public License as published by |
| 8 | ;;; | 11 | ;; the Free Software Foundation; either version 2, or (at your option) |
| 9 | ;;; GNU Emacs is free software; you can redistribute it and/or modify | 12 | ;; any later version. |
| 10 | ;;; it under the terms of the GNU General Public License as published by | 13 | |
| 11 | ;;; the Free Software Foundation; either version 2, or (at your option) | 14 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 12 | ;;; any later version. | 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 13 | ;;; | 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 14 | ;;; GNU Emacs is distributed in the hope that it will be useful, | 17 | ;; GNU General Public License for more details. |
| 15 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | 18 | |
| 16 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | 19 | ;; You should have received a copy of the GNU General Public License |
| 17 | ;;; GNU General Public License for more details. | 20 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
| 18 | ;;; | 21 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
| 19 | ;;; You should have received a copy of the GNU General Public License | 22 | ;; Boston, MA 02111-1307, USA. |
| 20 | ;;; along with GNU Emacs; see the file COPYING. If not, write to the | 23 | |
| 21 | ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | 24 | ;;; Commentary: |
| 22 | ;;; Boston, MA 02111-1307, USA. | 25 | |
| 23 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 26 | ;; IRC URLs are defined in http://www.w3.org/Addressing/draft-mirashi-url-irc-01.txt |
| 24 | 27 | ||
| 25 | ;;; IRC URLs are defined in http://www.w3.org/Addressing/draft-mirashi-url-irc-01.txt | 28 | ;;; Code: |
| 26 | 29 | ||
| 27 | (require 'url-vars) | 30 | (require 'url-vars) |
| 28 | (require 'url-parse) | 31 | (require 'url-parse) |
| @@ -74,3 +77,4 @@ PASSWORD - What password to use" | |||
| 74 | (provide 'url-irc) | 77 | (provide 'url-irc) |
| 75 | 78 | ||
| 76 | ;;; arch-tag: 2e5eecf8-9eb3-436b-9fbd-c26f2fb2bf3e | 79 | ;;; arch-tag: 2e5eecf8-9eb3-436b-9fbd-c26f2fb2bf3e |
| 80 | ;;; url-irc.el ends here | ||
diff --git a/lisp/url/url-mailto.el b/lisp/url/url-mailto.el index bcb6bad4179..f5192bcb03f 100644 --- a/lisp/url/url-mailto.el +++ b/lisp/url/url-mailto.el | |||
| @@ -25,7 +25,6 @@ | |||
| 25 | 25 | ||
| 26 | ;;; Code: | 26 | ;;; Code: |
| 27 | 27 | ||
| 28 | (eval-when-compile (require 'cl)) | ||
| 29 | (require 'url-vars) | 28 | (require 'url-vars) |
| 30 | (require 'url-parse) | 29 | (require 'url-parse) |
| 31 | (require 'url-util) | 30 | (require 'url-util) |
| @@ -85,7 +84,7 @@ | |||
| 85 | (setq args (cons (list "x-url-from" source-url) args))) | 84 | (setq args (cons (list "x-url-from" source-url) args))) |
| 86 | 85 | ||
| 87 | (if (assoc "to" args) | 86 | (if (assoc "to" args) |
| 88 | (push to (cdr (assoc "to" args))) | 87 | (push (cdr (assoc "to" args)) to) |
| 89 | (setq args (cons (list "to" to) args))) | 88 | (setq args (cons (list "to" to) args))) |
| 90 | (setq subject (cdr-safe (assoc "subject" args))) | 89 | (setq subject (cdr-safe (assoc "subject" args))) |
| 91 | (if (fboundp url-mail-command) (funcall url-mail-command) (mail)) | 90 | (if (fboundp url-mail-command) (funcall url-mail-command) (mail)) |
diff --git a/lisp/url/url-misc.el b/lisp/url/url-misc.el index ff2f1282137..21d42820e1b 100644 --- a/lisp/url/url-misc.el +++ b/lisp/url/url-misc.el | |||
| @@ -1,27 +1,29 @@ | |||
| 1 | ;;; url-misc.el --- Misc Uniform Resource Locator retrieval code | 1 | ;;; url-misc.el --- Misc Uniform Resource Locator retrieval code |
| 2 | |||
| 3 | ;; Copyright (c) 1996,1997,1998,1999,2002 Free Software Foundation, Inc. | ||
| 4 | |||
| 2 | ;; Keywords: comm, data, processes | 5 | ;; Keywords: comm, data, processes |
| 3 | 6 | ||
| 4 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 7 | ;; This file is part of GNU Emacs. |
| 5 | ;;; Copyright (c) 1996,1997,1998,1999,2002 Free Software Foundation, Inc. | 8 | |
| 6 | ;;; | 9 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
| 7 | ;;; This file is part of GNU Emacs. | 10 | ;; it under the terms of the GNU General Public License as published by |
| 8 | ;;; | 11 | ;; the Free Software Foundation; either version 2, or (at your option) |
| 9 | ;;; GNU Emacs is free software; you can redistribute it and/or modify | 12 | ;; any later version. |
| 10 | ;;; it under the terms of the GNU General Public License as published by | 13 | |
| 11 | ;;; the Free Software Foundation; either version 2, or (at your option) | 14 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 12 | ;;; any later version. | 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 13 | ;;; | 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 14 | ;;; GNU Emacs is distributed in the hope that it will be useful, | 17 | ;; GNU General Public License for more details. |
| 15 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | 18 | |
| 16 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | 19 | ;; You should have received a copy of the GNU General Public License |
| 17 | ;;; GNU General Public License for more details. | 20 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
| 18 | ;;; | 21 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
| 19 | ;;; You should have received a copy of the GNU General Public License | 22 | ;; Boston, MA 02111-1307, USA. |
| 20 | ;;; along with GNU Emacs; see the file COPYING. If not, write to the | 23 | |
| 21 | ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | 24 | ;;; Code: |
| 22 | ;;; Boston, MA 02111-1307, USA. | ||
| 23 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 24 | 25 | ||
| 26 | (eval-when-compile (require 'cl)) | ||
| 25 | (require 'url-vars) | 27 | (require 'url-vars) |
| 26 | (require 'url-parse) | 28 | (require 'url-parse) |
| 27 | (autoload 'Info-goto-node "info" "" t) | 29 | (autoload 'Info-goto-node "info" "" t) |
| @@ -115,3 +117,4 @@ | |||
| 115 | (provide 'url-misc) | 117 | (provide 'url-misc) |
| 116 | 118 | ||
| 117 | ;;; arch-tag: 8c544e1b-d8bc-40a6-b319-f1f37fef65a0 | 119 | ;;; arch-tag: 8c544e1b-d8bc-40a6-b319-f1f37fef65a0 |
| 120 | ;;; url-misc.el ends here | ||
diff --git a/lisp/url/url-news.el b/lisp/url/url-news.el index 59364c9ccd0..432c81f5d44 100644 --- a/lisp/url/url-news.el +++ b/lisp/url/url-news.el | |||
| @@ -1,26 +1,28 @@ | |||
| 1 | ;;; url-news.el --- News Uniform Resource Locator retrieval code | 1 | ;;; url-news.el --- News Uniform Resource Locator retrieval code |
| 2 | |||
| 3 | ;; Copyright (c) 1996 - 1999, 2004 Free Software Foundation, Inc. | ||
| 4 | |||
| 2 | ;; Keywords: comm, data, processes | 5 | ;; Keywords: comm, data, processes |
| 3 | 6 | ||
| 4 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 7 | ;; This file is part of GNU Emacs. |
| 5 | ;;; Copyright (c) 1996 - 1999, 2004 Free Software Foundation, Inc. | 8 | |
| 6 | ;;; | 9 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
| 7 | ;;; This file is part of GNU Emacs. | 10 | ;; it under the terms of the GNU General Public License as published by |
| 8 | ;;; | 11 | ;; the Free Software Foundation; either version 2, or (at your option) |
| 9 | ;;; GNU Emacs is free software; you can redistribute it and/or modify | 12 | ;; any later version. |
| 10 | ;;; it under the terms of the GNU General Public License as published by | 13 | |
| 11 | ;;; the Free Software Foundation; either version 2, or (at your option) | 14 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 12 | ;;; any later version. | 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 13 | ;;; | 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 14 | ;;; GNU Emacs is distributed in the hope that it will be useful, | 17 | ;; GNU General Public License for more details. |
| 15 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | 18 | |
| 16 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | 19 | ;; You should have received a copy of the GNU General Public License |
| 17 | ;;; GNU General Public License for more details. | 20 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
| 18 | ;;; | 21 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
| 19 | ;;; You should have received a copy of the GNU General Public License | 22 | ;; Boston, MA 02111-1307, USA. |
| 20 | ;;; along with GNU Emacs; see the file COPYING. If not, write to the | 23 | |
| 21 | ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | 24 | ;;; Code: |
| 22 | ;;; Boston, MA 02111-1307, USA. | 25 | |
| 23 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 24 | (require 'url-vars) | 26 | (require 'url-vars) |
| 25 | (require 'url-util) | 27 | (require 'url-util) |
| 26 | (require 'url-parse) | 28 | (require 'url-parse) |
| @@ -133,3 +135,4 @@ | |||
| 133 | (provide 'url-news) | 135 | (provide 'url-news) |
| 134 | 136 | ||
| 135 | ;;; arch-tag: 8975be13-04e8-4d38-bfff-47918e3ad311 | 137 | ;;; arch-tag: 8975be13-04e8-4d38-bfff-47918e3ad311 |
| 138 | ;;; url-news.el ends here | ||
diff --git a/lisp/url/url-ns.el b/lisp/url/url-ns.el new file mode 100644 index 00000000000..fe181422e4f --- /dev/null +++ b/lisp/url/url-ns.el | |||
| @@ -0,0 +1,107 @@ | |||
| 1 | ;;; url-ns.el --- Various netscape-ish functions for proxy definitions | ||
| 2 | |||
| 3 | ;; Copyright (c) 1997 - 1999 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Keywords: comm, data, processes, hypermedia | ||
| 6 | |||
| 7 | ;; This file is part of GNU Emacs. | ||
| 8 | |||
| 9 | ;; GNU Emacs is free software; you can redistribute it and/or modify | ||
| 10 | ;; it under the terms of the GNU General Public License as published by | ||
| 11 | ;; the Free Software Foundation; either version 2, or (at your option) | ||
| 12 | ;; any later version. | ||
| 13 | |||
| 14 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 17 | ;; GNU General Public License for more details. | ||
| 18 | |||
| 19 | ;; You should have received a copy of the GNU General Public License | ||
| 20 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | ||
| 21 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | ||
| 22 | ;; Boston, MA 02111-1307, USA. | ||
| 23 | |||
| 24 | ;;; Code: | ||
| 25 | |||
| 26 | (require 'url-gw) | ||
| 27 | |||
| 28 | ;;;###autoload | ||
| 29 | (defun isPlainHostName (host) | ||
| 30 | (not (string-match "\\." host))) | ||
| 31 | |||
| 32 | ;;;###autoload | ||
| 33 | (defun dnsDomainIs (host dom) | ||
| 34 | (string-match (concat (regexp-quote dom) "$") host)) | ||
| 35 | |||
| 36 | ;;;###autoload | ||
| 37 | (defun dnsResolve (host) | ||
| 38 | (url-gateway-nslookup-host host)) | ||
| 39 | |||
| 40 | ;;;###autoload | ||
| 41 | (defun isResolvable (host) | ||
| 42 | (if (string-match "^[0-9.]+$" host) | ||
| 43 | t | ||
| 44 | (not (string= host (url-gateway-nslookup-host host))))) | ||
| 45 | |||
| 46 | ;;;###autoload | ||
| 47 | (defun isInNet (ip net mask) | ||
| 48 | (let ((netc (split-string ip "\\.")) | ||
| 49 | (ipc (split-string net "\\.")) | ||
| 50 | (maskc (split-string mask "\\."))) | ||
| 51 | (if (or (/= (length netc) (length ipc)) | ||
| 52 | (/= (length ipc) (length maskc))) | ||
| 53 | nil | ||
| 54 | (setq netc (mapcar 'string-to-int netc) | ||
| 55 | ipc (mapcar 'string-to-int ipc) | ||
| 56 | maskc (mapcar 'string-to-int maskc)) | ||
| 57 | (and | ||
| 58 | (= (logand (nth 0 netc) (nth 0 maskc)) | ||
| 59 | (logand (nth 0 ipc) (nth 0 maskc))) | ||
| 60 | (= (logand (nth 1 netc) (nth 1 maskc)) | ||
| 61 | (logand (nth 1 ipc) (nth 1 maskc))) | ||
| 62 | (= (logand (nth 2 netc) (nth 2 maskc)) | ||
| 63 | (logand (nth 2 ipc) (nth 2 maskc))) | ||
| 64 | (= (logand (nth 3 netc) (nth 3 maskc)) | ||
| 65 | (logand (nth 3 ipc) (nth 3 maskc))))))) | ||
| 66 | |||
| 67 | ;; Netscape configuration file parsing | ||
| 68 | (defvar url-ns-user-prefs nil | ||
| 69 | "Internal, do not use.") | ||
| 70 | |||
| 71 | ;;;###autoload | ||
| 72 | (defun url-ns-prefs (&optional file) | ||
| 73 | (if (not file) | ||
| 74 | (setq file (expand-file-name "~/.netscape/preferences.js"))) | ||
| 75 | (if (not (and (file-exists-p file) | ||
| 76 | (file-readable-p file))) | ||
| 77 | (message "Could not open %s for reading" file) | ||
| 78 | (save-excursion | ||
| 79 | (let ((false nil) | ||
| 80 | (true t)) | ||
| 81 | (setq url-ns-user-prefs (make-hash-table :size 13 :test 'equal)) | ||
| 82 | (set-buffer (get-buffer-create " *ns-parse*")) | ||
| 83 | (erase-buffer) | ||
| 84 | (insert-file-contents file) | ||
| 85 | (goto-char (point-min)) | ||
| 86 | (while (re-search-forward "^//" nil t) | ||
| 87 | (replace-match ";;")) | ||
| 88 | (goto-char (point-min)) | ||
| 89 | (while (re-search-forward "^user_pref(" nil t) | ||
| 90 | (replace-match "(url-ns-set-user-pref ")) | ||
| 91 | (goto-char (point-min)) | ||
| 92 | (while (re-search-forward "\"," nil t) | ||
| 93 | (replace-match "\"")) | ||
| 94 | (goto-char (point-min)) | ||
| 95 | (eval-buffer))))) | ||
| 96 | |||
| 97 | (defun url-ns-set-user-pref (key val) | ||
| 98 | (puthash key val url-ns-user-prefs)) | ||
| 99 | |||
| 100 | ;;;###autoload | ||
| 101 | (defun url-ns-user-pref (key &optional default) | ||
| 102 | (gethash key url-ns-user-prefs default)) | ||
| 103 | |||
| 104 | (provide 'url-ns) | ||
| 105 | |||
| 106 | ;;; arch-tag: 69520992-cf97-40b4-9ad1-c866d3cae5bf | ||
| 107 | ;;; url-ns.el ends here | ||
diff --git a/lisp/url/url-privacy.el b/lisp/url/url-privacy.el index cb64cfbd4fc..50f46415b80 100644 --- a/lisp/url/url-privacy.el +++ b/lisp/url/url-privacy.el | |||
| @@ -1,26 +1,27 @@ | |||
| 1 | ;;; url-privacy.el --- Global history tracking for URL package | 1 | ;;; url-privacy.el --- Global history tracking for URL package |
| 2 | |||
| 3 | ;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc. | ||
| 4 | |||
| 2 | ;; Keywords: comm, data, processes, hypermedia | 5 | ;; Keywords: comm, data, processes, hypermedia |
| 3 | 6 | ||
| 4 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 7 | ;; This file is part of GNU Emacs. |
| 5 | ;;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc. | 8 | |
| 6 | ;;; | 9 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
| 7 | ;;; This file is part of GNU Emacs. | 10 | ;; it under the terms of the GNU General Public License as published by |
| 8 | ;;; | 11 | ;; the Free Software Foundation; either version 2, or (at your option) |
| 9 | ;;; GNU Emacs is free software; you can redistribute it and/or modify | 12 | ;; any later version. |
| 10 | ;;; it under the terms of the GNU General Public License as published by | 13 | |
| 11 | ;;; the Free Software Foundation; either version 2, or (at your option) | 14 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 12 | ;;; any later version. | 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 13 | ;;; | 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 14 | ;;; GNU Emacs is distributed in the hope that it will be useful, | 17 | ;; GNU General Public License for more details. |
| 15 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | 18 | |
| 16 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | 19 | ;; You should have received a copy of the GNU General Public License |
| 17 | ;;; GNU General Public License for more details. | 20 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
| 18 | ;;; | 21 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
| 19 | ;;; You should have received a copy of the GNU General Public License | 22 | ;; Boston, MA 02111-1307, USA. |
| 20 | ;;; along with GNU Emacs; see the file COPYING. If not, write to the | 23 | |
| 21 | ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | 24 | ;;; Code: |
| 22 | ;;; Boston, MA 02111-1307, USA. | ||
| 23 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 24 | 25 | ||
| 25 | (eval-when-compile (require 'cl)) | 26 | (eval-when-compile (require 'cl)) |
| 26 | (require 'url-vars) | 27 | (require 'url-vars) |
| @@ -79,3 +80,4 @@ | |||
| 79 | (provide 'url-privacy) | 80 | (provide 'url-privacy) |
| 80 | 81 | ||
| 81 | ;;; arch-tag: fdaf95e4-98f0-4680-94c3-f3eadafabe1d | 82 | ;;; arch-tag: fdaf95e4-98f0-4680-94c3-f3eadafabe1d |
| 83 | ;;; url-privacy.el ends here | ||
diff --git a/lisp/url/url-proxy.el b/lisp/url/url-proxy.el new file mode 100644 index 00000000000..20f1b4b7ea7 --- /dev/null +++ b/lisp/url/url-proxy.el | |||
| @@ -0,0 +1,79 @@ | |||
| 1 | ;;; url-proxy.el --- Proxy server support | ||
| 2 | |||
| 3 | ;; Copyright (c) 1999 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Keywords: comm, data, processes, hypermedia | ||
| 6 | |||
| 7 | ;; This file is part of GNU Emacs. | ||
| 8 | |||
| 9 | ;; GNU Emacs is free software; you can redistribute it and/or modify | ||
| 10 | ;; it under the terms of the GNU General Public License as published by | ||
| 11 | ;; the Free Software Foundation; either version 2, or (at your option) | ||
| 12 | ;; any later version. | ||
| 13 | |||
| 14 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 17 | ;; GNU General Public License for more details. | ||
| 18 | |||
| 19 | ;; You should have received a copy of the GNU General Public License | ||
| 20 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | ||
| 21 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | ||
| 22 | ;; Boston, MA 02111-1307, USA. | ||
| 23 | |||
| 24 | ;;; Code: | ||
| 25 | |||
| 26 | (require 'url-parse) | ||
| 27 | (autoload 'url-warn "url") | ||
| 28 | |||
| 29 | (defun url-default-find-proxy-for-url (urlobj host) | ||
| 30 | (cond | ||
| 31 | ((or (and (assoc "no_proxy" url-proxy-services) | ||
| 32 | (string-match | ||
| 33 | (cdr | ||
| 34 | (assoc "no_proxy" url-proxy-services)) | ||
| 35 | host)) | ||
| 36 | (equal "www" (url-type urlobj))) | ||
| 37 | "DIRECT") | ||
| 38 | ((cdr (assoc (url-type urlobj) url-proxy-services)) | ||
| 39 | (concat "PROXY " (cdr (assoc (url-type urlobj) url-proxy-services)))) | ||
| 40 | ;; | ||
| 41 | ;; Should check for socks | ||
| 42 | ;; | ||
| 43 | (t | ||
| 44 | "DIRECT"))) | ||
| 45 | |||
| 46 | (defvar url-proxy-locator 'url-default-find-proxy-for-url) | ||
| 47 | |||
| 48 | (defun url-find-proxy-for-url (url host) | ||
| 49 | (let ((proxies (split-string (funcall url-proxy-locator url host) " *; *")) | ||
| 50 | (proxy nil) | ||
| 51 | (case-fold-search t)) | ||
| 52 | ;; Not sure how I should handle gracefully degrading from one proxy to | ||
| 53 | ;; another, so for now just deal with the first one | ||
| 54 | ;; (while proxies | ||
| 55 | (if (listp proxies) | ||
| 56 | (setq proxy (car proxies)) | ||
| 57 | (setq proxy proxies)) | ||
| 58 | (cond | ||
| 59 | ((string-match "^direct" proxy) nil) | ||
| 60 | ((string-match "^proxy +" proxy) | ||
| 61 | (concat "http://" (substring proxy (match-end 0)) "/")) | ||
| 62 | ((string-match "^socks +" proxy) | ||
| 63 | (concat "socks://" (substring proxy (match-end 0)))) | ||
| 64 | (t | ||
| 65 | (url-warn 'url (format "Unknown proxy directive: %s" proxy) 'critical) | ||
| 66 | nil)))) | ||
| 67 | |||
| 68 | (defun url-proxy (url callback &optional cbargs) | ||
| 69 | ;; Retrieve URL from a proxy. | ||
| 70 | ;; Expects `url-using-proxy' to be bound to the specific proxy to use." | ||
| 71 | (setq url-using-proxy (url-generic-parse-url url-using-proxy)) | ||
| 72 | (let ((proxy-object (copy-sequence url))) | ||
| 73 | (url-set-target proxy-object nil) | ||
| 74 | (url-http url-using-proxy callback cbargs))) | ||
| 75 | |||
| 76 | (provide 'url-proxy) | ||
| 77 | |||
| 78 | ;;; arch-tag: 4ff8882e-e498-42b7-abc5-acb449cdbc62 | ||
| 79 | ;;; url-proxy.el ends here | ||
diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el index 5d1f73e0d5d..1d0bfcf0c48 100644 --- a/lisp/url/url-util.el +++ b/lisp/url/url-util.el | |||
| @@ -192,13 +192,13 @@ Will not do anything if `url-show-status' is nil." | |||
| 192 | (nth 1 (current-time-zone)) | 192 | (nth 1 (current-time-zone)) |
| 193 | "GMT")) | 193 | "GMT")) |
| 194 | (parsed (timezone-parse-date gmt)) | 194 | (parsed (timezone-parse-date gmt)) |
| 195 | (day (cdr-safe (assoc (substring raw 0 3) weekday-alist))) | 195 | (day (cdr-safe (assoc (substring raw 0 3) url-weekday-alist))) |
| 196 | (year nil) | 196 | (year nil) |
| 197 | (month (car | 197 | (month (car |
| 198 | (rassoc | 198 | (rassoc |
| 199 | (string-to-int (aref parsed 1)) monthabbrev-alist))) | 199 | (string-to-int (aref parsed 1)) url-monthabbrev-alist))) |
| 200 | ) | 200 | ) |
| 201 | (setq day (or (car-safe (rassoc day weekday-alist)) | 201 | (setq day (or (car-safe (rassoc day url-weekday-alist)) |
| 202 | (substring raw 0 3)) | 202 | (substring raw 0 3)) |
| 203 | year (aref parsed 0)) | 203 | year (aref parsed 0)) |
| 204 | ;; This is needed for plexus servers, or the server will hang trying to | 204 | ;; This is needed for plexus servers, or the server will hang trying to |
diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el index a33d8ba43e3..e4073db4271 100644 --- a/lisp/url/url-vars.el +++ b/lisp/url/url-vars.el | |||
| @@ -1,26 +1,27 @@ | |||
| 1 | ;;; url-vars.el --- Variables for Uniform Resource Locator tool | 1 | ;;; url-vars.el --- Variables for Uniform Resource Locator tool |
| 2 | |||
| 3 | ;; Copyright (c) 1996,1997,1998,1999,2001,2004 Free Software Foundation, Inc. | ||
| 4 | |||
| 2 | ;; Keywords: comm, data, processes, hypermedia | 5 | ;; Keywords: comm, data, processes, hypermedia |
| 3 | 6 | ||
| 4 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 7 | ;; This file is part of GNU Emacs. |
| 5 | ;;; Copyright (c) 1996,1997,1998,1999,2001,2004 Free Software Foundation, Inc. | 8 | |
| 6 | ;;; | 9 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
| 7 | ;;; This file is part of GNU Emacs. | 10 | ;; it under the terms of the GNU General Public License as published by |
| 8 | ;;; | 11 | ;; the Free Software Foundation; either version 2, or (at your option) |
| 9 | ;;; GNU Emacs is free software; you can redistribute it and/or modify | 12 | ;; any later version. |
| 10 | ;;; it under the terms of the GNU General Public License as published by | 13 | |
| 11 | ;;; the Free Software Foundation; either version 2, or (at your option) | 14 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 12 | ;;; any later version. | 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 13 | ;;; | 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 14 | ;;; GNU Emacs is distributed in the hope that it will be useful, | 17 | ;; GNU General Public License for more details. |
| 15 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | 18 | |
| 16 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | 19 | ;; You should have received a copy of the GNU General Public License |
| 17 | ;;; GNU General Public License for more details. | 20 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
| 18 | ;;; | 21 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
| 19 | ;;; You should have received a copy of the GNU General Public License | 22 | ;; Boston, MA 02111-1307, USA. |
| 20 | ;;; along with GNU Emacs; see the file COPYING. If not, write to the | 23 | |
| 21 | ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | 24 | ;;; Code: |
| 22 | ;;; Boston, MA 02111-1307, USA. | ||
| 23 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 24 | 25 | ||
| 25 | (require 'mm-util) | 26 | (require 'mm-util) |
| 26 | 27 | ||
| @@ -191,19 +192,6 @@ from the ACCESS_proxy environment variables." | |||
| 191 | (string :tag "Proxy"))) | 192 | (string :tag "Proxy"))) |
| 192 | :group 'url) | 193 | :group 'url) |
| 193 | 194 | ||
| 194 | (defcustom url-passwd-entry-func nil | ||
| 195 | "*Symbol indicating which function to call to read in a password. | ||
| 196 | It will be set up depending on whether you are running EFS or ange-ftp | ||
| 197 | at startup if it is nil. This function should accept the prompt | ||
| 198 | string as its first argument, and the default value as its second | ||
| 199 | argument." | ||
| 200 | :type '(choice (const :tag "Guess" :value nil) | ||
| 201 | (const :tag "Use Ange-FTP" :value ange-ftp-read-passwd) | ||
| 202 | (const :tag "Use EFS" :value efs-read-passwd) | ||
| 203 | (const :tag "Use Password Package" :value read-passwd) | ||
| 204 | (function :tag "Other")) | ||
| 205 | :group 'url-hairy) | ||
| 206 | |||
| 207 | (defcustom url-standalone-mode nil | 195 | (defcustom url-standalone-mode nil |
| 208 | "*Rely solely on the cache?" | 196 | "*Rely solely on the cache?" |
| 209 | :type 'boolean | 197 | :type 'boolean |
| @@ -240,24 +228,6 @@ Should be an assoc list of headers/contents.") | |||
| 240 | (defvar url-mime-encoding-string nil | 228 | (defvar url-mime-encoding-string nil |
| 241 | "*String to send in the Accept-encoding: field in HTTP requests.") | 229 | "*String to send in the Accept-encoding: field in HTTP requests.") |
| 242 | 230 | ||
| 243 | ;; `mm-mime-mule-charset-alist' in Gnus 5.8/9 contains elements whose | ||
| 244 | ;; cars aren't valid MIME charsets/coding systems, at least in Emacs. | ||
| 245 | ;; This gets it correct by construction in Emacs. Fixme: DTRT for | ||
| 246 | ;; XEmacs -- its `coding-system-list' doesn't have the BASE-ONLY arg. | ||
| 247 | (when (and (not (featurep 'xemacs)) | ||
| 248 | (fboundp 'coding-system-list)) | ||
| 249 | (setq mm-mime-mule-charset-alist | ||
| 250 | (apply | ||
| 251 | 'nconc | ||
| 252 | (mapcar | ||
| 253 | (lambda (cs) | ||
| 254 | (when (and (coding-system-get cs 'mime-charset) | ||
| 255 | (not (eq t (coding-system-get cs 'safe-charsets)))) | ||
| 256 | (list (cons (coding-system-get cs 'mime-charset) | ||
| 257 | (delq 'ascii | ||
| 258 | (coding-system-get cs 'safe-charsets)))))) | ||
| 259 | (coding-system-list 'base-only))))) | ||
| 260 | |||
| 261 | ;; Perhaps the first few should actually be given decreasing `q's and | 231 | ;; Perhaps the first few should actually be given decreasing `q's and |
| 262 | ;; the list should be trimmed significantly. | 232 | ;; the list should be trimmed significantly. |
| 263 | ;; Fixme: do something sane if we don't have `sort-coding-systems' | 233 | ;; Fixme: do something sane if we don't have `sort-coding-systems' |
| @@ -381,14 +351,14 @@ Currently supported methods: | |||
| 381 | 351 | ||
| 382 | (defvar url-setup-done nil "Has setup configuration been done?") | 352 | (defvar url-setup-done nil "Has setup configuration been done?") |
| 383 | 353 | ||
| 384 | (defconst weekday-alist | 354 | (defconst url-weekday-alist |
| 385 | '(("Sunday" . 0) ("Monday" . 1) ("Tuesday" . 2) ("Wednesday" . 3) | 355 | '(("Sunday" . 0) ("Monday" . 1) ("Tuesday" . 2) ("Wednesday" . 3) |
| 386 | ("Thursday" . 4) ("Friday" . 5) ("Saturday" . 6) | 356 | ("Thursday" . 4) ("Friday" . 5) ("Saturday" . 6) |
| 387 | ("Tues" . 2) ("Thurs" . 4) | 357 | ("Tues" . 2) ("Thurs" . 4) |
| 388 | ("Sun" . 0) ("Mon" . 1) ("Tue" . 2) ("Wed" . 3) | 358 | ("Sun" . 0) ("Mon" . 1) ("Tue" . 2) ("Wed" . 3) |
| 389 | ("Thu" . 4) ("Fri" . 5) ("Sat" . 6))) | 359 | ("Thu" . 4) ("Fri" . 5) ("Sat" . 6))) |
| 390 | 360 | ||
| 391 | (defconst monthabbrev-alist | 361 | (defconst url-monthabbrev-alist |
| 392 | '(("Jan" . 1) ("Feb" . 2) ("Mar" . 3) ("Apr" . 4) ("May" . 5) ("Jun" . 6) | 362 | '(("Jan" . 1) ("Feb" . 2) ("Mar" . 3) ("Apr" . 4) ("May" . 5) ("Jun" . 6) |
| 393 | ("Jul" . 7) ("Aug" . 8) ("Sep" . 9) ("Oct" . 10) ("Nov" . 11) | 363 | ("Jul" . 7) ("Aug" . 8) ("Sep" . 9) ("Oct" . 10) ("Nov" . 11) |
| 394 | ("Dec" . 12))) | 364 | ("Dec" . 12))) |
| @@ -425,6 +395,8 @@ This should be set, e.g. by mail user agents rendering HTML to avoid | |||
| 425 | (defun url-vars-unload-hook () | 395 | (defun url-vars-unload-hook () |
| 426 | (remove-hook 'set-language-environment-hook 'url-set-mime-charset-string)) | 396 | (remove-hook 'set-language-environment-hook 'url-set-mime-charset-string)) |
| 427 | 397 | ||
| 398 | (add-hook 'url-vars-unload-hook 'url-vars-unload-hook) | ||
| 399 | |||
| 428 | (provide 'url-vars) | 400 | (provide 'url-vars) |
| 429 | 401 | ||
| 430 | ;;; arch-tag: 29205e5f-c5ce-433c-8d5d-38cbaed64b49 | 402 | ;;; arch-tag: 29205e5f-c5ce-433c-8d5d-38cbaed64b49 |
diff --git a/lisp/url/url.el b/lisp/url/url.el index f7b1b717681..75ddfdc3a2f 100644 --- a/lisp/url/url.el +++ b/lisp/url/url.el | |||
| @@ -113,26 +113,6 @@ Emacs." | |||
| 113 | noproxy "") "\\)")) | 113 | noproxy "") "\\)")) |
| 114 | url-proxy-services)))) | 114 | url-proxy-services)))) |
| 115 | 115 | ||
| 116 | ;; Set the password entry funtion based on user defaults or guess | ||
| 117 | ;; based on which remote-file-access package they are using. | ||
| 118 | (cond | ||
| 119 | (url-passwd-entry-func nil) ; Already been set | ||
| 120 | ((fboundp 'read-passwd) ; Use secure password if available | ||
| 121 | (setq url-passwd-entry-func 'read-passwd)) | ||
| 122 | ((or (featurep 'efs) ; Using EFS | ||
| 123 | (featurep 'efs-auto)) ; or autoloading efs | ||
| 124 | (if (not (fboundp 'read-passwd)) | ||
| 125 | (autoload 'read-passwd "passwd" "Read in a password" nil)) | ||
| 126 | (setq url-passwd-entry-func 'read-passwd)) | ||
| 127 | ((or (featurep 'ange-ftp) ; Using ange-ftp | ||
| 128 | (and (boundp 'file-name-handler-alist) | ||
| 129 | (not (featurep 'xemacs)))) ; ?? | ||
| 130 | (setq url-passwd-entry-func 'ange-ftp-read-passwd)) | ||
| 131 | (t | ||
| 132 | (url-warn | ||
| 133 | 'security | ||
| 134 | "(url-setup): Can't determine how to read passwords, winging it."))) | ||
| 135 | |||
| 136 | (url-setup-privacy-info) | 116 | (url-setup-privacy-info) |
| 137 | (run-hooks 'url-load-hook) | 117 | (run-hooks 'url-load-hook) |
| 138 | (setq url-setup-done t))) | 118 | (setq url-setup-done t))) |
diff --git a/lisp/vc-arch.el b/lisp/vc-arch.el index e32fc474d94..70dbdcc85f2 100644 --- a/lisp/vc-arch.el +++ b/lisp/vc-arch.el | |||
| @@ -283,8 +283,8 @@ Return non-nil if FILE is unchanged." | |||
| 283 | (setq logdir (expand-file-name version logdir)) | 283 | (setq logdir (expand-file-name version logdir)) |
| 284 | (setq logdir (expand-file-name archive logdir)) | 284 | (setq logdir (expand-file-name archive logdir)) |
| 285 | (setq logdir (expand-file-name "patch-log" logdir)) | 285 | (setq logdir (expand-file-name "patch-log" logdir)) |
| 286 | ;; Revision names go: base-0, patch-N, version-0, versionfix-N. | 286 | (dolist (file (if (file-directory-p logdir) (directory-files logdir))) |
| 287 | (dolist (file (directory-files logdir)) | 287 | ;; Revision names go: base-0, patch-N, version-0, versionfix-M. |
| 288 | (when (and (eq (aref file 0) ?v) (not sealed)) | 288 | (when (and (eq (aref file 0) ?v) (not sealed)) |
| 289 | (setq sealed t rev-nb 0)) | 289 | (setq sealed t rev-nb 0)) |
| 290 | (if (and (string-match "-\\([0-9]+\\)\\'" file) | 290 | (if (and (string-match "-\\([0-9]+\\)\\'" file) |
diff --git a/lisp/vc-hooks.el b/lisp/vc-hooks.el index fef1431fe7d..22ff9edd428 100644 --- a/lisp/vc-hooks.el +++ b/lisp/vc-hooks.el | |||
| @@ -754,8 +754,8 @@ current, and kill the buffer that visits the link." | |||
| 754 | (set (make-local-variable 'backup-inhibited) t)) | 754 | (set (make-local-variable 'backup-inhibited) t)) |
| 755 | ;; Let the backend setup any buffer-local things he needs. | 755 | ;; Let the backend setup any buffer-local things he needs. |
| 756 | (vc-call-backend (vc-backend buffer-file-name) 'find-file-hook)) | 756 | (vc-call-backend (vc-backend buffer-file-name) 'find-file-hook)) |
| 757 | ((let* ((link (file-symlink-p buffer-file-name)) | 757 | ((let ((link-type (and (file-symlink-p buffer-file-name) |
| 758 | (link-type (and link (vc-backend (file-chase-links link))))) | 758 | (vc-backend (file-chase-links buffer-file-name))))) |
| 759 | (cond ((not link-type) nil) ;Nothing to do. | 759 | (cond ((not link-type) nil) ;Nothing to do. |
| 760 | ((eq vc-follow-symlinks nil) | 760 | ((eq vc-follow-symlinks nil) |
| 761 | (message | 761 | (message |
diff --git a/lisp/view.el b/lisp/view.el index b17cd52ae35..e184d68b117 100644 --- a/lisp/view.el +++ b/lisp/view.el | |||
| @@ -117,12 +117,12 @@ functions that enable or disable view mode.") | |||
| 117 | 117 | ||
| 118 | (defvar view-page-size nil | 118 | (defvar view-page-size nil |
| 119 | "Default number of lines to scroll by View page commands. | 119 | "Default number of lines to scroll by View page commands. |
| 120 | If nil then the local value of this is initially set to window size.") | 120 | If nil that means use the window size.") |
| 121 | (make-variable-buffer-local 'view-page-size) | 121 | (make-variable-buffer-local 'view-page-size) |
| 122 | 122 | ||
| 123 | (defvar view-half-page-size nil | 123 | (defvar view-half-page-size nil |
| 124 | "Default number of lines to scroll by View half page commands. | 124 | "Default number of lines to scroll by View half page commands. |
| 125 | If nil then the local value of this is initially set to half window size.") | 125 | If nil that means use half the window size.") |
| 126 | (make-variable-buffer-local 'view-half-page-size) | 126 | (make-variable-buffer-local 'view-half-page-size) |
| 127 | 127 | ||
| 128 | (defvar view-last-regexp nil) | 128 | (defvar view-last-regexp nil) |
| @@ -453,8 +453,8 @@ Entry to view-mode runs the normal hook `view-mode-hook'." | |||
| 453 | ;; This is to guarantee that the buffer-read-only variable is restored. | 453 | ;; This is to guarantee that the buffer-read-only variable is restored. |
| 454 | (add-hook 'change-major-mode-hook 'view-mode-disable nil t) | 454 | (add-hook 'change-major-mode-hook 'view-mode-disable nil t) |
| 455 | (setq view-mode t | 455 | (setq view-mode t |
| 456 | view-page-size (view-page-size-default view-page-size) | 456 | view-page-size nil |
| 457 | view-half-page-size (or view-half-page-size (/ (view-window-size) 2)) | 457 | view-half-page-size nil |
| 458 | view-old-buffer-read-only buffer-read-only | 458 | view-old-buffer-read-only buffer-read-only |
| 459 | buffer-read-only t | 459 | buffer-read-only t |
| 460 | view-old-Helper-return-blurb (and (boundp 'Helper-return-blurb) | 460 | view-old-Helper-return-blurb (and (boundp 'Helper-return-blurb) |
| @@ -675,7 +675,8 @@ previous state and go to previous buffer or window." | |||
| 675 | 675 | ||
| 676 | (defun view-set-half-page-size-default (lines) | 676 | (defun view-set-half-page-size-default (lines) |
| 677 | ;; Get and maybe set half page size. | 677 | ;; Get and maybe set half page size. |
| 678 | (if (not lines) view-half-page-size | 678 | (if (not lines) (or view-half-page-size |
| 679 | (/ (view-window-size) 2)) | ||
| 679 | (setq view-half-page-size | 680 | (setq view-half-page-size |
| 680 | (if (zerop (setq lines (prefix-numeric-value lines))) | 681 | (if (zerop (setq lines (prefix-numeric-value lines))) |
| 681 | (/ (view-window-size) 2) | 682 | (/ (view-window-size) 2) |
| @@ -803,13 +804,13 @@ Exit if end of text is visible and `view-scroll-auto-exit' is non-nil. | |||
| 803 | \\[View-scroll-page-backward-set-page-size]. | 804 | \\[View-scroll-page-backward-set-page-size]. |
| 804 | If LINES is more than a window-full, only the last window-full is shown." | 805 | If LINES is more than a window-full, only the last window-full is shown." |
| 805 | (interactive "P") | 806 | (interactive "P") |
| 806 | (view-scroll-lines lines nil view-page-size nil)) | 807 | (view-scroll-lines lines nil (view-page-size-default view-page-size) nil)) |
| 807 | 808 | ||
| 808 | (defun View-scroll-page-backward (&optional lines) | 809 | (defun View-scroll-page-backward (&optional lines) |
| 809 | "Scroll \"page size\" or prefix LINES lines backward in View mode. | 810 | "Scroll \"page size\" or prefix LINES lines backward in View mode. |
| 810 | See also `View-scroll-page-forward'." | 811 | See also `View-scroll-page-forward'." |
| 811 | (interactive "P") | 812 | (interactive "P") |
| 812 | (view-scroll-lines lines t view-page-size nil)) | 813 | (view-scroll-lines lines t (view-page-size-default view-page-size) nil)) |
| 813 | 814 | ||
| 814 | (defun View-scroll-page-forward-set-page-size (&optional lines) | 815 | (defun View-scroll-page-forward-set-page-size (&optional lines) |
| 815 | "Scroll forward LINES lines in View mode, setting the \"page size\". | 816 | "Scroll forward LINES lines in View mode, setting the \"page size\". |
diff --git a/lisp/whitespace.el b/lisp/whitespace.el index 40a234f02d6..323c75ed6de 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el | |||
| @@ -859,6 +859,8 @@ This is meant to be added buffer-locally to `write-file-functions'." | |||
| 859 | (remove-hook 'write-file-functions 'whitespace-write-file-hook t) | 859 | (remove-hook 'write-file-functions 'whitespace-write-file-hook t) |
| 860 | (remove-hook 'kill-buffer-hook 'whitespace-buffer)) | 860 | (remove-hook 'kill-buffer-hook 'whitespace-buffer)) |
| 861 | 861 | ||
| 862 | (add-hook 'whitespace-unload-hook 'whitespace-unload-hook) | ||
| 863 | |||
| 862 | (provide 'whitespace) | 864 | (provide 'whitespace) |
| 863 | 865 | ||
| 864 | ;;; arch-tag: 4ff44e87-b63c-402d-95a6-15e51e58bd0c | 866 | ;;; arch-tag: 4ff44e87-b63c-402d-95a6-15e51e58bd0c |