diff options
| author | Kenichi Handa <handa@m17n.org> | 2010-09-22 11:56:28 +0900 |
|---|---|---|
| committer | Kenichi Handa <handa@m17n.org> | 2010-09-22 11:56:28 +0900 |
| commit | 1114abdb3d5a0f4f86d7a28f8c523c6f07790208 (patch) | |
| tree | 49871b5c4ffce9d6c281ccbc79a79b231e5f41b4 | |
| parent | 86282aabd0094aac190834788200bd049a976fc9 (diff) | |
| parent | ee705a5c54c4054bcd1608e5cd5be193e679d0db (diff) | |
| download | emacs-1114abdb3d5a0f4f86d7a28f8c523c6f07790208.tar.gz | |
merge trunk
| -rw-r--r-- | doc/misc/ChangeLog | 5 | ||||
| -rw-r--r-- | doc/misc/gnus.texi | 2 | ||||
| -rw-r--r-- | lisp/ChangeLog | 7 | ||||
| -rw-r--r-- | lisp/emacs-lisp/smie.el | 29 | ||||
| -rw-r--r-- | lisp/gnus/ChangeLog | 78 | ||||
| -rw-r--r-- | lisp/gnus/gnus-group.el | 29 | ||||
| -rw-r--r-- | lisp/gnus/gnus-html.el | 341 | ||||
| -rw-r--r-- | lisp/gnus/gnus-int.el | 14 | ||||
| -rw-r--r-- | lisp/gnus/gnus-start.el | 22 | ||||
| -rw-r--r-- | lisp/gnus/gnus-sum.el | 9 | ||||
| -rw-r--r-- | lisp/gnus/gnus.el | 84 | ||||
| -rw-r--r-- | lisp/gnus/nnimap.el | 162 | ||||
| -rw-r--r-- | lisp/gnus/nnmail.el | 15 | ||||
| -rw-r--r-- | lisp/gnus/nnml.el | 33 | ||||
| -rwxr-xr-x | nt/configure.bat | 40 | ||||
| -rw-r--r-- | src/ChangeLog | 9 | ||||
| -rw-r--r-- | src/doc.c | 2 | ||||
| -rw-r--r-- | src/makefile.w32-in | 1 |
18 files changed, 570 insertions, 312 deletions
diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index 68d6d3c8f00..3e723cd8c83 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog @@ -1,3 +1,8 @@ +2010-09-21 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus.texi (Expunging mailboxes): Update name of the expunging + command. + 2010-09-20 Katsumi Yamaoka <yamaoka@jpl.org> * emacs-mime.texi (rfc2047): Update description for diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 841cf8c510c..52c8bb642f0 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -18384,7 +18384,7 @@ INBOX.mailbox). @cindex expunge @cindex manual expunging @kindex G x (Group) -@findex gnus-group-nnimap-expunge +@findex gnus-group-expunge-group If you're using the @code{never} setting of @code{nnimap-expunge-on-close}, you may want the option of expunging all deleted articles in a mailbox diff --git a/lisp/ChangeLog b/lisp/ChangeLog index e293d7612ba..9900472a59d 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,10 @@ +2010-09-21 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/smie.el (smie-debug--describe-cycle): Fix typo. + (smie-indent-comment): Be more careful with comment-start-skip. + (smie-indent-comment-close, smie-indent-comment-inside): New funs. + (smie-indent-functions): Use them. + 2010-09-21 Michael Albinus <michael.albinus@gmx.de> * net/ange-ftp.el (ange-ftp-skip-msgs): Add "^504 ..." message. diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el index 0267e9771f5..55516d276da 100644 --- a/lisp/emacs-lisp/smie.el +++ b/lisp/emacs-lisp/smie.el @@ -338,7 +338,7 @@ CSTS is a list of pairs representing arcs in a graph." res)) cycle))) (mapconcat - (lambda (elems) (mapconcat 'indentity elems "=")) + (lambda (elems) (mapconcat 'identity elems "=")) (append names (list (car names))) " < "))) @@ -1173,7 +1173,11 @@ in order to figure out the indentation of some other (further down) point." ;; front of a comment" when doing virtual-indentation anyway. And if we are ;; (as can happen in octave-mode), moving forward can lead to inf-loops. (and (smie-indent--bolp) - (looking-at comment-start-skip) + (let ((pos (point))) + (save-excursion + (beginning-of-line) + (and (re-search-forward comment-start-skip (line-end-position) t) + (eq pos (or (match-end 1) (match-beginning 0)))))) (save-excursion (forward-comment (point-max)) (skip-chars-forward " \t\r\n") @@ -1194,6 +1198,20 @@ in order to figure out the indentation of some other (further down) point." (if (looking-at (regexp-quote continue)) (current-column)))))))) +(defun smie-indent-comment-close () + (and (boundp 'comment-end-skip) + comment-end-skip + (not (looking-at " \t*$")) ;Not just a \n comment-closer. + (looking-at comment-end-skip) + (nth 4 (syntax-ppss)) + (save-excursion + (goto-char (nth 8 (syntax-ppss))) + (current-column)))) + +(defun smie-indent-comment-inside () + (and (nth 4 (syntax-ppss)) + 'noindent)) + (defun smie-indent-after-keyword () ;; Indentation right after a special keyword. (save-excursion @@ -1275,9 +1293,10 @@ in order to figure out the indentation of some other (further down) point." (current-column))))))) (defvar smie-indent-functions - '(smie-indent-fixindent smie-indent-bob smie-indent-close smie-indent-comment - smie-indent-comment-continue smie-indent-keyword smie-indent-after-keyword - smie-indent-exps) + '(smie-indent-fixindent smie-indent-bob smie-indent-close + smie-indent-comment smie-indent-comment-continue smie-indent-comment-close + smie-indent-comment-inside smie-indent-keyword smie-indent-after-keyword + smie-indent-exps) "Functions to compute the indentation. Each function is called with no argument, shouldn't move point, and should return either nil if it has no opinion, or an integer representing the column diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index b85618ae705..eeba68f81a2 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,81 @@ +2010-09-21 Adam Sjøgren <asjo@koldfront.dk> + + * gnus-sum.el (gnus-adjust-marked-articles): Fix typo. + +2010-09-21 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-int.el (gnus-open-server): Give a better error message in the + "go offline" case. + + * gnus-sum.el (gnus-adjust-marked-articles): Hack to avoid adjusting + marks for nnimap, which is seldom the right thing to do. + + * gnus.el (gnus-sloppily-equal-method-parameters): Refactor out. + (gnus-same-method-different-name): New function. + + * nnimap.el (parse-time): Require. + + * gnus-start.el (gnus-get-unread-articles): Fix the prefixed select + method in the presence of many similar methods. + + * nnmail.el (nnmail-expired-article-p): Fix typo: time-subtract. + + * nnimap.el (nnimap-find-expired-articles): Don't refer to + nnml-inhibit-expiry. + + * gnus-sum.el (gnus-summary-move-article): Use gnus-server-equal to + find out whether methods are equal. + + * nnimap.el (nnimap-find-expired-articles): New function. + (nnimap-process-expiry-targets): New function. + (nnimap-request-move-article): Request the article before looking at + what the Message-ID is. Fix found by Andrew Cohen. + (nnimap-mark-and-expunge-incoming): Wait for the last sequence. + + * nnmail.el (nnmail-expired-article-p): Allow returning the cutoff time + for oldness in addition to being a predicate. + + * nnimap.el (nnimap-request-group): When we have zero articles, return + the right data to Gnus. + (nnimap-request-expire-articles): Only delete articles immediately if + the target is 'delete. + + * gnus-sum.el (gnus-summary-move-article): When respooling to the same + method, this would bug out. + + * gnus-group.el (gnus-group-expunge-group): Renamed from + gnus-group-nnimap-expunge, and implemented as a normal interface + function. + + * gnus-int.el (gnus-request-expunge-group): New function. + + * nnimap.el (nnimap-request-create-group): Implement. + (nnimap-request-expunge-group): New function. + +2010-09-21 Julien Danjou <julien@danjou.info> + + * gnus-html.el (gnus-html-image-cache-ttl): Add new variable. + (gnus-html-cache-expired): Add new function. + (gnus-html-wash-images): Use `gnus-html-cache-expired' to check + wethever we should display image for fetch it. + Compute alt-text earlier to pass it to the fetching function too. + (gnus-html-schedule-image-fetching): Change function argument to only + get one image at a time, not a list. + (gnus-html-image-fetched): Use `url-store-in-cache' to store image in + cache. + (gnus-html-get-image-data): New function to retrieve image data from + cache. + (gnus-html-put-image): Change buffer argument to use image data rather + than file, and place image above region rather than inserting a new + one. Do not take alt-text as argument, since it's useless now: we place + the image above alt-text. + (gnus-html-prune-cache): Remove. + (gnus-html-show-images): Start to fetch image when we find one, do not + push into a temporary list. + (gnus-html-prefetch-images): Only fetch image if they have expired. + (gnus-html-browse-image): Fix, use 'gnus-image-url. + (gnus-html-image-map): Add "v" to browse-url on undisplayed image. + 2010-09-20 Katsumi Yamaoka <yamaoka@jpl.org> * rfc2047.el (rfc2047-encode-parameter): Doc fix. diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index fa6ae51886c..80cf580b84a 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -509,7 +509,10 @@ simple manner.") (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))))) (t number)) ?s) (?R gnus-tmp-number-of-read ?s) - (?U (gnus-number-of-unseen-articles-in-group gnus-tmp-group) ?d) + (?U (if (gnus-active gnus-tmp-group) + (gnus-number-of-unseen-articles-in-group gnus-tmp-group) + "*") + ?s) (?t gnus-tmp-number-total ?d) (?y gnus-tmp-number-of-unread ?s) (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d) @@ -675,7 +678,7 @@ simple manner.") "R" gnus-group-make-rss-group "c" gnus-group-customize "z" gnus-group-compact-group - "x" gnus-group-nnimap-expunge + "x" gnus-group-expunge-group "\177" gnus-group-delete-group [delete] gnus-group-delete-group) @@ -3163,21 +3166,17 @@ mail messages or news articles in files that have numeric names." 'summary 'group))) (error "Couldn't enter %s" dir)))) -(autoload 'nnimap-expunge "nnimap") -(autoload 'nnimap-acl-get "nnimap") -(autoload 'nnimap-acl-edit "nnimap") - -(defun gnus-group-nnimap-expunge (group) +(defun gnus-group-expunge-group (group) "Expunge deleted articles in current nnimap GROUP." (interactive (list (gnus-group-group-name))) - (let ((mailbox (gnus-group-real-name group)) method) - (unless group - (error "No group on current line")) - (unless (gnus-get-info group) - (error "Killed group; can't be edited")) - (unless (eq 'nnimap (car (setq method (gnus-find-method-for-group group)))) - (error "%s is not an nnimap group" group)) - (nnimap-expunge mailbox (cadr method)))) + (let ((method (gnus-find-method-for-group group))) + (if (not (gnus-check-backend-function + 'request-expunge-group (car method))) + (error "%s does not support expunging" (car method)) + (gnus-request-expunge-group group method)))) + +(autoload 'nnimap-acl-get "nnimap") +(autoload 'nnimap-acl-edit "nnimap") (defun gnus-group-nnimap-edit-acl (group) "Edit the Access Control List of current nnimap GROUP." diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el index 78bb7ca18b5..34dbb4dd878 100644 --- a/lisp/gnus/gnus-html.el +++ b/lisp/gnus/gnus-html.el @@ -34,15 +34,10 @@ (require 'gnus-art) (require 'mm-url) (require 'url) +(require 'url-cache) -(defcustom gnus-html-cache-directory (nnheader-concat gnus-directory "html-cache/") - "Where Gnus will cache images it downloads from the web." - :version "24.1" - :group 'gnus-art - :type 'directory) - -(defcustom gnus-html-cache-size 500000000 - "The size of the Gnus image cache." +(defcustom gnus-html-image-cache-ttl (days-to-time 7) + "Time in seconds used to cache the image on disk." :version "24.1" :group 'gnus-art :type 'integer) @@ -73,6 +68,7 @@ fit these criteria." (let ((map (make-sparse-keymap))) (define-key map "u" 'gnus-article-copy-string) (define-key map "i" 'gnus-html-insert-image) + (define-key map "v" 'gnus-html-browse-url) map)) (defvar gnus-html-displayed-image-map @@ -84,6 +80,19 @@ fit these criteria." (define-key map [tab] 'widget-forward) map)) +(defun gnus-html-cache-expired (url ttl) + "Check if URL is cached for more than TTL." + (cond (url-standalone-mode + (not (file-exists-p (url-cache-create-filename url)))) + (t (let ((cache-time (url-is-cached url))) + (if cache-time + (time-less-p + (time-add + cache-time + ttl) + (current-time)) + t))))) + ;;;###autoload (defun gnus-article-html (&optional handle) (let ((article-buffer (current-buffer))) @@ -133,6 +142,7 @@ fit these criteria." (replace-match "" t t))) (defun gnus-html-wash-images () + "Run through current buffer and replace img tags by images." (let (tag parameters string start end images url) (goto-char (point-min)) ;; Search for all the images first. @@ -158,62 +168,68 @@ fit these criteria." (setq image (gnus-create-image (buffer-string) nil t)))) (when image - (let ((string (buffer-substring start end))) - (delete-region start end) - (gnus-put-image image (gnus-string-or string "*") 'cid) - (gnus-add-image 'cid image)))) + (let ((string (buffer-substring start end))) + (delete-region start end) + (gnus-put-image image (gnus-string-or string "*") 'cid) + (gnus-add-image 'cid image)))) ;; Normal, external URL. - (if (gnus-html-image-url-blocked-p - url - (if (buffer-live-p gnus-summary-buffer) - (with-current-buffer gnus-summary-buffer - gnus-blocked-images) - gnus-blocked-images)) - (progn - (widget-convert-button - 'link start end - :action 'gnus-html-insert-image - :help-echo url - :keymap gnus-html-image-map - :button-keymap gnus-html-image-map) - (let ((overlay (gnus-make-overlay start end)) - (spec (list url - (set-marker (make-marker) start) - (set-marker (make-marker) end)))) - (gnus-overlay-put overlay 'local-map gnus-html-image-map) - (gnus-overlay-put overlay 'gnus-image spec) - (gnus-put-text-property - start end - 'gnus-image spec))) - (let ((file (gnus-html-image-id url)) - width height alt-text) - (when (string-match "height=\"?\\([0-9]+\\)" parameters) - (setq height (string-to-number (match-string 1 parameters)))) - (when (string-match "width=\"?\\([0-9]+\\)" parameters) - (setq width (string-to-number (match-string 1 parameters)))) - (when (string-match "\\(alt\\|title\\)=\"\\([^\"]+\\)" - parameters) - (setq alt-text (match-string 2 parameters))) - ;; Don't fetch images that are really small. They're - ;; probably tracking pictures. - (when (and (or (null height) - (> height 4)) - (or (null width) - (> width 4))) - (if (file-exists-p file) - ;; It's already cached, so just insert it. - (let ((string (buffer-substring start end))) - ;; Delete the IMG text. - (delete-region start end) - (gnus-html-put-image file (point) string url alt-text)) - ;; We don't have it, so schedule it for fetching - ;; asynchronously. - (push (list url - (set-marker (make-marker) start) - (point-marker)) - images)))))))) - (when images - (gnus-html-schedule-image-fetching (current-buffer) (nreverse images))))) + (let ((alt-text (when (string-match "\\(alt\\|title\\)=\"\\([^\"]+\\)" + parameters) + (match-string 2 parameters)))) + (if (gnus-html-image-url-blocked-p + url + (if (buffer-live-p gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer + gnus-blocked-images) + gnus-blocked-images)) + (progn + (widget-convert-button + 'link start end + :action 'gnus-html-insert-image + :help-echo url + :keymap gnus-html-image-map + :button-keymap gnus-html-image-map) + (let ((overlay (gnus-make-overlay start end)) + (spec (list url + (set-marker (make-marker) start) + (set-marker (make-marker) end) + alt-text))) + (gnus-overlay-put overlay 'local-map gnus-html-image-map) + (gnus-overlay-put overlay 'gnus-image spec) + (gnus-put-text-property start end 'gnus-image-url url) + (gnus-put-text-property + start end + 'gnus-image spec))) + ;; Non-blocked url + (let ((width + (when (string-match "width=\"?\\([0-9]+\\)" parameters) + (string-to-number (match-string 1 parameters)))) + (height + (when (string-match "height=\"?\\([0-9]+\\)" parameters) + (string-to-number (match-string 1 parameters))))) + ;; Don't fetch images that are really small. They're + ;; probably tracking pictures. + (when (and (or (null height) + (> height 4)) + (or (null width) + (> width 4))) + (gnus-html-display-image url start end alt-text)))))))))) + +(defun gnus-html-display-image (url start end alt-text) + "Display image at URL on text from START to END. +Use ALT-TEXT for the image string." + (if (gnus-html-cache-expired url gnus-html-image-cache-ttl) + ;; We don't have it, so schedule it for fetching + ;; asynchronously. + (gnus-html-schedule-image-fetching + (current-buffer) + (list url + (set-marker (make-marker) start) + (set-marker (make-marker) end) + alt-text)) + ;; It's already cached, so just insert it. + (gnus-html-put-image (gnus-html-get-image-data url) + start end url alt-text))) (defun gnus-html-wash-tags () (let (tag parameters string start end images url) @@ -300,8 +316,7 @@ fit these criteria." (defun gnus-html-insert-image () "Fetch and insert the image under point." (interactive) - (gnus-html-schedule-image-fetching - (current-buffer) (list (get-text-property (point) 'gnus-image)))) + (apply 'gnus-html-display-image (get-text-property (point) 'gnus-image))) (defun gnus-html-show-alt-text () "Show the ALT text of the image under point." @@ -311,7 +326,7 @@ fit these criteria." (defun gnus-html-browse-image () "Browse the image under point." (interactive) - (browse-url (get-text-property (point) 'gnus-image))) + (browse-url (get-text-property (point) 'gnus-image-url))) (defun gnus-html-browse-url () "Browse the image under point." @@ -321,87 +336,89 @@ fit these criteria." (message "No URL at point") (browse-url url)))) -(defun gnus-html-schedule-image-fetching (buffer images) - (gnus-message 8 "gnus-html-schedule-image-fetching: buffer %s, images %s" - buffer images) - (dolist (image images) - (ignore-errors - (url-retrieve (car image) - 'gnus-html-image-fetched - (list buffer image))))) - -(defun gnus-html-image-id (url) - (expand-file-name (sha1 url) gnus-html-cache-directory)) +(defun gnus-html-schedule-image-fetching (buffer image) + "Retrieve IMAGE, and place it into BUFFER on arrival." + (gnus-message 8 "gnus-html-schedule-image-fetching: buffer %s, image %s" + buffer image) + (ignore-errors + (url-retrieve (car image) + 'gnus-html-image-fetched + (list buffer image)))) (defun gnus-html-image-fetched (status buffer image) - (let ((file (gnus-html-image-id (car image)))) - ;; Search the start of the image data + (url-store-in-cache (current-buffer)) + (when (and (search-forward "\n\n" nil t) + (buffer-live-p buffer) + ;; If the `image' has no marker, do not replace anything + (cadr image) + ;; If the position of the marker is 1, then that + ;; means that the text it was in has been deleted; + ;; i.e., that the user has selected a different + ;; article before the image arrived. + (not (= (marker-position (cadr image)) + (with-current-buffer buffer + (point-min))))) + (let ((data (buffer-substring (point) (point-max)))) + (with-current-buffer buffer + (let ((inhibit-read-only t)) + (gnus-html-put-image data (cadr image) (caddr image) (car image) (cadddr image)))))) + (kill-buffer (current-buffer))) + +(defun gnus-html-get-image-data (url) + "Get image data for URL. +Return a string with image data." + (with-temp-buffer + (mm-disable-multibyte) + (url-cache-extract (url-cache-create-filename url)) (when (search-forward "\n\n" nil t) - ;; Write region (image data) silently - (write-region (point) (point-max) file nil 1) - (kill-buffer (current-buffer)) - (when (and (buffer-live-p buffer) - ;; If the `image' has no marker, do not replace anything - (cadr image) - ;; If the position of the marker is 1, then that - ;; means that the text it was in has been deleted; - ;; i.e., that the user has selected a different - ;; article before the image arrived. - (not (= (marker-position (cadr image)) (point-min)))) - (with-current-buffer buffer - (let ((inhibit-read-only t) - (string (buffer-substring (cadr image) (caddr image)))) - (delete-region (cadr image) (caddr image)) - (gnus-html-put-image file (cadr image) (car image) string))))))) - -(defun gnus-html-put-image (file point string &optional url alt-text) + (buffer-substring (point) (point-max))))) + +(defun gnus-html-put-image (data start end &optional url alt-text) (when (gnus-graphic-display-p) (let* ((image (ignore-errors - (gnus-create-image file))) - (size (and image - (if (featurep 'xemacs) - (cons (glyph-width image) (glyph-height image)) - (image-size image t))))) + (gnus-create-image data nil t))) + (size (and image + (if (featurep 'xemacs) + (cons (glyph-width image) (glyph-height image)) + (image-size image t))))) (save-excursion - (goto-char point) - (if (and image - ;; Kludge to avoid displaying 30x30 gif images, which - ;; seems to be a signal of a broken image. - (not (and (if (featurep 'xemacs) - (glyphp image) - (listp image)) - (eq (if (featurep 'xemacs) - (let ((data (cdadar (specifier-spec-list - (glyph-image image))))) - (and (vectorp data) - (aref data 0))) - (plist-get (cdr image) :type)) - 'gif) - (= (car size) 30) - (= (cdr size) 30)))) - (let ((start (point))) - (setq image (gnus-html-rescale-image image file size)) - (gnus-put-image image - (gnus-string-or string "*") - 'external) - (let ((overlay (gnus-make-overlay start (point)))) - (gnus-overlay-put overlay 'local-map - gnus-html-displayed-image-map) - (gnus-put-text-property start (point) 'gnus-alt-text alt-text) - (when url - (gnus-put-text-property start (point) 'gnus-image url))) - (gnus-add-image 'external image) - t) - (insert string) - (when (fboundp 'find-image) - (setq image (find-image '((:type xpm :file "lock-broken.xpm")))) - (gnus-put-image image - (gnus-string-or string "*") - 'internal) - (gnus-add-image 'internal image)) - nil))))) - -(defun gnus-html-rescale-image (image file size) + (goto-char start) + (let ((alt-text (or alt-text (buffer-substring-no-properties start end)))) + (if (and image + ;; Kludge to avoid displaying 30x30 gif images, which + ;; seems to be a signal of a broken image. + (not (and (if (featurep 'xemacs) + (glyphp image) + (listp image)) + (eq (if (featurep 'xemacs) + (let ((d (cdadar (specifier-spec-list + (glyph-image image))))) + (and (vectorp d) + (aref d 0))) + (plist-get (cdr image) :type)) + 'gif) + (= (car size) 30) + (= (cdr size) 30)))) + ;; Good image, add it! + (let ((image (gnus-html-rescale-image image data size))) + (delete-region start end) + (gnus-put-image image alt-text 'external) + (gnus-overlay-put (gnus-make-overlay start (point)) 'local-map + gnus-html-displayed-image-map) + (gnus-put-text-property start (point) 'gnus-alt-text alt-text) + (when url + (gnus-put-text-property start (point) 'gnus-image-url url)) + (gnus-add-image 'external image) + t) + ;; Bad image, try to show something else + (delete-region start end) + (when (fboundp 'find-image) + (setq image (find-image '((:type xpm :file "lock-broken.xpm")))) + (gnus-put-image image alt-text 'internal) + (gnus-add-image 'internal image)) + nil)))))) + +(defun gnus-html-rescale-image (image data size) (if (or (not (fboundp 'imagemagick-types)) (not (get-buffer-window (current-buffer)))) image @@ -414,35 +431,17 @@ fit these criteria." (- (nth 3 edges) (nth 1 edges))))) scaled-image) (when (> height window-height) - (setq image (or (create-image file 'imagemagick nil + (setq image (or (create-image data 'imagemagick t :height window-height) image)) (setq size (image-size image t))) (when (> (car size) window-width) (setq image (or - (create-image file 'imagemagick nil + (create-image data 'imagemagick t :width window-width) image))) image))) -(defun gnus-html-prune-cache () - (let ((total-size 0) - files) - (dolist (file (directory-files gnus-html-cache-directory t nil t)) - (let ((attributes (file-attributes file))) - (unless (nth 0 attributes) - (incf total-size (nth 7 attributes)) - (push (list (time-to-seconds (nth 5 attributes)) - (nth 7 attributes) file) - files)))) - (when (> total-size gnus-html-cache-size) - (setq files (sort files (lambda (f1 f2) - (< (car f1) (car f2))))) - (dolist (file files) - (when (> total-size gnus-html-cache-size) - (decf total-size (cadr file)) - (delete-file (nth 2 file))))))) - (defun gnus-html-image-url-blocked-p (url blocked-images) "Find out if URL is blocked by BLOCKED-IMAGES." (let ((ret (and blocked-images @@ -459,14 +458,10 @@ fit these criteria." This only works if the article in question is HTML." (interactive) (gnus-with-article-buffer - (let ((overlays (overlays-in (point-min) (point-max))) - overlay images) - (while (setq overlay (pop overlays)) - (when (overlay-get overlay 'gnus-image) - (push (overlay-get overlay 'gnus-image) images))) - (if (not images) - (message "No images to show") - (gnus-html-schedule-image-fetching (current-buffer) images))))) + (dolist (overlay (overlays-in (point-min) (point-max))) + (let ((o (overlay-get overlay 'gnus-image))) + (when o + (apply 'gnus-html-display-image o)))))) ;;;###autoload (defun gnus-html-prefetch-images (summary) @@ -477,11 +472,9 @@ This only works if the article in question is HTML." (while (re-search-forward "<img.*src=[\"']\\([^\"']+\\)" nil t) (let ((url (match-string 1))) (unless (gnus-html-image-url-blocked-p url blocked-images) - (unless (file-exists-p (gnus-html-image-id url)) - (ignore-errors - (url-retrieve (mm-url-decode-entities-string url) - 'gnus-html-image-fetched - (list nil (list url)))))))))))) + (when (gnus-html-cache-expired url gnus-html-image-cache-ttl) + (gnus-html-schedule-image-fetching nil + (list url)))))))))) (provide 'gnus-html) diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el index f245907ed1b..5ef58834df7 100644 --- a/lisp/gnus/gnus-int.el +++ b/lisp/gnus/gnus-int.el @@ -275,8 +275,10 @@ If it is down, start it up (again)." (not gnus-batch-mode) (gnus-y-or-n-p (format - "Unable to open server %s, go offline? " - server))) + "Unable to open server %s (%s), go offline? " + server + (nnheader-get-report + (car gnus-command-method))))) (setq open-offline t) 'offline) (t @@ -552,6 +554,14 @@ If BUFFER, insert the article in that group." (funcall (gnus-get-function gnus-command-method 'request-post) (nth 1 gnus-command-method))) +(defun gnus-request-expunge-group (group gnus-command-method) + "Expunge GROUP, which is removing articles that have been marked as deleted." + (when (stringp gnus-command-method) + (setq gnus-command-method (gnus-server-to-method gnus-command-method))) + (funcall (gnus-get-function gnus-command-method 'request-expunge-group) + (gnus-group-real-name group) + (nth 1 gnus-command-method))) + (defun gnus-request-scan (group gnus-command-method) "Request a SCAN being performed in GROUP from GNUS-COMMAND-METHOD. If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned." diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index f4745c184e5..c2f09a83c07 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -705,6 +705,7 @@ the first newsgroup." nnoo-state-alist nil gnus-current-select-method nil nnmail-split-history nil + gnus-extended-servers nil gnus-ephemeral-servers nil) (gnus-shutdown 'gnus) ;; Kill the startup file. @@ -1693,28 +1694,19 @@ If SCAN, request a scan of that group as well." (while newsrc (setq active (gnus-active (setq group (gnus-info-group (setq info (pop newsrc)))))) - - ;; Check newsgroups. If the user doesn't want to check them, or - ;; they can't be checked (for instance, if the news server can't - ;; be reached) we just set the number of unread articles in this - ;; newsgroup to t. This means that Gnus thinks that there are - ;; unread articles, but it has no idea how many. - - ;; To be more explicit: - ;; >0 for an active group with messages - ;; 0 for an active group with no unread messages - ;; nil for non-foreign groups that the user has requested not be checked - ;; t for unchecked foreign groups or bogus groups, or groups that can't - ;; be checked, for one reason or other. - ;; First go through all the groups, see what select methods they ;; belong to, and then collect them into lists per unique select ;; method. (if (not (setq method (gnus-info-method info))) (setq method gnus-select-method) + ;; There may be several similar methods. Possibly extend the + ;; method. (if (setq cmethod (assoc method methods-cache)) (setq method (cdr cmethod)) - (setq cmethod (inline (gnus-server-get-method nil method))) + (setq cmethod (if (stringp method) + (gnus-server-to-method method) + (inline (gnus-find-method-for-group + (gnus-info-group info) info)))) (push (cons method cmethod) methods-cache) (setq method cmethod))) (setq method-group-list (assoc method type-cache)) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index d0c50c8fec0..5997339a335 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -5850,6 +5850,10 @@ If SELECT-ARTICLES, only select those articles from GROUP." (types gnus-article-mark-lists) marks var articles article mark mark-type bgn end) + ;; Hack to avoid adjusting marks for imap. + (when (eq (car (gnus-find-method-for-group (gnus-info-group info))) + 'nnimap) + (setq min 1)) (dolist (marks marked-lists) (setq mark (car marks) @@ -9681,7 +9685,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." gnus-newsgroup-name)) (to-method (or select-method (gnus-find-method-for-group to-newsgroup))) - (move-is-internal (gnus-method-equal from-method to-method))) + (move-is-internal (gnus-server-equal from-method to-method))) (gnus-request-move-article article ; Article to move gnus-newsgroup-name ; From newsgroup @@ -9692,7 +9696,8 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (not articles) t) ; Accept form (not articles) ; Only save nov last time (and move-is-internal - (gnus-group-real-name to-newsgroup))))) ; is this move internal? + to-newsgroup ; Not respooling + (gnus-group-real-name to-newsgroup))))) ; Is this move internal? ;; Copy the article. ((eq action 'copy) (with-current-buffer copy-buf diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 68f7f5f5e1a..3f18858fc64 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -2682,6 +2682,7 @@ a string, be sure to use a valid format, see RFC 2616." (defvar gnus-newsgroup-name nil) (defvar gnus-ephemeral-servers nil) (defvar gnus-server-method-cache nil) +(defvar gnus-extended-servers nil) (defvar gnus-agent-fetching nil "Whether Gnus agent is in fetching mode.") @@ -3686,32 +3687,35 @@ that that variable is buffer-local to the summary buffers." (and (eq (car m1) (car m2)) (equal (cadr m1) (cadr m2)) - ;; Check parameters for sloppy equalness. - (let ((p1 (copy-list (cddr m1))) - (p2 (copy-list (cddr m2))) - e1 e2) - (block nil - (while (setq e1 (pop p1)) - (unless (setq e2 (assq (car e1) p2)) - ;; The parameter doesn't exist in p2. - (return nil)) - (setq p2 (delq e2 p2)) - (unless (equalp e1 e2) - (if (not (and (stringp (cadr e1)) - (stringp (cadr e2)))) - (return nil) - ;; Special-case string parameter comparison so that we - ;; can uniquify them. - (let ((s1 (cadr e1)) - (s2 (cadr e2))) - (when (string-match "/$" s1) - (setq s1 (directory-file-name s1))) - (when (string-match "/$" s2) - (setq s2 (directory-file-name s2))) - (unless (equal s1 s2) - (return nil)))))) - ;; If p2 now is empty, they were equal. - (null p2)))))) + (gnus-sloppily-equal-method-parameters m1 m2)))) + +(defsubst gnus-sloppily-equal-method-parameters (m1 m2) + ;; Check parameters for sloppy equalness. + (let ((p1 (copy-list (cddr m1))) + (p2 (copy-list (cddr m2))) + e1 e2) + (block nil + (while (setq e1 (pop p1)) + (unless (setq e2 (assq (car e1) p2)) + ;; The parameter doesn't exist in p2. + (return nil)) + (setq p2 (delq e2 p2)) + (unless (equalp e1 e2) + (if (not (and (stringp (cadr e1)) + (stringp (cadr e2)))) + (return nil) + ;; Special-case string parameter comparison so that we + ;; can uniquify them. + (let ((s1 (cadr e1)) + (s2 (cadr e2))) + (when (string-match "/$" s1) + (setq s1 (directory-file-name s1))) + (when (string-match "/$" s2) + (setq s2 (directory-file-name s2))) + (unless (equal s1 s2) + (return nil)))))) + ;; If p2 now is empty, they were equal. + (null p2)))) (defun gnus-server-equal (m1 m2) "Say whether two methods are equal." @@ -4200,9 +4204,12 @@ parameters." (if (or (not (inline (gnus-similar-server-opened method))) (not (cddr method))) method - `(,(car method) ,(concat (cadr method) "+" group) - (,(intern (format "%s-address" (car method))) ,(cadr method)) - ,@(cddr method)))) + (setq method + `(,(car method) ,(concat (cadr method) "+" group) + (,(intern (format "%s-address" (car method))) ,(cadr method)) + ,@(cddr method))) + (push method gnus-extended-servers) + method)) (defun gnus-server-status (method) "Return the status of METHOD." @@ -4227,6 +4234,20 @@ parameters." (format "%s using %s" address (car server)) (format "%s" (car server))))) +(defun gnus-same-method-different-name (method) + (let ((slot (intern (concat (symbol-name (car method)) "-address")))) + (unless (assq slot (cddr method)) + (setq method + (append method (list (list slot (nth 1 method))))))) + (let ((methods gnus-extended-servers) + open found) + (while (and (not found) + (setq open (pop methods))) + (when (and (eq (car method) (car open)) + (gnus-sloppily-equal-method-parameters method open)) + (setq found open))) + found)) + (defun gnus-find-method-for-group (group &optional info) "Find the select method that GROUP uses." (or gnus-override-method @@ -4249,7 +4270,10 @@ parameters." (cond ((stringp method) (inline (gnus-server-to-method method))) ((stringp (cadr method)) - (inline (gnus-server-extend-method group method))) + (or + (inline + (gnus-same-method-different-name method)) + (inline (gnus-server-extend-method group method)))) (t method))) (cond ((equal (cadr method) "") diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 434ad01bc19..e43cd2d8afb 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -37,6 +37,7 @@ (require 'gnus) (require 'nnoo) (require 'netrc) +(require 'parse-time) (nnoo-declare nnimap) @@ -77,6 +78,8 @@ will fetch all parts that have types that match that string. A likely value would be \"text/\" to automatically fetch all textual parts.") +(defvoo nnimap-expunge nil) + (defvoo nnimap-connection-alist nil) (defvoo nnimap-current-infos nil) @@ -405,7 +408,7 @@ textual parts.") (with-current-buffer (nnimap-buffer) (erase-buffer) (let ((group-sequence - (nnimap-send-command "SELECT %S" (utf7-encode group))) + (nnimap-send-command "SELECT %S" (utf7-encode group t))) (flag-sequence (nnimap-send-command "UID FETCH 1:* FLAGS"))) (nnimap-wait-for-response flag-sequence) @@ -421,20 +424,28 @@ textual parts.") (setq high (nth 3 (car marks)) low (nth 4 (car marks)))) ((re-search-backward "UIDNEXT \\([0-9]+\\)" nil t) - (setq high (string-to-number (match-string 1)) + (setq high (1- (string-to-number (match-string 1))) low 1))))) (erase-buffer) (insert (format - "211 %d %d %d %S\n" - (1+ (- high low)) - low high group)))) - t))) + "211 %d %d %d %S\n" (1+ (- high low)) low high group))) + t)))) + +(deffoo nnimap-request-create-group (group &optional server args) + (when (nnimap-possibly-change-group nil server) + (with-current-buffer (nnimap-buffer) + (car (nnimap-command "CREATE %S" (utf7-encode group t)))))) (deffoo nnimap-request-delete-group (group &optional force server) (when (nnimap-possibly-change-group nil server) (with-current-buffer (nnimap-buffer) - (car (nnimap-command "DELETE %S" (utf7-encode group)))))) + (car (nnimap-command "DELETE %S" (utf7-encode group t)))))) + +(deffoo nnimap-request-expunge-group (group &optional server) + (when (nnimap-possibly-change-group group server) + (with-current-buffer (nnimap-buffer) + (car (nnimap-command "EXPUNGE"))))) (defun nnimap-get-flags (spec) (let ((articles nil) @@ -456,38 +467,95 @@ textual parts.") (deffoo nnimap-request-move-article (article group server accept-form &optional last internal-move-group) - (when (nnimap-possibly-change-group group server) - ;; If the move is internal (on the same server), just do it the easy - ;; way. - (let ((message-id (message-field-value "message-id"))) - (if internal-move-group - (let ((result - (with-current-buffer (nnimap-buffer) - (nnimap-command "UID COPY %d %S" - article - (utf7-encode internal-move-group t))))) - (when (car result) - (nnimap-delete-article article) - (cons internal-move-group - (nnimap-find-article-by-message-id - internal-move-group message-id)))) - (with-temp-buffer - (when (nnimap-request-article article group server (current-buffer)) - (let ((result (eval accept-form))) - (when result + (with-temp-buffer + (when (nnimap-request-article article group server (current-buffer)) + ;; If the move is internal (on the same server), just do it the easy + ;; way. + (let ((message-id (message-field-value "message-id"))) + (if internal-move-group + (let ((result + (with-current-buffer (nnimap-buffer) + (nnimap-command "UID COPY %d %S" + article + (utf7-encode internal-move-group t))))) + (when (car result) (nnimap-delete-article article) - result)))))))) + (cons internal-move-group + (nnimap-find-article-by-message-id + internal-move-group message-id)))) + ;; Move the article to a different method. + (let ((result (eval accept-form))) + (when result + (nnimap-delete-article article) + result))))))) (deffoo nnimap-request-expire-articles (articles group &optional server force) (cond + ((null articles) + nil) ((not (nnimap-possibly-change-group group server)) articles) - (force + ((and force + (eq nnmail-expiry-target 'delete)) (unless (nnimap-delete-article articles) (message "Article marked for deletion, but not expunged.")) nil) (t - articles))) + (let ((deletable-articles + (if force + articles + (gnus-sorted-intersection + articles + (nnimap-find-expired-articles group))))) + (if (null deletable-articles) + articles + (if (eq nnmail-expiry-target 'delete) + (nnimap-delete-article deletable-articles) + (setq deletable-articles + (nnimap-process-expiry-targets + deletable-articles group server))) + ;; Return the articles we didn't delete. + (gnus-sorted-complement articles deletable-articles)))))) + +(defun nnimap-process-expiry-targets (articles group server) + (let ((deleted-articles nil)) + (dolist (article articles) + (let ((target nnmail-expiry-target)) + (with-temp-buffer + (when (nnimap-request-article article group server (current-buffer)) + (message "Expiring article %s:%d" group article) + (when (functionp target) + (setq target (funcall target group))) + (when (and target + (not (eq target 'delete))) + (if (or (gnus-request-group target t) + (gnus-request-create-group target)) + (nnmail-expiry-target-group target group) + (setq target nil))) + (when target + (push article deleted-articles)))))) + ;; Change back to the current group again. + (nnimap-possibly-change-group group server) + (setq deleted-articles (nreverse deleted-articles)) + (nnimap-delete-article deleted-articles) + deleted-articles)) + +(defun nnimap-find-expired-articles (group) + (let ((cutoff (nnmail-expired-article-p group nil nil))) + (with-current-buffer (nnimap-buffer) + (let ((result + (nnimap-command + "UID SEARCH SENTBEFORE %s" + (format-time-string + (format "%%d-%s-%%Y" + (upcase + (car (rassoc (nth 4 (decode-time cutoff)) + parse-time-months)))) + cutoff)))) + (and (car result) + (delete 0 (mapcar #'string-to-number + (cdr (assoc "SEARCH" (cdr result)))))))))) + (defun nnimap-find-article-by-message-id (group message-id) (when (nnimap-possibly-change-group group nil) @@ -505,10 +573,14 @@ textual parts.") (with-current-buffer (nnimap-buffer) (nnimap-command "UID STORE %s +FLAGS.SILENT (\\Deleted)" (nnimap-article-ranges articles)) - (when (member "UIDPLUS" (nnimap-capabilities nnimap-object)) - (nnimap-send-command "UID EXPUNGE %s" - (nnimap-article-ranges articles)) - t))) + (cond + ((member "UIDPLUS" (nnimap-capabilities nnimap-object)) + (nnimap-command "UID EXPUNGE %s" + (nnimap-article-ranges articles)) + t) + (nnimap-expunge + (nnimap-command "EXPUNGE") + t)))) (deffoo nnimap-request-scan (&optional group server) (when (and (nnimap-possibly-change-group nil server) @@ -1040,17 +1112,19 @@ textual parts.") (defun nnimap-mark-and-expunge-incoming (range) (when range (setq range (nnimap-article-ranges range)) - (nnimap-send-command - "UID STORE %s +FLAGS.SILENT (\\Deleted)" range) - (cond - ;; If the server supports it, we now delete the message we have - ;; just copied over. - ((member "UIDPLUS" (nnimap-capabilities nnimap-object)) - (nnimap-send-command "UID EXPUNGE %s" range)) - ;; If it doesn't support UID EXPUNGE, then we only expunge if the - ;; user has configured it. - (nnimap-expunge-inbox - (nnimap-send-command "EXPUNGE"))))) + (let ((sequence + (nnimap-send-command + "UID STORE %s +FLAGS.SILENT (\\Deleted)" range))) + (cond + ;; If the server supports it, we now delete the message we have + ;; just copied over. + ((member "UIDPLUS" (nnimap-capabilities nnimap-object)) + (setq sequence (nnimap-send-command "UID EXPUNGE %s" range))) + ;; If it doesn't support UID EXPUNGE, then we only expunge if the + ;; user has configured it. + (nnimap-expunge-inbox + (setq sequence (nnimap-send-command "EXPUNGE")))) + (nnimap-wait-for-response sequence)))) (defun nnimap-parse-copied-articles (sequences) (let (sequence copied range) diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el index 3e6cee82521..95a98352f00 100644 --- a/lisp/gnus/nnmail.el +++ b/lisp/gnus/nnmail.el @@ -1858,9 +1858,12 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (run-hooks 'nnmail-post-get-new-mail-hook)))) (defun nnmail-expired-article-p (group time force &optional inhibit) - "Say whether an article that is TIME old in GROUP should be expired." + "Say whether an article that is TIME old in GROUP should be expired. +If TIME is nil, then return the cutoff time for oldness instead." (if force - t + (if (null time) + (current-time) + t) (let ((days (or (and nnmail-expiry-wait-function (funcall nnmail-expiry-wait-function group)) nnmail-expiry-wait))) @@ -1871,14 +1874,18 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." nil) ((eq days 'immediate) ;; We expire all articles on sight. - t) + (if (null time) + (current-time) + t)) ((equal time '(0 0)) ;; This is an ange-ftp group, and we don't have any dates. nil) ((numberp days) (setq days (days-to-time days)) ;; Compare the time with the current time. - (ignore-errors (time-less-p days (time-since time)))))))) + (if (null time) + (time-subtract (current-time) days) + (ignore-errors (time-less-p days (time-since time))))))))) (declare-function gnus-group-mark-article-read "gnus-group" (group article)) diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el index 11cdfd768c3..d05485b32f3 100644 --- a/lisp/gnus/nnml.el +++ b/lisp/gnus/nnml.el @@ -942,22 +942,23 @@ Unless no-active is non-nil, update the active file too." (when (file-exists-p nov) (funcall nnmail-delete-file-function nov)) (dolist (file files) - (unless (file-directory-p (setq file (concat dir (cdr file)))) - (erase-buffer) - (nnheader-insert-file-contents file) - (narrow-to-region - (goto-char (point-min)) - (progn - (re-search-forward "\n\r?\n" nil t) - (setq chars (- (point-max) (point))) - (max (point-min) (1- (point))))) - (unless (zerop (buffer-size)) - (goto-char (point-min)) - (setq headers (nnml-parse-head chars (car file))) - (with-current-buffer nov-buffer - (goto-char (point-max)) - (nnheader-insert-nov headers))) - (widen))) + (let ((path (concat dir (cdr file)))) + (unless (file-directory-p path) + (erase-buffer) + (nnheader-insert-file-contents path) + (narrow-to-region + (goto-char (point-min)) + (progn + (re-search-forward "\n\r?\n" nil t) + (setq chars (- (point-max) (point))) + (max (point-min) (1- (point))))) + (unless (zerop (buffer-size)) + (goto-char (point-min)) + (setq headers (nnml-parse-head chars (car file))) + (with-current-buffer nov-buffer + (goto-char (point-max)) + (nnheader-insert-nov headers))) + (widen)))) (with-current-buffer nov-buffer (nnmail-write-region (point-min) (point-max) nov nil 'nomesg) (kill-buffer (current-buffer)))))) diff --git a/nt/configure.bat b/nt/configure.bat index c7bfad35189..74c7e1af137 100755 --- a/nt/configure.bat +++ b/nt/configure.bat @@ -1,6 +1,6 @@ @echo off
rem ----------------------------------------------------------------------
-rem Configuration script for MS Windows 95/98/Me and NT/2000/XP
+rem Configuration script for MS Windows operating systems
rem Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005,
rem 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
@@ -22,7 +22,7 @@ rem along with GNU Emacs. If not, see http://www.gnu.org/licenses/. rem ----------------------------------------------------------------------
rem YOU'LL NEED THE FOLLOWING UTILITIES TO MAKE EMACS:
rem
-rem + MS Windows 95/98/Me or NT/2000/XP
+rem + MS Windows 95, NT or later
rem + either MSVC 2.x or later, or gcc-2.95 or later (with GNU make 3.75
rem or later) and the Mingw32 and W32 API headers and libraries.
rem + Visual Studio 2005 is not supported at this time.
@@ -116,6 +116,7 @@ if "%1" == "--without-xpm" goto withoutxpm if "%1" == "--with-svg" goto withsvg
if "%1" == "--distfiles" goto distfiles
if "%1" == "" goto checkutils
+
:usage
echo Usage: configure [options]
echo Options:
@@ -137,61 +138,82 @@ echo. --without-xpm do not use XPM library even if it is installed echo. --with-svg use the RSVG library (experimental)
echo. --distfiles path to files for make dist, e.g. libXpm.dll
goto end
+
rem ----------------------------------------------------------------------
+
:setprefix
shift
set prefix=%1
shift
goto again
+
rem ----------------------------------------------------------------------
+
:withgcc
set COMPILER=gcc
shift
goto again
+
rem ----------------------------------------------------------------------
+
:withmsvc
set COMPILER=cl
shift
goto again
+
rem ----------------------------------------------------------------------
+
:nodebug
set nodebug=Y
shift
goto again
+
rem ----------------------------------------------------------------------
+
:noopt
set noopt=Y
shift
goto again
+
rem ----------------------------------------------------------------------
+
:enablechecking
set enablechecking=Y
shift
goto again
+
rem ----------------------------------------------------------------------
+
:profile
set profile=Y
shift
goto again
+
rem ----------------------------------------------------------------------
+
:nocygwin
set nocygwin=Y
shift
goto again
+
rem ----------------------------------------------------------------------
+
:usercflags
shift
set usercflags=%usercflags%%sep1%%1
set sep1= %nothing%
shift
goto again
+
rem ----------------------------------------------------------------------
+
:userldflags
shift
set userldflags=%userldflags%%sep2%%1
set sep2= %nothing%
shift
goto again
+
rem ----------------------------------------------------------------------
:withoutpng
@@ -249,6 +271,7 @@ goto again rem ----------------------------------------------------------------------
rem Check that necessary utilities (cp and rm) are present.
+
:checkutils
echo Checking for 'cp'...
cp configure.bat junk.bat
@@ -257,9 +280,11 @@ echo Checking for 'rm'... rm junk.bat
if exist junk.bat goto needrm
goto checkcompiler
+
:needcp
echo You need 'cp' (the Unix file copy program) to build Emacs.
goto end
+
:needrm
del junk.bat
echo You need 'rm' (the Unix file delete program) to build Emacs.
@@ -267,6 +292,7 @@ goto end rem ----------------------------------------------------------------------
rem Auto-detect compiler if not specified, and validate GCC if chosen.
+
:checkcompiler
if (%COMPILER%)==(cl) goto compilercheckdone
if (%COMPILER%)==(gcc) goto checkgcc
@@ -301,6 +327,7 @@ if exist junk.o set nocygwin=Y :chkapi
echo The failed program was: >>config.log
type junk.c >>config.log
+
:chkapiN
rm -f junk.c junk.o
rem ----------------------------------------------------------------------
@@ -320,8 +347,10 @@ echo {PIMAGE_SECTION_HEADER pSection = IMAGE_FIRST_SECTION(pHeader);} >>junk.c if (%nocygwin%) == (Y) goto chkapi1
set cf=%usercflags%
goto chkapi2
+
:chkapi1
set cf=%usercflags% -mno-cygwin
+
:chkapi2
echo on
gcc %cf% -c junk.c
@@ -357,10 +386,12 @@ type junk.c >>config.log set mf=-mcpu=i686
rm -f junk.c junk.o
goto gccdebug
+
:gccMtuneOk
echo GCC supports -mtune=pentium4 >>config.log
set mf=-mtune=pentium4
rm -f junk.c junk.o
+
:gccdebug
rem Check for DWARF-2 debug info support, else default to stabs
echo main(){} >junk.c
@@ -372,6 +403,7 @@ type junk.c >>config.log set dbginfo=-gstabs+
rm -f junk.c junk.o
goto compilercheckdone
+
:gccdwarf
echo GCC supports DWARF-2 >>config.log
set dbginfo=-gdwarf-2 -g3
@@ -565,6 +597,7 @@ goto :distfilesDone set fileNotFound=
rem ----------------------------------------------------------------------
+
:genmakefiles
echo Generating makefiles
if %COMPILER% == gcc set MAKECMD=gmake
@@ -619,6 +652,7 @@ fc /b config.tmp ..\src\config.h >nul 2>&1 if errorlevel 1 goto doCopy
fc /b paths.h ..\src\epaths.h >nul 2>&1
if errorlevel 0 goto dontCopy
+
:doCopy
copy config.tmp ..\src\config.h
copy paths.h ..\src\epaths.h
@@ -648,6 +682,7 @@ fc /b foo.bar foo.bar >nul 2>&1 if not errorlevel 2 goto doUpdateSubdirs
fc /b subdirs.el ..\site-lisp\subdirs.el >nul 2>&1
if not errorlevel 1 goto dontUpdateSubdirs
+
:doUpdateSubdirs
if exist ..\site-lisp\subdirs.el del ..\site-lisp\subdirs.el
copy subdirs.el ..\site-lisp\subdirs.el
@@ -716,6 +751,7 @@ goto end echo Your environment size is too small. Please enlarge it and rerun configure.
echo For example, type "command.com /e:2048" to have 2048 bytes available.
set $foo$=
+
:end
set prefix=
set nodebug=
diff --git a/src/ChangeLog b/src/ChangeLog index 063d65475ef..a44d97d96a1 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -10,6 +10,15 @@ current display element is a grapheme cluster in bidi-reordered region. +2010-09-21 Ari Roponen <ari.roponen@gmail.com> (tiny change) + + * doc.c (Fsnarf_documentation): Use memmove instead of memcpy as + the regions may overlap. + +2010-09-21 Juanma Barranquero <lekktu@gmail.com> + + * makefile.w32-in ($(BLD)/sysdep.$(O)): Update dependencies. + 2010-09-21 Dan Nicolaescu <dann@ics.uci.edu> * emacs.c: Do not include sys/ioctl.h, not needed. diff --git a/src/doc.c b/src/doc.c index f8ab9d081b9..36f7c0e882a 100644 --- a/src/doc.c +++ b/src/doc.c @@ -678,7 +678,7 @@ the same file name is found in the `doc-directory'. */) } pos += end - buf; filled -= end - buf; - memcpy (buf, end, filled); + memmove (buf, end, filled); } emacs_close (fd); return Qnil; diff --git a/src/makefile.w32-in b/src/makefile.w32-in index 8d99d6cedfe..752a3c211b3 100644 --- a/src/makefile.w32-in +++ b/src/makefile.w32-in @@ -1344,7 +1344,6 @@ $(BLD)/sysdep.$(O) : \ $(EMACS_ROOT)/nt/inc/pwd.h \ $(EMACS_ROOT)/nt/inc/unistd.h \ $(EMACS_ROOT)/nt/inc/sys/file.h \ - $(EMACS_ROOT)/nt/inc/sys/ioctl.h \ $(EMACS_ROOT)/nt/inc/sys/socket.h \ $(EMACS_ROOT)/nt/inc/sys/time.h \ $(SRC)/lisp.h \ |
