Using saved parent location: http://bzr.savannah.gnu.org/r/emacs/trunk/ Now on revision 104087. ------------------------------------------------------------ revno: 104087 committer: Leo Liu branch nick: trunk timestamp: Tue 2011-05-03 11:34:26 +0800 message: New command isearch-yank-pop and bind it to `M-y' in Isearch diff: === modified file 'etc/ChangeLog' --- etc/ChangeLog 2011-05-03 00:48:07 +0000 +++ etc/ChangeLog 2011-05-03 03:34:26 +0000 @@ -1,3 +1,7 @@ +2011-05-03 Leo Liu + + * NEWS: Mention the new command isearch-yank-pop. + 2011-05-03 Teodor Zlatanov * NEWS: Mention new library gnutls.el and explain GnuTLS === modified file 'etc/NEWS' --- etc/NEWS 2011-05-03 00:48:07 +0000 +++ etc/NEWS 2011-05-03 03:34:26 +0000 @@ -281,6 +281,10 @@ *** C-y in Isearch is now bound to isearch-yank-kill, instead of isearch-yank-line. +--- +*** M-y in Isearch is now bound to isearch-yank-pop, instead of +isearch-yank-kill. + +++ *** M-s C-e in Isearch is now bound to isearch-yank-line. === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-05-03 01:52:52 +0000 +++ lisp/ChangeLog 2011-05-03 03:34:26 +0000 @@ -1,3 +1,9 @@ +2011-05-03 Leo Liu + + * isearch.el (isearch-yank-pop): New command. + (isearch-mode-map): bind it to `M-y'. + (isearch-forward): Mention it. + 2011-05-03 Stefan Monnier * simple.el (minibuffer-complete-shell-command): Remove. === modified file 'lisp/isearch.el' --- lisp/isearch.el 2011-04-19 13:44:55 +0000 +++ lisp/isearch.el 2011-05-03 03:34:26 +0000 @@ -473,7 +473,7 @@ (define-key map "\M-n" 'isearch-ring-advance) (define-key map "\M-p" 'isearch-ring-retreat) - (define-key map "\M-y" 'isearch-yank-kill) + (define-key map "\M-y" 'isearch-yank-pop) (define-key map "\M-\t" 'isearch-complete) @@ -637,6 +637,8 @@ Type \\[isearch-yank-line] to yank rest of line onto end of search string\ and search for it. Type \\[isearch-yank-kill] to yank the last string of killed text. +Type \\[isearch-yank-pop] to replace string just yanked into search prompt + with string killed before it. Type \\[isearch-quote-char] to quote control character to search for it. \\[isearch-abort] while searching or when search has failed cancels input\ back to what has @@ -1497,6 +1499,18 @@ (interactive) (isearch-yank-string (current-kill 0))) +(defun isearch-yank-pop () + "Replace just-yanked search string with previously killed string." + (interactive) + (if (not (memq last-command '(isearch-yank-kill isearch-yank-pop))) + ;; Fall back on `isearch-yank-kill' for the benefits of people + ;; who are used to the old behavior of `M-y' in isearch mode. In + ;; future, this fallback may be changed if we ever change + ;; `yank-pop' to do something like the kill-ring-browser. + (isearch-yank-kill) + (isearch-pop-state) + (isearch-yank-string (current-kill 1)))) + (defun isearch-yank-x-selection () "Pull current X selection into search string." (interactive) ------------------------------------------------------------ revno: 104086 committer: Stefan Monnier branch nick: trunk timestamp: Mon 2011-05-02 22:52:52 -0300 message: * lisp/simple.el (minibuffer-local-shell-command-map): Use completion-at-point. (minibuffer-complete-shell-command): Remove. (read-shell-command): Setup completion vars here instead. (read-expression-map): Bind TAB to symbol completion. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-05-03 01:48:32 +0000 +++ lisp/ChangeLog 2011-05-03 01:52:52 +0000 @@ -1,5 +1,10 @@ 2011-05-03 Stefan Monnier + * simple.el (minibuffer-complete-shell-command): Remove. + (minibuffer-local-shell-command-map): Use completion-at-point. + (read-shell-command): Setup completion vars here instead. + (read-expression-map): Bind TAB to symbol completion. + * textmodes/ispell.el (lookup-words): Use with-temp-buffer; signal error directly rather via storing it into `results'. === modified file 'lisp/simple.el' --- lisp/simple.el 2011-04-19 13:44:55 +0000 +++ lisp/simple.el 2011-05-03 01:52:52 +0000 @@ -1154,6 +1154,9 @@ ;; Initialize read-expression-map. It is defined at C level. (let ((m (make-sparse-keymap))) (define-key m "\M-\t" 'lisp-complete-symbol) + ;; Might as well bind TAB to completion, since inserting a TAB char is much + ;; too rarely useful. + (define-key m "\t" 'lisp-complete-symbol) (set-keymap-parent m minibuffer-local-map) (setq read-expression-map m)) @@ -2168,19 +2171,10 @@ (defvar shell-file-name-chars) (defvar shell-file-name-quote-list) -(defun minibuffer-complete-shell-command () - "Dynamically complete shell command at point." - (interactive) - (require 'shell) - (let ((comint-delimiter-argument-list shell-delimiter-argument-list) - (comint-file-name-chars shell-file-name-chars) - (comint-file-name-quote-list shell-file-name-quote-list)) - (run-hook-with-args-until-success 'shell-dynamic-complete-functions))) - (defvar minibuffer-local-shell-command-map (let ((map (make-sparse-keymap))) (set-keymap-parent map minibuffer-local-map) - (define-key map "\t" 'minibuffer-complete-shell-command) + (define-key map "\t" 'completion-at-point) map) "Keymap used for completing shell commands in minibuffer.") @@ -2189,8 +2183,18 @@ The arguments are the same as the ones of `read-from-minibuffer', except READ and KEYMAP are missing and HIST defaults to `shell-command-history'." + (require 'shell) (minibuffer-with-setup-hook (lambda () + (set (make-local-variable 'comint-delimiter-argument-list) + shell-delimiter-argument-list) + (set (make-local-variable 'comint-file-name-chars) shell-file-name-chars) + (set (make-local-variable 'comint-file-name-quote-list) + shell-file-name-quote-list) + (set (make-local-variable 'comint-dynamic-complete-functions) + shell-dynamic-complete-functions) + (add-hook 'completion-at-point-functions + 'comint-completion-at-point nil 'local) (set (make-local-variable 'minibuffer-default-add-function) 'minibuffer-default-add-shell-commands)) (apply 'read-from-minibuffer prompt initial-contents ------------------------------------------------------------ revno: 104085 committer: Stefan Monnier branch nick: trunk timestamp: Mon 2011-05-02 22:48:32 -0300 message: * lisp/textmodes/ispell.el (lookup-words): Use with-temp-buffer; signal error directly rather via storing it into `results'. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-05-02 12:22:38 +0000 +++ lisp/ChangeLog 2011-05-03 01:48:32 +0000 @@ -1,3 +1,8 @@ +2011-05-03 Stefan Monnier + + * textmodes/ispell.el (lookup-words): Use with-temp-buffer; signal + error directly rather via storing it into `results'. + 2011-05-02 Leo Liu * vc/diff.el: Fix description. === modified file 'lisp/textmodes/ispell.el' --- lisp/textmodes/ispell.el 2011-01-26 08:36:39 +0000 +++ lisp/textmodes/ispell.el 2011-05-03 01:48:32 +0000 @@ -2300,48 +2300,42 @@ (wild-p (string-match "\\*" word)) (look-p (and ispell-look-p ; Only use look for an exact match. (or ispell-have-new-look (not wild-p)))) - (ispell-grep-buffer (get-buffer-create "*Ispell-Temp*")) ; result buf (prog (if look-p ispell-look-command ispell-grep-command)) (args (if look-p ispell-look-options ispell-grep-options)) status results loc) - (unwind-protect - (save-window-excursion - (message "Starting \"%s\" process..." (file-name-nondirectory prog)) - (set-buffer ispell-grep-buffer) - (if look-p - nil - ;; convert * to .* - (insert "^" word "$") - (while (search-backward "*" nil t) (insert ".")) - (setq word (buffer-string)) - (erase-buffer)) - (setq status (apply 'ispell-call-process prog nil t nil - (nconc (if (and args (> (length args) 0)) - (list args) - (if look-p nil - (list "-e"))) - (list word) - (if lookup-dict (list lookup-dict))))) - ;; grep returns status 1 and no output when word not found, which - ;; is a perfectly normal thing. - (if (stringp status) - (setq results (cons (format "error: %s exited with signal %s" - (file-name-nondirectory prog) status) - results)) - ;; else collect words into `results' in FIFO order - (goto-char (point-max)) - ;; assure we've ended with \n - (or (bobp) (= (preceding-char) ?\n) (insert ?\n)) - (while (not (bobp)) - (setq loc (point)) - (forward-line -1) - (setq results (cons (buffer-substring-no-properties (point) - (1- loc)) - results))))) - ;; protected - (kill-buffer ispell-grep-buffer) - (if (and results (string-match ".+: " (car results))) - (error "%s error: %s" ispell-grep-command (car results)))) + (with-temp-buffer + (message "Starting \"%s\" process..." (file-name-nondirectory prog)) + (if look-p + nil + ;; Convert * to .* + (insert "^" word "$") + (while (search-backward "*" nil t) (insert ".")) + (setq word (buffer-string)) + (erase-buffer)) + (setq status (apply 'ispell-call-process prog nil t nil + (nconc (if (and args (> (length args) 0)) + (list args) + (if look-p nil + (list "-e"))) + (list word) + (if lookup-dict (list lookup-dict))))) + ;; `grep' returns status 1 and no output when word not found, which + ;; is a perfectly normal thing. + (if (stringp status) + (error "error: %s exited with signal %s" + (file-name-nondirectory prog) status) + ;; Else collect words into `results' in FIFO order. + (goto-char (point-max)) + ;; Assure we've ended with \n. + (or (bobp) (= (preceding-char) ?\n) (insert ?\n)) + (while (not (bobp)) + (setq loc (point)) + (forward-line -1) + (push (buffer-substring-no-properties (point) + (1- loc)) + results)))) + (if (and results (string-match ".+: " (car results))) + (error "%s error: %s" ispell-grep-command (car results))) results)) ------------------------------------------------------------ revno: 104084 committer: Ted Zlatanov branch nick: quickfixes timestamp: Mon 2011-05-02 19:48:07 -0500 message: Document new GnuTLS additions for general and W32 use. * NEWS: Mention new library gnutls.el and explain GnuTLS functionality. Mention new configure.bat options --without-gnutls and --lib for W32. diff: === modified file 'etc/ChangeLog' --- etc/ChangeLog 2011-05-02 22:53:34 +0000 +++ etc/ChangeLog 2011-05-03 00:48:07 +0000 @@ -1,3 +1,9 @@ +2011-05-03 Teodor Zlatanov + + * NEWS: Mention new library gnutls.el and explain GnuTLS + functionality. Mention new configure.bat options --without-gnutls + and --lib for W32. + 2011-05-02 Lars Magne Ingebrigtsen * NEWS: Mention `url-retrieve-queue', (:file "file") and === modified file 'etc/NEWS' --- etc/NEWS 2011-05-02 22:53:34 +0000 +++ etc/NEWS 2011-05-03 00:48:07 +0000 @@ -903,7 +903,21 @@ FIXME: These should be front-ended by xml.el. -** FIXME GnuTLS +** GnuTLS + +*** Emacs can be compiled with libgnutls support +This is the default. You will then be able to use the functionality +in gnutls.el, namely the `open-gnutls-stream' and `gnutls-negotiate' +functions. It's easiest to use these functions through +`open-network-stream' because it can upgrade connections through +STARTTLS opportunistically or use plain SSL, depending on your needs. + +Only versions 2.8.x and higher or GnuTLS have been tested. + +*** gnutls-log-level +Set `gnutls-log-level' higher than 0 to get debug output. 1 is for +important messages, 2 is for debug data, and higher numbers are as per +the GnuTLS logging conventions. The output is in *Messages*. ** Isearch @@ -931,6 +945,12 @@ ** New configure.bat option --distfiles to specify files to be included in binary distribution. +** New configure.bat option --without-gnutls to disable automatic +GnuTLS detection. + +** New configure.bat option --lib for general library linkage, works +with the USER_LIBS build variable. + ** New make target `dist' to create binary distribution for MS Windows. ------------------------------------------------------------ revno: 104083 committer: Lars Magne Ingebrigtsen branch nick: trunk timestamp: Tue 2011-05-03 00:53:34 +0200 message: * NEWS: Mention `url-retrieve-queue', (:file "file") and `server-eval-at'. diff: === modified file 'etc/ChangeLog' --- etc/ChangeLog 2011-04-28 22:48:58 +0000 +++ etc/ChangeLog 2011-05-02 22:53:34 +0000 @@ -1,3 +1,8 @@ +2011-05-02 Lars Magne Ingebrigtsen + + * NEWS: Mention `url-retrieve-queue', (:file "file") and + `server-eval-at'. + 2011-04-28 Juanma Barranquero * NEWS: Document `delayed-warnings-list' and `delayed-warnings-hook'. === modified file 'etc/NEWS' --- etc/NEWS 2011-04-28 22:48:58 +0000 +++ etc/NEWS 2011-05-02 22:53:34 +0000 @@ -396,6 +396,9 @@ ** browse-url has gotten a new variable that is used for mailto: URLs, `browse-url-mailto-function', which defaults to `browse-url-mail'. +** `url-queue-retrieve' downloads web pages asynchronously, but allow +controlling the degree of parallelism. + ** Directory local variables can apply to file-less buffers, in certain modes (eg dired, vc-dir, log-edit). For example, adding "(diff-mode . ((mode . whitespace)))" to your .dir-locals.el file, @@ -822,6 +825,12 @@ ** New low-level function run-hook-wrapped. +** `server-eval-at' is provided to allow evaluating forms on different +Emacs server instances. + +** `call-process' allows a `(:file "file")' spec to redirect STDOUT to +a file. + ** byte-compile-disable-print-circle is obsolete. ** deferred-action-list and deferred-action-function are obsolete. ** Removed the stack-trace-on-error variable. ------------------------------------------------------------ revno: 104082 author: Lars Magne Ingebrigtsen committer: Katsumi Yamaoka branch nick: trunk timestamp: Mon 2011-05-02 22:41:38 +0000 message: Merge changes made in Gnus trunk. gnus-html.el (gnus-html-schedule-image-fetching): Use url-queue-retrieve, if it exists. shr.el (shr-tag-img): Ditto. gnus.el: Autoload more gnus-agent functions. gnus-art.el (gnus-request-article-this-buffer): Store articles in the agent if we haven't already (bug#8502). gnus-async.el (gnus-async-article-callback): Put prefetched articles into the Agent, too. gnus-agent.el (gnus-agent-store-article): New function. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2011-05-02 03:37:06 +0000 +++ lisp/gnus/ChangeLog 2011-05-02 22:41:38 +0000 @@ -1,5 +1,20 @@ 2011-05-02 Lars Magne Ingebrigtsen + * gnus-html.el (gnus-html-schedule-image-fetching): Use + url-queue-retrieve, if it exists. + + * shr.el (shr-tag-img): Ditto. + + * gnus.el: Autoload more gnus-agent functions. + + * gnus-art.el (gnus-request-article-this-buffer): Store articles in the + agent if we haven't already (bug#8502). + + * gnus-async.el (gnus-async-article-callback): Put prefetched articles + into the Agent, too. + + * gnus-agent.el (gnus-agent-store-article): New function. + * nnheader.el (nnheader-insert-buffer-substring): Renamed from nntp- and moved from that file for reuse. === modified file 'lisp/gnus/gnus-agent.el' --- lisp/gnus/gnus-agent.el 2011-03-30 14:59:42 +0000 +++ lisp/gnus/gnus-agent.el 2011-05-02 22:41:38 +0000 @@ -3876,6 +3876,15 @@ (insert-file-contents file)) t)))) +(defun gnus-agent-store-article (article group) + (let* ((gnus-command-method (gnus-find-method-for-group group)) + (file (gnus-agent-article-name (number-to-string article) group)) + (file-name-coding-system nnmail-pathname-coding-system) + (coding-system-for-write gnus-cache-coding-system)) + (when (not (file-exists-p file)) + (gnus-make-directory (file-name-directory file)) + (write-region (point-min) (point-max) file nil 'silent)))) + (defun gnus-agent-regenerate-group (group &optional reread) "Regenerate GROUP. If REREAD is t, all articles in the .overview are marked as unread. === modified file 'lisp/gnus/gnus-art.el' --- lisp/gnus/gnus-art.el 2011-04-11 00:28:41 +0000 +++ lisp/gnus/gnus-art.el 2011-05-02 22:41:38 +0000 @@ -6841,7 +6841,10 @@ gnus-summary-buffer) (when gnus-keep-backlog (gnus-backlog-enter-article - group article (current-buffer)))) + group article (current-buffer))) + (when (and gnus-agent + (gnus-agent-group-covered-p group)) + (gnus-agent-store-article article group))) (setq result 'article)) (methods (setq gnus-override-method (pop methods))) === modified file 'lisp/gnus/gnus-async.el' --- lisp/gnus/gnus-async.el 2011-01-25 04:08:28 +0000 +++ lisp/gnus/gnus-async.el 2011-05-02 22:41:38 +0000 @@ -237,6 +237,12 @@ (save-excursion (save-restriction (narrow-to-region mark (point-max)) + ;; Put the articles into the agent, if they aren't already. + (when (and gnus-agent + (gnus-agent-group-covered-p group)) + (save-restriction + (narrow-to-region mark (point-max)) + (gnus-agent-store-article article group))) ;; Prefetch images for the groups that want that. (when (fboundp 'gnus-html-prefetch-images) (gnus-html-prefetch-images summary)) === modified file 'lisp/gnus/gnus-html.el' --- lisp/gnus/gnus-html.el 2011-01-25 04:08:28 +0000 +++ lisp/gnus/gnus-html.el 2011-05-02 22:41:38 +0000 @@ -386,16 +386,14 @@ "Retrieve IMAGE, and place it into BUFFER on arrival." (gnus-message 8 "gnus-html-schedule-image-fetching: buffer %s, image %s" buffer image) - (let ((args (list (car image) + (if (fboundp 'url-queue-retrieve) + (url-queue-retrieve (car image) + 'gnus-html-image-fetched + (list buffer image) t) + (ignore-errors + (url-retrieve (car image) 'gnus-html-image-fetched - (list buffer image)))) - (when (> (length (if (featurep 'xemacs) - (cdr (split-string (function-arglist 'url-retrieve))) - (help-function-arglist 'url-retrieve))) - 4) - (setq args (nconc args (list t)))) - (ignore-errors - (push (apply #'url-retrieve args) gnus-buffers)))) + (list buffer image))))) (defun gnus-html-image-fetched (status buffer image) "Callback function called when image has been fetched." === modified file 'lisp/gnus/gnus.el' --- lisp/gnus/gnus.el 2011-04-21 22:06:12 +0000 +++ lisp/gnus/gnus.el 2011-05-02 22:41:38 +0000 @@ -2910,7 +2910,8 @@ gnus-agent-save-active gnus-agent-method-p gnus-agent-get-undownloaded-list gnus-agent-fetch-session gnus-summary-set-agent-mark gnus-agent-save-group-info - gnus-agent-request-article gnus-agent-retrieve-headers) + gnus-agent-request-article gnus-agent-retrieve-headers + gnus-agent-store-article gnus-agent-group-covered-p) ("gnus-agent" :interactive t gnus-unplugged gnus-agentize gnus-agent-batch) ("gnus-vm" :interactive t gnus-summary-save-in-vm === modified file 'lisp/gnus/shr.el' --- lisp/gnus/shr.el 2011-04-30 00:03:19 +0000 +++ lisp/gnus/shr.el 2011-05-02 22:41:38 +0000 @@ -871,10 +871,13 @@ (shr-put-image (shr-get-image-data url) alt)) (t (insert alt) - (ignore-errors - (url-retrieve (shr-encode-url url) 'shr-image-fetched - (list (current-buffer) start (point-marker)) - t)))) + (funcall + (if (fboundp 'url-queue-retrieve) + 'url-queue-retrieve + 'url-retrieve) + (shr-encode-url url) 'shr-image-fetched + (list (current-buffer) start (point-marker)) + t))) (put-text-property start (point) 'keymap shr-map) (put-text-property start (point) 'shr-alt alt) (put-text-property start (point) 'image-url url) ------------------------------------------------------------ revno: 104081 committer: Lars Magne Ingebrigtsen branch nick: trunk timestamp: Mon 2011-05-02 20:30:48 +0200 message: Kill all processes associated with the buffer. diff: === modified file 'lisp/url/url-queue.el' --- lisp/url/url-queue.el 2011-05-02 18:15:39 +0000 +++ lisp/url/url-queue.el 2011-05-02 18:30:48 +0000 @@ -93,15 +93,16 @@ (defun url-queue-prune-old-entries () (let (dead-jobs) (dolist (job url-queue) - ;; Kill jobs that have lasted longer than five seconds. + ;; Kill jobs that have lasted longer than the timeout. (when (and (url-queue-start-time job) (> (- (float-time) (url-queue-start-time job)) url-queue-timeout)) (push job dead-jobs))) (dolist (job dead-jobs) (when (bufferp (url-queue-buffer job)) - (ignore-errors - (delete-process (get-buffer-process (url-queue-buffer job)))) + (while (get-buffer-process (url-queue-buffer job)) + (ignore-errors + (delete-process (get-buffer-process (url-queue-buffer job))))) (ignore-errors (kill-buffer (url-queue-buffer job)))) (setq url-queue (delq job url-queue))))) ------------------------------------------------------------ revno: 104080 committer: Lars Magne Ingebrigtsen branch nick: trunk timestamp: Mon 2011-05-02 20:15:39 +0200 message: Autoload `url-queue-retrieve', and fix up the pruning code. diff: === modified file 'lisp/url/ChangeLog' --- lisp/url/ChangeLog 2011-05-02 17:28:34 +0000 +++ lisp/url/ChangeLog 2011-05-02 18:15:39 +0000 @@ -3,6 +3,9 @@ * url-queue.el: New file. (url-queue-run-queue): Pick the first waiting job, and not the last. + (url-queue-parallel-processes): Lower the concurrency level, since + Emacs doesn't seem to like too many async processes. + (url-queue-prune-old-entries): Fix up the pruning code. 2011-04-16 Lars Magne Ingebrigtsen === modified file 'lisp/url/url-queue.el' --- lisp/url/url-queue.el 2011-05-02 17:28:34 +0000 +++ lisp/url/url-queue.el 2011-05-02 18:15:39 +0000 @@ -31,7 +31,7 @@ (eval-when-compile (require 'cl)) (require 'browse-url) -(defcustom url-queue-parallel-processes 4 +(defcustom url-queue-parallel-processes 2 "The number of concurrent processes." :type 'integer :group 'url) @@ -47,8 +47,9 @@ (defstruct url-queue url callback cbargs silentp - process start-time) + buffer start-time) +;;;###autoload (defun url-queue-retrieve (url callback &optional cbargs silent) "Retrieve URL asynchronously and call CALLBACK with CBARGS when finished. Like `url-retrieve' (which see for details of the arguments), but @@ -83,7 +84,7 @@ (apply (url-queue-callback job) (cons status (url-queue-cbargs job)))) (defun url-queue-start-retrieve (job) - (setf (url-queue-process job) + (setf (url-queue-buffer job) (ignore-errors (url-retrieve (url-queue-url job) #'url-queue-callback-function (list job) @@ -98,12 +99,12 @@ url-queue-timeout)) (push job dead-jobs))) (dolist (job dead-jobs) - (when (processp (url-queue-process job)) - (ignore-errors - (delete-process (url-queue-process job))) - (ignore-errors - (kill-buffer (process-buffer (url-queue-process job)))) - (setq url-queue (delq job url-queue)))))) + (when (bufferp (url-queue-buffer job)) + (ignore-errors + (delete-process (get-buffer-process (url-queue-buffer job)))) + (ignore-errors + (kill-buffer (url-queue-buffer job)))) + (setq url-queue (delq job url-queue))))) (provide 'url-queue) ------------------------------------------------------------ revno: 104079 committer: Lars Magne Ingebrigtsen branch nick: trunk timestamp: Mon 2011-05-02 19:28:34 +0200 message: (url-queue-run-queue): Pick the first waiting job, and not the last. diff: === modified file 'lisp/url/ChangeLog' --- lisp/url/ChangeLog 2011-05-02 17:06:56 +0000 +++ lisp/url/ChangeLog 2011-05-02 17:28:34 +0000 @@ -1,6 +1,8 @@ 2011-05-02 Lars Magne Ingebrigtsen * url-queue.el: New file. + (url-queue-run-queue): Pick the first waiting job, and not the + last. 2011-04-16 Lars Magne Ingebrigtsen === modified file 'lisp/url/url-queue.el' --- lisp/url/url-queue.el 2011-05-02 17:06:56 +0000 +++ lisp/url/url-queue.el 2011-05-02 17:28:34 +0000 @@ -67,9 +67,11 @@ (let ((running 0) waiting) (dolist (entry url-queue) - (if (url-queue-start-time entry) - (incf running) - (setq waiting entry))) + (cond + ((url-queue-start-time entry) + (incf running)) + ((not waiting) + (setq waiting entry)))) (when (and waiting (< running url-queue-parallel-processes)) (setf (url-queue-start-time waiting) (float-time)) ------------------------------------------------------------ revno: 104078 committer: Lars Magne Ingebrigtsen branch nick: trunk timestamp: Mon 2011-05-02 19:06:56 +0200 message: Add the new file url-queue.el, which allows controlling the parallelism when fetching web pages asynchronously. diff: === modified file 'lisp/url/ChangeLog' --- lisp/url/ChangeLog 2011-04-16 13:59:54 +0000 +++ lisp/url/ChangeLog 2011-05-02 17:06:56 +0000 @@ -1,3 +1,7 @@ +2011-05-02 Lars Magne Ingebrigtsen + + * url-queue.el: New file. + 2011-04-16 Lars Magne Ingebrigtsen * url-http.el (url-http-wait-for-headers-change-function): Protect === added file 'lisp/url/url-queue.el' --- lisp/url/url-queue.el 1970-01-01 00:00:00 +0000 +++ lisp/url/url-queue.el 2011-05-02 17:06:56 +0000 @@ -0,0 +1,108 @@ +;;; url-queue.el --- Fetching web pages in parallel + +;; Copyright (C) 2011 Free Software Foundation, Inc. + +;; Author: Lars Magne Ingebrigtsen +;; Keywords: comm + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; The point of this package is to allow fetching web pages in +;; parallel -- but control the level of parallelism to avoid DoS-ing +;; web servers and Emacs. + +;;; Code: + +(eval-when-compile (require 'cl)) +(require 'browse-url) + +(defcustom url-queue-parallel-processes 4 + "The number of concurrent processes." + :type 'integer + :group 'url) + +(defcustom url-queue-timeout 5 + "How long to let a job live once it's started (in seconds)." + :type 'integer + :group 'url) + +;;; Internal variables. + +(defvar url-queue nil) + +(defstruct url-queue + url callback cbargs silentp + process start-time) + +(defun url-queue-retrieve (url callback &optional cbargs silent) + "Retrieve URL asynchronously and call CALLBACK with CBARGS when finished. +Like `url-retrieve' (which see for details of the arguments), but +controls the level of parallelism via the +`url-queue-parallel-processes' variable." + (setq url-queue + (append url-queue + (list (make-url-queue :url url + :callback callback + :cbargs cbargs + :silentp silent)))) + (url-queue-run-queue)) + +(defun url-queue-run-queue () + (url-queue-prune-old-entries) + (let ((running 0) + waiting) + (dolist (entry url-queue) + (if (url-queue-start-time entry) + (incf running) + (setq waiting entry))) + (when (and waiting + (< running url-queue-parallel-processes)) + (setf (url-queue-start-time waiting) (float-time)) + (url-queue-start-retrieve waiting)))) + +(defun url-queue-callback-function (status job) + (setq url-queue (delq job url-queue)) + (url-queue-run-queue) + (apply (url-queue-callback job) (cons status (url-queue-cbargs job)))) + +(defun url-queue-start-retrieve (job) + (setf (url-queue-process job) + (ignore-errors + (url-retrieve (url-queue-url job) + #'url-queue-callback-function (list job) + (url-queue-silentp job))))) + +(defun url-queue-prune-old-entries () + (let (dead-jobs) + (dolist (job url-queue) + ;; Kill jobs that have lasted longer than five seconds. + (when (and (url-queue-start-time job) + (> (- (float-time) (url-queue-start-time job)) + url-queue-timeout)) + (push job dead-jobs))) + (dolist (job dead-jobs) + (when (processp (url-queue-process job)) + (ignore-errors + (delete-process (url-queue-process job))) + (ignore-errors + (kill-buffer (process-buffer (url-queue-process job)))) + (setq url-queue (delq job url-queue)))))) + +(provide 'url-queue) + +;;; url-queue.el ends here ------------------------------------------------------------ revno: 104077 committer: Leo Liu branch nick: trunk timestamp: Mon 2011-05-02 20:22:38 +0800 message: Fix description of diff.el diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-05-02 02:06:53 +0000 +++ lisp/ChangeLog 2011-05-02 12:22:38 +0000 @@ -1,3 +1,7 @@ +2011-05-02 Leo Liu + + * vc/diff.el: Fix description. + 2011-05-02 Lars Magne Ingebrigtsen * server.el (server-eval-at): New function. === modified file 'lisp/vc/diff.el' --- lisp/vc/diff.el 2011-01-25 04:08:28 +0000 +++ lisp/vc/diff.el 2011-05-02 12:22:38 +0000 @@ -1,4 +1,4 @@ -;;; diff.el --- run `diff' in compilation-mode +;;; diff.el --- run `diff' ;; Copyright (C) 1992, 1994, 1996, 2001-2011 Free Software Foundation, Inc. ------------------------------------------------------------ revno: 104076 fixes bug(s): http://debbugs.gnu.org/8596 committer: Juanma Barranquero branch nick: trunk timestamp: Mon 2011-05-02 05:57:02 +0200 message: src/sysdep.c (get_tty_size) [WINDOWSNT]: Implement. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-05-02 02:49:06 +0000 +++ src/ChangeLog 2011-05-02 03:57:02 +0000 @@ -1,5 +1,9 @@ 2011-05-02 Juanma Barranquero + * sysdep.c (get_tty_size) [WINDOWSNT]: Implement. (Bug#8596) + +2011-05-02 Juanma Barranquero + * gnutls.c (Qgnutls_log_level, Qgnutls_code, Qgnutls_anon) (Qgnutls_x509pki, Qgnutls_e_interrupted, Qgnutls_e_again) (Qgnutls_e_invalid_session, Qgnutls_e_not_ready_for_handshake) === modified file 'src/sysdep.c' --- src/sysdep.c 2011-05-01 08:52:17 +0000 +++ src/sysdep.c 2011-05-02 03:57:02 +0000 @@ -1125,8 +1125,7 @@ void get_tty_size (int fd, int *widthp, int *heightp) { - -#ifdef TIOCGWINSZ +#if defined TIOCGWINSZ /* BSD-style. */ struct winsize size; @@ -1139,8 +1138,7 @@ *heightp = size.ws_row; } -#else -#ifdef TIOCGSIZE +#elif defined TIOCGSIZE /* SunOS - style. */ struct ttysize size; @@ -1153,16 +1151,28 @@ *heightp = size.ts_lines; } -#else -#ifdef MSDOS +#elif defined WINDOWSNT + + CONSOLE_SCREEN_BUFFER_INFO info; + if (GetConsoleScreenBufferInfo (GetStdHandle (STD_OUTPUT_HANDLE), &info)) + { + *widthp = info.srWindow.Right - info.srWindow.Left + 1; + *heightp = info.srWindow.Bottom - info.srWindow.Top + 1; + } + else + *widthp = *heightp = 0; + +#elif defined MSDOS + *widthp = ScreenCols (); *heightp = ScreenRows (); + #else /* system doesn't know size */ + *widthp = 0; *heightp = 0; + #endif -#endif /* not SunOS-style */ -#endif /* not BSD-style */ } /* Set the logical window size associated with descriptor FD