Commit 7e655d38 authored by Paul Eggert's avatar Paul Eggert
Browse files

Merge from trunk.

parents ccd9a01a 357e1c67
......@@ -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).
......
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):
......
......@@ -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
......
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".
......
......@@ -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
......@@ -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 */
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.
......
......@@ -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
......
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
......
......@@ -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))))
......
......@@ -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
......
......@@ -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.
......
......@@ -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.
......
......@@ -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
......
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
......
;;; 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)))