diff options
| -rw-r--r-- | autogen/config.in | 10 | ||||
| -rw-r--r-- | doc/lispref/ChangeLog | 5 | ||||
| -rw-r--r-- | doc/lispref/processes.texi | 6 | ||||
| -rw-r--r-- | doc/misc/ChangeLog | 6 | ||||
| -rw-r--r-- | doc/misc/gnus.texi | 4 | ||||
| -rw-r--r-- | lib/getopt_.h | 4 | ||||
| -rw-r--r-- | lisp/ChangeLog | 26 | ||||
| -rw-r--r-- | lisp/emacs-lisp/debug.el | 18 | ||||
| -rw-r--r-- | lisp/gnus/ChangeLog | 21 | ||||
| -rw-r--r-- | lisp/gnus/gnus-registry.el | 15 | ||||
| -rw-r--r-- | lisp/gnus/gnus-sum.el | 8 | ||||
| -rw-r--r-- | lisp/gnus/shr.el | 32 | ||||
| -rw-r--r-- | lisp/minibuffer.el | 99 | ||||
| -rw-r--r-- | lisp/subr.el | 7 | ||||
| -rw-r--r-- | lisp/url/ChangeLog | 9 | ||||
| -rw-r--r-- | lisp/url/url-future.el | 126 | ||||
| -rw-r--r-- | lisp/url/url-queue.el | 2 | ||||
| -rw-r--r-- | src/ChangeLog | 23 | ||||
| -rw-r--r-- | src/data.c | 4 | ||||
| -rw-r--r-- | src/dispnew.c | 9 | ||||
| -rw-r--r-- | src/frame.c | 2 | ||||
| -rw-r--r-- | src/makefile.w32-in | 2 |
22 files changed, 350 insertions, 88 deletions
diff --git a/autogen/config.in b/autogen/config.in index 860c509cd3e..24650ae7084 100644 --- a/autogen/config.in +++ b/autogen/config.in @@ -1278,16 +1278,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* Turned on June 1996 supposing nobody will mind it. */ #define AMPERSAND_FULL_NAME -/* If using GNU, then support inline function declarations. */ -/* Don't try to switch on inline handling as detected by AC_C_INLINE - generally, because even if non-gcc compilers accept `inline', they - may reject `extern inline'. */ -#if defined (__GNUC__) -#define INLINE __inline__ -#else -#define INLINE -#endif - /* `subprocesses' should be defined if you want to have code for asynchronous subprocesses (as used in M-x compile and M-x shell). diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index bd92b2a7273..83cee10f899 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,3 +1,8 @@ +2011-05-31 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * processes.texi (Process Information): Document + `process-alive-p'. + 2011-05-29 Chong Yidong <cyd@stupidchicken.com> * help.texi (Accessing Documentation): diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index 1a1b63683ce..2284699c82b 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -859,6 +859,12 @@ For a network connection, @code{process-status} returns one of the symbols closed the connection, or Emacs did @code{delete-process}. @end defun +@defun process-alive-p process +This function returns nin-@code{nil} if @var{process} is alive. A +process is considered alive if its status is @code{run}, @code{open}, +@code{listen}, @code{connect} or @code{stop}. +@end defun + @defun process-type process This function returns the symbol @code{network} for a network connection or server, @code{serial} for a serial port connection, or diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index 917ebf0d675..aaf4bcae1b3 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog @@ -1,3 +1,9 @@ +2011-05-31 Teodor Zlatanov <tzz@lifelogs.com> + + * gnus.texi (Store custom flags and keywords): Refer to + `gnus-registry-article-marks-to-{chars,names}' instead of + `gnus-registry-user-format-function-{M,M2}'. + 2011-05-18 Teodor Zlatanov <tzz@lifelogs.com> * gnus.texi (Gnus Registry Setup): Rename from "Setup". diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index a6b79237f08..82200780e19 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -26094,10 +26094,10 @@ their @code{:char} property, or showing the marks as full strings. @lisp ;; show the marks as single characters (see the :char property in ;; `gnus-registry-marks'): -;; (defalias 'gnus-user-format-function-M 'gnus-registry-user-format-function-M) +;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-chars) ;; show the marks by name (see `gnus-registry-marks'): -;; (defalias 'gnus-user-format-function-M 'gnus-registry-user-format-function-M2) +;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-names) @end lisp diff --git a/lib/getopt_.h b/lib/getopt_.h index 43acccc0bfc..e0923962b4f 100644 --- a/lib/getopt_.h +++ b/lib/getopt_.h @@ -279,5 +279,5 @@ extern int getopt_long_only (int ___argc, char *__getopt_argv_const *___argv, /* Make sure we later can get all the definitions and declarations. */
#undef __need_getopt
-#endif /* getopt.h */
-#endif /* getopt.h */
+#endif /* _GL_GETOPT_H */
+#endif /* _GL_GETOPT_H */
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 07f700f6987..8f96a838cc5 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,31 @@ 2011-05-31 Stefan Monnier <monnier@iro.umontreal.ca> + * minibuffer.el (complete-with-action): Return nil for the metadata and + boundaries of non-functional tables. + (completion-table-dynamic): Return nil for the metadata. + (completion-table-with-terminator): Add default case, using + complete-with-action. + (completion--metadata): New function. + (completion-all-sorted-completions, minibuffer-completion-help): Use it + to try and avoid pathological performance problems. + (completion--embedded-envvar-table): Return `category' metadata. + +2011-05-31 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * subr.el (process-alive-p): New tiny convenience function. + +2011-05-31 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/debug.el (debug): Save&restore not just the buffer's + content but also its previous major mode. + +2011-05-31 Helmut Eller <eller.helmut@gmail.com> + + * debug.el (debug): Restore the previous content of the + *Backtrace* buffer when we exit with C-M-c. + +2011-05-31 Stefan Monnier <monnier@iro.umontreal.ca> + * minibuffer.el: Add metadata method to completion tables. (completion-category-overrides): New defcustom. (completion-metadata, completion--field-metadata) diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 88633eaaa46..28962595ace 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -118,6 +118,10 @@ first will be printed into the backtrace buffer." (let (debugger-value (debug-on-error nil) (debug-on-quit nil) + (debugger-previous-state + (if (get-buffer "*Backtrace*") + (with-current-buffer (get-buffer "*Backtrace*") + (list major-mode (buffer-string))))) (debugger-buffer (get-buffer-create "*Backtrace*")) (debugger-old-buffer (current-buffer)) (debugger-step-after-exit nil) @@ -214,8 +218,6 @@ first will be printed into the backtrace buffer." ;; recreate it every time the debugger stops, so instead we'll ;; erase it (and maybe hide it) but keep it alive. (with-current-buffer debugger-buffer - (erase-buffer) - (fundamental-mode) (with-selected-window (get-buffer-window debugger-buffer 0) (when (and (window-dedicated-p (selected-window)) (not debugger-will-be-back)) @@ -232,7 +234,17 @@ first will be printed into the backtrace buffer." ;; to be left at the top-level, still working on how ;; best to do that. (bury-buffer)))) - (kill-buffer debugger-buffer)) + (unless debugger-previous-state + (kill-buffer debugger-buffer))) + ;; Restore the previous state of the debugger-buffer, in case we were + ;; in a recursive invocation of the debugger. + (when (and debugger-previous-state + (buffer-live-p debugger-buffer)) + (with-current-buffer debugger-buffer + (let ((inhibit-read-only t)) + (erase-buffer) + (insert (nth 1 debugger-previous-state)) + (funcall (nth 0 debugger-previous-state))))) (with-timeout-unsuspend debugger-with-timeout-suspend) (set-match-data debugger-outer-match-data))) ;; Put into effect the modified values of these variables diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index dcbc647950f..4cf21f65597 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,24 @@ +2011-05-31 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * shr.el (shr-rescale-image): Add an :ascent of 100 to images so that + the underline comes at the bottom. + +2011-05-31 Teodor Zlatanov <tzz@lifelogs.com> + + * gnus-registry.el (gnus-registry-article-marks-to-chars): Rename from + `gnus-registry-user-format-function-M' and declare the latter obsolete. + (gnus-registry-article-marks-to-names): Rename from + `gnus-registry-user-format-function-M2'. + +2011-05-31 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-sum.el (gnus-summary-exit): Make sure to kill article buffer in + ephemeral group. + +2011-05-31 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * shr.el (shr-browse-image): Copy the URL if called interactively. + 2011-05-30 Lars Magne Ingebrigtsen <larsi@gnus.org> * gnus-group.el (gnus-group-mark-article-read): It's possible that we diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index e0efbaf4f30..f6c0daaaa93 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -62,10 +62,10 @@ ;; show the marks as single characters (see the :char property in ;; `gnus-registry-marks'): -;; (defalias 'gnus-user-format-function-M 'gnus-registry-user-format-function-M) +;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-chars) ;; show the marks by name (see `gnus-registry-marks'): -;; (defalias 'gnus-user-format-function-M 'gnus-registry-user-format-function-M2) +;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-names) ;; TODO: @@ -897,9 +897,12 @@ Uses `gnus-registry-marks' to find what shortcuts to install." nil (cons "Registry Marks" gnus-registry-misc-menus)))))) +(make-obsolete 'gnus-registry-user-format-function-M + 'gnus-registry-article-marks-to-chars "24.1") ? + ;; use like this: -;; (defalias 'gnus-user-format-function-M 'gnus-registry-user-format-function-M) -(defun gnus-registry-user-format-function-M (headers) +;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-chars) +(defun gnus-registry-article-marks-to-chars (headers) "Show the marks for an article by the :char property" (let* ((id (mail-header-message-id headers)) (marks (when id (gnus-registry-get-id-key id 'mark)))) @@ -911,8 +914,8 @@ Uses `gnus-registry-marks' to find what shortcuts to install." marks ""))) ;; use like this: -;; (defalias 'gnus-user-format-function-M 'gnus-registry-user-format-function-M2) -(defun gnus-registry-user-format-function-M2 (headers) +;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-names) +(defun gnus-registry-article-marks-to-names (headers) "Show the marks for an article by name" (let* ((id (mail-header-message-id headers)) (marks (when id (gnus-registry-get-id-key id 'mark)))) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 2d75c35158a..1c4382b24a6 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -7194,7 +7194,11 @@ If FORCE (the prefix), also save the .newsrc file(s)." (article-buffer gnus-article-buffer) (mode major-mode) (group-point nil) - (buf (current-buffer))) + (buf (current-buffer)) + ;; `gnus-single-article-buffer' is nil buffer-locally in + ;; ephemeral group of which summary buffer will be killed, + ;; but the global value may be non-nil. + (single-article-buffer gnus-single-article-buffer)) (unless quit-config ;; Do adaptive scoring, and possibly save score files. (when gnus-newsgroup-adaptive @@ -7257,7 +7261,7 @@ If FORCE (the prefix), also save the .newsrc file(s)." (gnus-configure-windows 'group 'force))) ;; If we have several article buffers, we kill them at exit. - (unless gnus-single-article-buffer + (unless single-article-buffer (when (gnus-buffer-live-p article-buffer) (with-current-buffer article-buffer ;; Don't kill sticky article buffers diff --git a/lisp/gnus/shr.el b/lisp/gnus/shr.el index ebd854930df..67effc07ee2 100644 --- a/lisp/gnus/shr.el +++ b/lisp/gnus/shr.el @@ -183,14 +183,23 @@ redirects somewhere else." (message "No image under point") (message "%s" text)))) -(defun shr-browse-image () - "Browse the image under point." - (interactive) +(defun shr-browse-image (&optional copy-url) + "Browse the image under point. +If COPY-URL (the prefix if called interactively) is non-nil, copy +the URL of the image to the kill buffer instead." + (interactive "P") (let ((url (get-text-property (point) 'image-url))) - (if (not url) - (message "No image under point") + (cond + ((not url) + (message "No image under point")) + (copy-url + (with-temp-buffer + (insert url) + (copy-region-as-kill (point-min) (point-max)) + (message "Copied %s" url))) + (t (message "Browsing %s..." url) - (browse-url url)))) + (browse-url url))))) (defun shr-insert-image () "Insert the image under point into the buffer." @@ -524,8 +533,9 @@ redirects somewhere else." (defun shr-rescale-image (data) (if (or (not (fboundp 'imagemagick-types)) (not (get-buffer-window (current-buffer)))) - (create-image data nil t) - (let* ((image (create-image data nil t)) + (create-image data nil t + :ascent 100) + (let* ((image (create-image data nil t :ascent 100)) (size (image-size image t)) (width (car size)) (height (cdr size)) @@ -544,11 +554,13 @@ redirects somewhere else." (when (> (car size) window-width) (setq image (or (create-image data 'imagemagick t - :width window-width) + :width window-width + :ascent 100) image))) (when (and (fboundp 'create-animated-image) (eq (image-type data nil t) 'gif)) - (setq image (create-animated-image data 'gif t))) + (setq image (create-animated-image data 'gif t + :ascent 100))) image))) ;; url-cache-extract autoloads url-cache. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 0f96f7905eb..972c65f62e3 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -26,11 +26,15 @@ ;; internal use only. ;; Functional completion tables have an extended calling conventions: -;; - The `action' can be (additionally to nil, t, and lambda) of the form -;; (boundaries . SUFFIX) in which case it should return +;; The `action' can be (additionally to nil, t, and lambda) of the form +;; - (boundaries . SUFFIX) in which case it should return ;; (boundaries START . END). See `completion-boundaries'. ;; Any other return value should be ignored (so we ignore values returned ;; from completion tables that don't know about this new `action' form). +;; - `metadata' in which case it should return (metadata . ALIST) where +;; ALIST is the metadata of this table. See `completion-metadata'. +;; Any other return value should be ignored (so we ignore values returned +;; from completion tables that don't know about this new `action' form). ;;; Bugs: @@ -107,7 +111,8 @@ E.g. for simple completion tables, the result is always (0 . (length SUFFIX)) and for file names the result is the positions delimited by the closest directory separators." (let ((boundaries (if (functionp table) - (funcall table string pred (cons 'boundaries suffix))))) + (funcall table string pred + (cons 'boundaries suffix))))) (if (not (eq (car-safe boundaries) 'boundaries)) (setq boundaries nil)) (cons (or (cadr boundaries) 0) @@ -125,7 +130,8 @@ This metadata is an alist. Currently understood keys are: Takes one argument (COMPLETIONS) and should return a new list of completions. Can operate destructively. - `cycle-sort-function': function to sort entries when cycling. - Works like `display-sort-function'." + Works like `display-sort-function'. +The metadata of a completion table should be constant between two boundaries." (let ((metadata (if (functionp table) (funcall table string pred 'metadata)))) (if (eq (car-safe metadata) 'metadata) @@ -160,8 +166,8 @@ PRED is a completion predicate. ACTION can be one of nil, t or `lambda'." (cond ((functionp table) (funcall table string pred action)) - ((eq (car-safe action) 'boundaries) - (cons 'boundaries (completion-boundaries string table pred (cdr action)))) + ((eq (car-safe action) 'boundaries) nil) + ((eq action 'metadata) nil) (t (funcall (cond @@ -182,7 +188,7 @@ The result of the `completion-table-dynamic' form is a function that can be used as the COLLECTION argument to `try-completion' and `all-completions'. See Info node `(elisp)Programmed Completion'." (lambda (string pred action) - (if (eq (car-safe action) 'boundaries) + (if (or (eq (car-safe action) 'boundaries) (eq action 'metadata)) ;; `fun' is not supposed to return another function but a plain old ;; completion table, whose boundaries are always trivial. nil @@ -287,18 +293,18 @@ instead of a string, a function that takes the completion and returns the (funcall terminator comp) (concat comp terminator)) comp)))) - ((eq action t) + ;; completion-table-with-terminator is always used for + ;; "sub-completions" so it's only called if the terminator is missing, + ;; in which case `test-completion' should return nil. + ((eq action 'lambda) nil) + (t ;; FIXME: We generally want the `try' and `all' behaviors to be ;; consistent so pcm can merge the `all' output to get the `try' output, ;; but that sometimes clashes with the need for `all' output to look ;; good in *Completions*. ;; (mapcar (lambda (s) (concat s terminator)) ;; (all-completions string table pred)))) - (all-completions string table pred)) - ;; completion-table-with-terminator is always used for - ;; "sub-completions" so it's only called if the terminator is missing, - ;; in which case `test-completion' should return nil. - ((eq action 'lambda) nil))) + (complete-with-action action table string pred)))) (defun completion-table-with-predicate (table pred1 strict string pred2 action) "Make a completion table equivalent to TABLE but filtered through PRED1. @@ -769,22 +775,33 @@ scroll the window of possible completions." (setq completion-cycling nil) (setq completion-all-sorted-completions nil)) +(defun completion--metadata (string base md-at-point table pred) + ;; Like completion-metadata, but for the specific case of getting the + ;; metadata at `base', which tends to trigger pathological behavior for old + ;; completion tables which don't understand `metadata'. + (let ((bounds (completion-boundaries string table pred ""))) + (if (eq (car bounds) base) md-at-point + (completion-metadata (substring string 0 base) table pred)))) + (defun completion-all-sorted-completions () (or completion-all-sorted-completions (let* ((start (field-beginning)) (end (field-end)) (string (buffer-substring start end)) + (md (completion--field-metadata start)) (all (completion-all-completions string minibuffer-completion-table minibuffer-completion-predicate (- (point) start) - (completion--field-metadata start))) + md)) (last (last all)) (base-size (or (cdr last) 0)) - (all-md (completion-metadata (substring string 0 base-size) - minibuffer-completion-table - minibuffer-completion-predicate)) + (all-md (completion--metadata (buffer-substring-no-properties + start (point)) + base-size md + minibuffer-completion-table + minibuffer-completion-predicate)) (sort-fun (completion-metadata-get all-md 'cycle-sort-function))) (when last (setcdr last nil) @@ -1272,12 +1289,13 @@ variables.") (let* ((start (field-beginning)) (end (field-end)) (string (field-string)) + (md (completion--field-metadata start)) (completions (completion-all-completions string minibuffer-completion-table minibuffer-completion-predicate (- (point) (field-beginning)) - (completion--field-metadata start)))) + md))) (message nil) (if (or (null completions) (and (not (consp (cdr completions))) @@ -1293,12 +1311,11 @@ variables.") (let* ((last (last completions)) (base-size (cdr last)) (prefix (unless (zerop base-size) (substring string 0 base-size))) - ;; FIXME: This function is for the output of all-completions, - ;; not completion-all-completions. Often it's the same, but - ;; not always. - (all-md (completion-metadata (substring string 0 base-size) - minibuffer-completion-table - minibuffer-completion-predicate)) + (all-md (completion--metadata (buffer-substring-no-properties + start (point)) + base-size md + minibuffer-completion-table + minibuffer-completion-predicate)) (afun (or (completion-metadata-get all-md 'annotation-function) (plist-get completion-extra-properties :annotation-function) @@ -1673,8 +1690,8 @@ same as `substitute-in-file-name'." ;; other table that provides the "main" completion. Let the ;; other table handle the test-completion case. nil) - ((eq (car-safe action) 'boundaries) - ;; Only return boundaries if there's something to complete, + ((or (eq (car-safe action) 'boundaries) (eq action 'metadata)) + ;; Only return boundaries/metadata if there's something to complete, ;; since otherwise when we're used in ;; completion-table-in-turn, we could return boundaries and ;; let some subsequent table return a list of completions. @@ -1684,11 +1701,13 @@ same as `substitute-in-file-name'." (when (try-completion (substring string beg) table nil) ;; Compute the boundaries of the subfield to which this ;; completion applies. - (let ((suffix (cdr action))) - (list* 'boundaries - (or (match-beginning 2) (match-beginning 1)) - (when (string-match "[^[:alnum:]_]" suffix) - (match-beginning 0)))))) + (if (eq action 'metadata) + '(metadata (category . environment-variable)) + (let ((suffix (cdr action))) + (list* 'boundaries + (or (match-beginning 2) (match-beginning 1)) + (when (string-match "[^[:alnum:]_]" suffix) + (match-beginning 0))))))) (t (if (eq (aref string (1- beg)) ?{) (setq table (apply-partially 'completion-table-with-terminator @@ -2299,7 +2318,8 @@ PATTERN is as returned by `completion-pcm--string->pattern'." (case-fold-search completion-ignore-case) (completion-regexp-list (cons regex completion-regexp-list)) (compl (all-completions - (concat prefix (if (stringp (car pattern)) (car pattern) "")) + (concat prefix + (if (stringp (car pattern)) (car pattern) "")) table pred))) (if (not (functionp table)) ;; The internal functions already obeyed completion-regexp-list. @@ -2397,13 +2417,14 @@ filter out additional entries (because TABLE migth not obey PRED)." (- (length newbeforepoint) (car newbounds))))) (dolist (submatch suball) - (setq all (nconc (mapcar - (lambda (s) (concat submatch between s)) - (funcall filter - (completion-pcm--all-completions - (concat subprefix submatch between) - pattern table pred))) - all))) + (setq all (nconc + (mapcar + (lambda (s) (concat submatch between s)) + (funcall filter + (completion-pcm--all-completions + (concat subprefix submatch between) + pattern table pred))) + all))) ;; FIXME: This can come in handy for try-completion, ;; but isn't right for all-completions, since it lists ;; invalid completions. diff --git a/lisp/subr.el b/lisp/subr.el index 4fe9987b95b..08099dc1fdd 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1805,6 +1805,13 @@ Signal an error if the program returns with a non-zero exit status." (forward-line 1)) (nreverse lines))))) +(defun process-alive-p (process) + "Returns non-nil if PROCESS is alive. +A process is considered alive if its status is `run', `open', +`listen', `connect' or `stop'." + (memq (process-status process) + '(run open listen connect stop))) + ;; compatibility (make-obsolete diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index 37a9fb8ffe2..1f2784fe656 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog @@ -1,3 +1,12 @@ +2011-05-31 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * url-queue.el (url-queue-parallel-processes): Increase the + default to 6, since 2 seems too conservative for normal usage. + +2011-05-31 Teodor Zlatanov <tzz@lifelogs.com> + + * url-future.el: Add general futures facility. + 2011-05-29 Leo Liu <sdl.web@gmail.com> * url-cookie.el (url-cookie): Add option :named so that diff --git a/lisp/url/url-future.el b/lisp/url/url-future.el new file mode 100644 index 00000000000..334c4fa9126 --- /dev/null +++ b/lisp/url/url-future.el @@ -0,0 +1,126 @@ +;;; url-future.el --- general futures facility for url.el + +;; Copyright (C) 2011 Free Software Foundation, Inc. + +;; Author: Teodor Zlatanov <tzz@lifelogs.com> +;; Keywords: data + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Make a url-future (basically a defstruct): +;; (make-url-future :value (lambda () (calculation goes here)) +;; :callback (lambda (future) (use future on success)) +;; :errorback (lambda (future &rest error) (error handler))) + +;; Then either call it with `url-future-call' or cancel it with +;; `url-future-cancel'. Generally the functions will return the +;; future itself, not the value it holds. Also the functions will +;; throw a url-future-already-done error if you try to call or cancel +;; a future more than once. + +;; So, to get the value: +;; (when (url-future-completed-p future) (url-future-value future)) + +;; See the ERT tests and the code for futher details. + +;;; Code: + +(eval-when-compile (require 'cl)) +(eval-when-compile (require 'ert)) + +(defstruct url-future callback errorback status value) + +(defmacro url-future-done-p (url-future) + `(url-future-status ,url-future)) + +(defmacro url-future-completed-p (url-future) + `(eq (url-future-status ,url-future) t)) + +(defmacro url-future-errored-p (url-future) + `(eq (url-future-status ,url-future) 'error)) + +(defmacro url-future-cancelled-p (url-future) + `(eq (url-future-status ,url-future) 'cancel)) + +(defun url-future-finish (url-future &optional status) + (if (url-future-done-p url-future) + (signal 'error 'url-future-already-done) + (setf (url-future-status url-future) (or status t)) + ;; the status must be such that the future was completed + ;; to run the callback + (when (url-future-completed-p url-future) + (funcall (or (url-future-callback url-future) 'ignore) + url-future)) + url-future)) + +(defun url-future-errored (url-future errorcons) + (if (url-future-done-p url-future) + (signal 'error 'url-future-already-done) + (setf (url-future-status url-future) 'error) + (setf (url-future-value url-future) errorcons) + (funcall (or (url-future-errorback url-future) 'ignore) + url-future errorcons))) + +(defun url-future-call (url-future) + (if (url-future-done-p url-future) + (signal 'error 'url-future-already-done) + (let ((ff (url-future-value url-future))) + (when (functionp ff) + (condition-case catcher + (setf (url-future-value url-future) + (funcall ff)) + (error (url-future-errored url-future catcher))) + (url-future-value url-future))) + (if (url-future-errored-p url-future) + url-future + (url-future-finish url-future)))) + +(defun url-future-cancel (url-future) + (if (url-future-done-p url-future) + (signal 'error 'url-future-already-done) + (url-future-finish url-future 'cancel))) + +(ert-deftest url-future-test () + (let* ((text "running future") + (good (make-url-future :value (lambda () (format text)) + :callback (lambda (f) (set 'saver f)))) + (bad (make-url-future :value (lambda () (/ 1 0)) + :errorback (lambda (&rest d) (set 'saver d)))) + (tocancel (make-url-future :value (lambda () (/ 1 0)) + :callback (lambda (f) (set 'saver f)) + :errorback (lambda (&rest d) + (set 'saver d)))) + saver) + (should (equal good (url-future-call good))) + (should (equal good saver)) + (should (equal text (url-future-value good))) + (should (url-future-completed-p good)) + (should-error (url-future-call good)) + (setq saver nil) + (should (equal bad (url-future-call bad))) + (should-error (url-future-call bad)) + (should (equal saver (list bad '(arith-error)))) + (should (url-future-errored-p bad)) + (setq saver nil) + (should (equal (url-future-cancel tocancel) tocancel)) + (should-error (url-future-call tocancel)) + (should (null saver)) + (should (url-future-cancelled-p tocancel)))) + +(provide 'url-future) +;;; url-future.el ends here diff --git a/lisp/url/url-queue.el b/lisp/url/url-queue.el index 08496ad5afb..e6c8537c469 100644 --- a/lisp/url/url-queue.el +++ b/lisp/url/url-queue.el @@ -31,7 +31,7 @@ (eval-when-compile (require 'cl)) (require 'browse-url) -(defcustom url-queue-parallel-processes 2 +(defcustom url-queue-parallel-processes 6 "The number of concurrent processes." :type 'integer :group 'url) diff --git a/src/ChangeLog b/src/ChangeLog index 4a9e651e4d1..6d1b740de9c 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -14,6 +14,29 @@ (access_keymap): NATNUMP -> INTEGERP, since the integer must be nonnegative. +2011-05-31 Juanma Barranquero <lekktu@gmail.com> + + * makefile.w32-in ($(BLD)/data.$(O), $(BLD)/editfns.$(O)): + Update dependencies. + +2011-05-31 Dan Nicolaescu <dann@ics.uci.edu> + + * data.c (init_data): Remove code for UTS, this system is not + supported anymore. + +2011-05-31 Dan Nicolaescu <dann@ics.uci.edu> + + Don't force ./temacs to start in terminal mode. + + * frame.c (make_initial_frame): Initialize faces in all cases, not + only when CANNOT_DUMP is defined. + * dispnew.c (init_display): Remove CANNOT_DUMP condition. + +2011-05-31 Dan Nicolaescu <dann@ics.uci.edu> + + * dispnew.c (add_window_display_history): Use const for the string + pointer. Remove declaration, not needed. + 2011-05-31 Paul Eggert <eggert@cs.ucla.edu> Use 'inline', not 'INLINE'. diff --git a/src/data.c b/src/data.c index 443d78376d9..78bd454056d 100644 --- a/src/data.c +++ b/src/data.c @@ -3220,8 +3220,4 @@ init_data (void) return; #endif /* CANNOT_DUMP */ signal (SIGFPE, arith_error); - -#ifdef uts - signal (SIGEMT, arith_error); -#endif /* uts */ } diff --git a/src/dispnew.c b/src/dispnew.c index cd20bd6e9aa..501dc4ffd80 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -290,7 +290,6 @@ static int history_idx; static unsigned history_tick; static void add_frame_display_history (struct frame *, int); -static void add_window_display_history (struct window *, char *, int); /* Add to the redisplay history how window W has been displayed. MSG is a trace containing the information how W's glyph matrix @@ -298,7 +297,7 @@ static void add_window_display_history (struct window *, char *, int); has been interrupted for pending input. */ static void -add_window_display_history (struct window *w, char *msg, int paused_p) +add_window_display_history (struct window *w, const char *msg, int paused_p) { char *buf; @@ -6234,11 +6233,7 @@ init_display (void) } } - if (!inhibit_window_system && display_arg -#ifndef CANNOT_DUMP - && initialized -#endif - ) + if (!inhibit_window_system && display_arg) { Vinitial_window_system = Qx; #ifdef HAVE_X11 diff --git a/src/frame.c b/src/frame.c index 74e222f85fc..6008ba9567a 100644 --- a/src/frame.c +++ b/src/frame.c @@ -544,10 +544,8 @@ make_initial_frame (void) /* The default value of menu-bar-mode is t. */ set_menu_bar_lines (f, make_number (1), Qnil); -#ifdef CANNOT_DUMP if (!noninteractive) init_frame_faces (f); -#endif return f; } diff --git a/src/makefile.w32-in b/src/makefile.w32-in index 060b565b308..8da589a7115 100644 --- a/src/makefile.w32-in +++ b/src/makefile.w32-in @@ -654,6 +654,7 @@ $(BLD)/data.$(O) : \ $(SRC)/data.c \ $(CONFIG_H) \ $(EMACS_ROOT)/nt/inc/sys/time.h \ + $(EMACS_ROOT)/lib/intprops.h \ $(LISP_H) \ $(SRC)/buffer.h \ $(SRC)/ccl.h \ @@ -753,6 +754,7 @@ $(BLD)/editfns.$(O) : \ $(EMACS_ROOT)/nt/inc/sys/time.h \ $(EMACS_ROOT)/lib/intprops.h \ $(EMACS_ROOT)/lib/strftime.h \ + $(EMACS_ROOT)/lib/verify.h \ $(LISP_H) \ $(SRC)/atimer.h \ $(SRC)/blockinput.h \ |