mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-26 10:49:33 +00:00
Code Issues Releases Activity

Merge from trunk.

Browse Source
This commit is contained in:
Paul Eggert 2011-06-02 00:42:55 -07:00
commit af3c30cb28
52 changed files with 1097 additions and 592 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
autogen/config.in
View File

@ -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).

5
doc/lispref/ChangeLog
View File

@ -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):

6
doc/lispref/processes.texi
View File

@ -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

6
doc/misc/ChangeLog
View File

@ -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".

4
doc/misc/gnus.texi
View File

@ -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

4
etc/NEWS
View File

@ -68,6 +68,10 @@ and also when HOME is set to C:\ by default.
* Changes in Emacs 24.1
** The inactive minibuffer has its own major mode `minibuffer-inactive-mode'.
This is handy for minibuffer-only frames, and is also used for the "mouse-1
pops up *Messages*" feature, which can now easily be changed.
** emacsclient changes
*** New emacsclient argument --parent-id ID can be used to open a

4
lib-src/ChangeLog
View File

@ -1,3 +1,7 @@
2011-06-01 Dan Nicolaescu <dann@ics.uci.edu>
* emacsclient.c (socket_status): Use constant pointer.
2011-05-28 Paul Eggert <eggert@cs.ucla.edu>
Use 'inline', not 'INLINE'.

2
lib-src/emacsclient.c
View File

@ -1098,7 +1098,7 @@ find_tty (const char **tty_type, const char **tty_name, int noabort)
0 - success: none of the above */
static int
socket_status (char *name)
socket_status (const char *name)
{
struct stat statbfr;

4
lib/getopt_.h
View File

@ -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 */

110
lisp/ChangeLog
View File

@ -1,3 +1,109 @@
2011-06-02 Stefan Monnier <monnier@iro.umontreal.ca>
* net/tramp.el (tramp-with-progress-reporter): Rename from
with-progress-reporter. Use `declare'.
* net/tramp-smb.el:
* net/tramp-sh.el:
* net/tramp-gvfs.el: Update all uses.
2011-06-02 Jay Belanger <jay.p.belanger@gmail.com>
* calc/calc.el (calc-kill-stack-buffer): Make sure that the trail
buffer isn't killed before making it current.
2011-06-01 Stefan Monnier <monnier@iro.umontreal.ca>
Silence various byte-compiler warnings.
* emacs-lisp/byte-run.el (make-obsolete-variable): New argument
`access-type' and new obsolescence format.
* emacs-lisp/bytecomp.el (byte-compile-warn-obsolete): Adjust to
new format.
(byte-compile-check-variable): New `access-type' argument.
Only warn if the access-type is obsolete.
(byte-compile-dynamic-variable-bind, byte-compile-variable-ref)
(byte-compile-variable-set): Adjust callers.
* help-fns.el (describe-variable): Adjust to new obsolescence format.
* mail/sendmail.el (mail-mailer-swallows-blank-line): Only mark
setting it as obsolete.
* simple.el (minibuffer-completing-symbol):
* font-lock.el (font-lock-beginning-of-syntax-function): Only mark read
access as obsolete.
* minibuffer.el (minibuffer-completing-file-name): Don't make it
obsolete yet.
* international/quail.el (quail-mouse-choose-completion): Remove unused
code referring to obsolete var.
(quail-choose-completion-string): Remove.
* server.el (server-clients-with, server-kill-buffer-query-function)
(server-kill-emacs-query-function): Silence "unused `proc'" warnings.
* proced.el (proced-send-signal):
* emacs-lisp/lisp.el (lisp-complete-symbol):
Replace completion-annotate-function with completion-extra-properties.
2011-06-01 Stefan Monnier <monnier@iro.umontreal.ca>
* simple.el (goto-line): Use read-number.
(overriding-map-is-bound): Remove.
(saved-overriding-map): Change default.
(save&set-overriding-map): Rename from ensure-overriding-map-is-bound;
Take the map as argument.
(universal-argument, negative-argument, digit-argument): Use it.
(restore-overriding-map): Adjust.
(do-auto-fill): Use fill-forward-paragraph.
(keyboard-quit): Don't signal an error when debug-on-quit is non-nil.
* minibuffer.el (minibuffer-inactive-mode-map): New var.
(minibuffer-inactive-mode): New major mode.
* mouse.el (mouse-drag-region): Remove the "mouse-1 pops up
the *Messages* buffer" hack.
(mouse-popup-menubar): Don't burp if the event is a normal key.
Miscellaneous tweaks.
* emacs-lisp/cl-macs.el (dolist, dotimes): Use the same strategy for
lexical scoping as in subr.el's dolist and dotimes.
* emacs-lisp/bytecomp.el (byte-compile-unfold-bcf):
Silence compiler warning.
* thingatpt.el (forward-whitespace): Trivial coding style fix.
* subr.el (with-output-to-temp-buffer): Provide an edebug spec.
* international/ccl.el (ccl-compile): Trivial simplification.
* help-fns.el (help-do-arg-highlight): Silence compiler warning.
* emacs-lisp/testcover.el (testcover-end): Remove spurious
`printflag' argument.
* emacs-lisp/byte-run.el (make-obsolete, make-obsolete-variable):
Purecopy the whole obsolescence data.
2011-06-01 Leo Liu <sdl.web@gmail.com>
* net/rcirc.el (rcirc-decode-coding-system): Revert last change;
improve doc-string as suggested by Marco Pessotto
<melmothx@gmail.com>.
(rcirc-print): Fix last change.
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.
@ -30,6 +136,10 @@
(rcirc-decode-coding-system): Allow value nil for automatic coding
system detection.
2011-06-01 Glenn Morris <rgm@gnu.org>
* mail/emacsbug.el (report-emacs-bug-hook): Mailclient ignores From.
2011-05-29 Chong Yidong <cyd@stupidchicken.com>
* image.el (image-animate-max-time): Allow nil and t values.

27
lisp/calc/calc.el
View File

@ -1293,19 +1293,20 @@ the trail buffer."
(if (not info-list)
(progn
(setq calc-buffer-list (delete cb calc-buffer-list))
(with-current-buffer calc-trail-buffer
(if (eq cb calc-main-buffer)
;; If there are other Calc stacks, make another one
;; the calc-main-buffer ...
(if calc-buffer-list
(setq calc-main-buffer (car calc-buffer-list))
;; ... otherwise kill the trail and its windows.
(let ((wl (get-buffer-window-list calc-trail-buffer)))
(while wl
(delete-window (car wl))
(setq wl (cdr wl))))
(kill-buffer calc-trail-buffer)
(setq calc-trail-buffer nil))))
(if (buffer-live-p calc-trail-buffer)
(with-current-buffer calc-trail-buffer
(if (eq cb calc-main-buffer)
;; If there are other Calc stacks, make another one
;; the calc-main-buffer ...
(if calc-buffer-list
(setq calc-main-buffer (car calc-buffer-list))
;; ... otherwise kill the trail and its windows.
(let ((wl (get-buffer-window-list calc-trail-buffer)))
(while wl
(delete-window (car wl))
(setq wl (cdr wl))))
(kill-buffer calc-trail-buffer)))))
(setq calc-trail-buffer nil)
t))))
(defun calc-mode ()

26
lisp/emacs-lisp/byte-run.el
View File

@ -120,13 +120,13 @@ convention was modified."
The warning will say that CURRENT-NAME should be used instead.
If CURRENT-NAME is a string, that is the `use instead' message
\(it should end with a period, and not start with a capital).
If provided, WHEN should be a string indicating when the function
WHEN should be a string indicating when the function
was first made obsolete, for example a date or a release number."
(interactive "aMake function obsolete: \nxObsoletion replacement: ")
(put obsolete-name 'byte-obsolete-info
;; The second entry used to hold the `byte-compile' handler, but
;; is not used any more nowadays.
(list (purecopy current-name) nil (purecopy when)))
(purecopy (list current-name nil when)))
obsolete-name)
(set-advertised-calling-convention
;; New code should always provide the `when' argument.
@ -153,27 +153,21 @@ See the docstrings of `defalias' and `make-obsolete' for more details."
'define-obsolete-function-alias
'(obsolete-name current-name when &optional docstring) "23.1")
(defun make-obsolete-variable (obsolete-name current-name &optional when)
(defun make-obsolete-variable (obsolete-name current-name &optional when access-type)
"Make the byte-compiler warn that OBSOLETE-NAME is obsolete.
The warning will say that CURRENT-NAME should be used instead.
If CURRENT-NAME is a string, that is the `use instead' message.
If provided, WHEN should be a string indicating when the variable
was first made obsolete, for example a date or a release number."
(interactive
(list
(let ((str (completing-read "Make variable obsolete: " obarray 'boundp t)))
(if (equal str "") (error ""))
(intern str))
(car (read-from-string (read-string "Obsoletion replacement: ")))))
WHEN should be a string indicating when the variable
was first made obsolete, for example a date or a release number.
ACCESS-TYPE if non-nil should specify the kind of access that will trigger
obsolescence warnings; it can be either `get' or `set'."
(put obsolete-name 'byte-obsolete-variable
(cons
(if (stringp current-name)
(purecopy current-name)
current-name) (purecopy when)))
(purecopy (list current-name access-type when)))
obsolete-name)
(set-advertised-calling-convention
;; New code should always provide the `when' argument.
'make-obsolete-variable '(obsolete-name current-name when) "23.1")
'make-obsolete-variable
'(obsolete-name current-name when &optional access-type) "23.1")
(defmacro define-obsolete-variable-alias (obsolete-name current-name
&optional when docstring)

26
lisp/emacs-lisp/bytecomp.el
View File

@ -1109,7 +1109,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
(let* ((funcp (get symbol 'byte-obsolete-info))
(obsolete (or funcp (get symbol 'byte-obsolete-variable)))
(instead (car obsolete))
(asof (if funcp (nth 2 obsolete) (cdr obsolete))))
(asof (nth 2 obsolete)))
(unless (and funcp (memq symbol byte-compile-not-obsolete-funcs))
(byte-compile-warn "`%s' is an obsolete %s%s%s" symbol
(if funcp "function" "variable")
@ -2991,7 +2991,7 @@ That command is designed for interactive use only" fn))
(cond
((<= (+ alen alen) fmax2)
;; Add missing &optional (or &rest) arguments.
(dotimes (i (- (/ (1+ fmax2) 2) alen))
(dotimes (_ (- (/ (1+ fmax2) 2) alen))
(byte-compile-push-constant nil)))
((zerop (logand fmax2 1))
(byte-compile-log-warning "Too many arguments for inlined function"
@ -3016,20 +3016,24 @@ That command is designed for interactive use only" fn))
(assert (eq byte-compile-depth (1+ start-depth))
nil "Wrong depth start=%s end=%s" start-depth byte-compile-depth)))
(defun byte-compile-check-variable (var &optional binding)
"Do various error checks before a use of the variable VAR.
If BINDING is non-nil, VAR is being bound."
(defun byte-compile-check-variable (var access-type)
"Do various error checks before a use of the variable VAR."
(when (symbolp var)
(byte-compile-set-symbol-position var))
(cond ((or (not (symbolp var)) (byte-compile-const-symbol-p var))
(when (byte-compile-warning-enabled-p 'constants)
(byte-compile-warn (if binding
(byte-compile-warn (if (eq access-type 'let-bind)
"attempt to let-bind %s `%s`"
"variable reference to %s `%s'")
(if (symbolp var) "constant" "nonvariable")
(prin1-to-string var))))
((and (get var 'byte-obsolete-variable)
(not (memq var byte-compile-not-obsolete-vars)))
((let ((od (get var 'byte-obsolete-variable)))
(and od
(not (memq var byte-compile-not-obsolete-vars))
(or (case (nth 1 od)
(set (not (eq access-type 'reference)))
(get (eq access-type 'reference))
(t t)))))
(byte-compile-warn-obsolete var))))
(defsubst byte-compile-dynamic-variable-op (base-op var)
@ -3041,13 +3045,13 @@ If BINDING is non-nil, VAR is being bound."
(defun byte-compile-dynamic-variable-bind (var)
"Generate code to bind the lexical variable VAR to the top-of-stack value."
(byte-compile-check-variable var t)
(byte-compile-check-variable var 'let-bind)
(push var byte-compile-bound-variables)
(byte-compile-dynamic-variable-op 'byte-varbind var))
(defun byte-compile-variable-ref (var)
"Generate code to push the value of the variable VAR on the stack."
(byte-compile-check-variable var)
(byte-compile-check-variable var 'reference)
(let ((lex-binding (assq var byte-compile--lexical-environment)))
(if lex-binding
;; VAR is lexically bound
@ -3063,7 +3067,7 @@ If BINDING is non-nil, VAR is being bound."
(defun byte-compile-variable-set (var)
"Generate code to set the variable VAR from the top-of-stack value."
(byte-compile-check-variable var)
(byte-compile-check-variable var 'assign)
(let ((lex-binding (assq var byte-compile--lexical-environment)))
(if lex-binding
;; VAR is lexically bound

10
lisp/emacs-lisp/cconv.el
View File

@ -112,16 +112,6 @@
;; ,@(mapcar (lambda (binder) (if (consp binder) (cadr binder)))
;; binders)))
;; (defmacro letrec (binders &rest body)
;; ;; Only useful in lexical-binding mode.
;; ;; As a special-form, we could implement it more efficiently (and cleanly,
;; ;; making the vars actually unbound during evaluation of the binders).
;; `(let ,(mapcar (lambda (binder) (if (consp binder) (car binder) binder))
;; binders)
;; ,@(delq nil (mapcar (lambda (binder) (if (consp binder) `(setq ,@binder)))
;; binders))
;; ,@body))
(eval-when-compile (require 'cl))
(defconst cconv-liftwhen 6

61
lisp/emacs-lisp/cl-macs.el
View File

@ -1236,14 +1236,29 @@ Then evaluate RESULT to get return value, default nil.
\(fn (VAR LIST [RESULT]) BODY...)"
(let ((temp (make-symbol "--cl-dolist-temp--")))
(list 'block nil
(list* 'let (list (list temp (nth 1 spec)) (car spec))
(list* 'while temp (list 'setq (car spec) (list 'car temp))
(append body (list (list 'setq temp
(list 'cdr temp)))))
(if (cdr (cdr spec))
(cons (list 'setq (car spec) nil) (cdr (cdr spec)))
'(nil))))))
;; FIXME: Copy&pasted from subr.el.
`(block nil
;; This is not a reliable test, but it does not matter because both
;; semantics are acceptable, tho one is slightly faster with dynamic
;; scoping and the other is slightly faster (and has cleaner semantics)
;; with lexical scoping.
,(if lexical-binding
`(let ((,temp ,(nth 1 spec)))
(while ,temp
(let ((,(car spec) (car ,temp)))
,@body
(setq ,temp (cdr ,temp))))
,@(if (cdr (cdr spec))
;; FIXME: This let often leads to "unused var" warnings.
`((let ((,(car spec) nil)) ,@(cdr (cdr spec))))))
`(let ((,temp ,(nth 1 spec))
,(car spec))
(while ,temp
(setq ,(car spec) (car ,temp))
,@body
(setq ,temp (cdr ,temp)))
,@(if (cdr (cdr spec))
`((setq ,(car spec) nil) ,@(cddr spec))))))))
;;;###autoload
(defmacro dotimes (spec &rest body)
@ -1253,12 +1268,30 @@ to COUNT, exclusive. Then evaluate RESULT to get return value, default
nil.
\(fn (VAR COUNT [RESULT]) BODY...)"
(let ((temp (make-symbol "--cl-dotimes-temp--")))
(list 'block nil
(list* 'let (list (list temp (nth 1 spec)) (list (car spec) 0))
(list* 'while (list '< (car spec) temp)
(append body (list (list 'incf (car spec)))))
(or (cdr (cdr spec)) '(nil))))))
(let ((temp (make-symbol "--cl-dotimes-temp--"))
(end (nth 1 spec)))
;; FIXME: Copy&pasted from subr.el.
`(block nil
;; This is not a reliable test, but it does not matter because both
;; semantics are acceptable, tho one is slightly faster with dynamic
;; scoping and the other has cleaner semantics.
,(if lexical-binding
(let ((counter '--dotimes-counter--))
`(let ((,temp ,end)
(,counter 0))
(while (< ,counter ,temp)
(let ((,(car spec) ,counter))
,@body)
(setq ,counter (1+ ,counter)))
,@(if (cddr spec)
;; FIXME: This let often leads to "unused var" warnings.
`((let ((,(car spec) ,counter)) ,@(cddr spec))))))
`(let ((,temp ,end)
(,(car spec) 0))
(while (< ,(car spec) ,temp)
,@body
(incf ,(car spec)))
,@(cdr (cdr spec)))))))
;;;###autoload
(defmacro do-symbols (spec &rest body)

18
lisp/emacs-lisp/debug.el
View File

@ -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

5
lisp/emacs-lisp/lisp.el
View File

@ -636,9 +636,8 @@ considered."
(plist (nthcdr 3 data)))
(if (null data)
(minibuffer-message "Nothing to complete")
(let ((completion-annotate-function
(plist-get plist :annotation-function)))
(completion-in-region (nth 0 data) (nth 1 data) (nth 2 data)
(let ((completion-extra-properties plist))
(completion-in-region (nth 0 data) (nth 1 data) (nth 2 data)
(plist-get plist :predicate))))))

2
lisp/emacs-lisp/testcover.el
View File

@ -430,7 +430,7 @@ FUN should be `testcover-reinstrument' for compositional functions,
"Turn off instrumentation of all macros and functions in FILENAME."
(interactive "fStop covering file: ")
(let ((buf (find-file-noselect filename)))
(eval-buffer buf t)))
(eval-buffer buf)))
;;;=========================================================================

2
lisp/font-lock.el
View File

@ -563,7 +563,7 @@ we recommend setting `syntax-begin-function' instead.
This is normally set via `font-lock-defaults'.")
(make-obsolete-variable 'font-lock-beginning-of-syntax-function
'syntax-begin-function "23.3")
'syntax-begin-function "23.3" 'set)
(defvar font-lock-mark-block-function nil
"*Non-nil means use this function to mark a block of text.

26
lisp/gnus/ChangeLog
View File

@ -1,3 +1,29 @@
2011-06-01 Teodor Zlatanov <tzz@lifelogs.com>
* gnus-registry.el (gnus-registry-remove-ignored): New function to
remove entries with groups we ignore.
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

29
lisp/gnus/gnus-registry.el
View File

@ -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:
@ -321,6 +321,20 @@ This is not required after changing `gnus-registry-cache-file'."
(gnus-message 5 "Saving Gnus registry (size %d) to %s...done"
(registry-size db) file)))
(defun gnus-registry-remove-ignored ()
(interactive)
(let* ((db gnus-registry-db)
(grouphashtb (registry-lookup-secondary db 'group))
(old-size (registry-size db)))
(registry-reindex db)
(loop for k being the hash-keys of grouphashtb
using (hash-values v)
when (gnus-registry-ignore-group-p k)
do (registry-delete db v nil))
(registry-reindex db)
(gnus-message 4 "Removed %d ignored entries from the Gnus registry"
(- old-size (registry-size db)))))
;; article move/copy/spool/delete actions
(defun gnus-registry-action (action data-header from &optional to method)
(let* ((id (mail-header-id data-header))
@ -897,9 +911,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 +928,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))))

8
lisp/gnus/gnus-sum.el
View File

@ -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

32
lisp/gnus/shr.el
View File

@ -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.

8
lisp/help-fns.el
View File

@ -222,7 +222,7 @@ if the variable `help-downcase-arguments' is non-nil."
(defun help-do-arg-highlight (doc args)
(with-syntax-table (make-syntax-table emacs-lisp-mode-syntax-table)
(modify-syntax-entry ?\- "w")
(dolist (arg args doc)
(dolist (arg args)
(setq doc (replace-regexp-in-string
;; This is heuristic, but covers all common cases
;; except ARG1-ARG2
@ -236,7 +236,8 @@ if the variable `help-downcase-arguments' is non-nil."
"\\(?:-[{([<`\"].*?\\)?"; for ARG-{x}, (x), <x>, [x], `x'
"\\>") ; end of word
(help-highlight-arg arg)
doc t t 1)))))
doc t t 1)))
doc))
(defun help-highlight-arguments (usage doc &rest args)
(when (and usage (string-match "^(" usage))
@ -804,7 +805,8 @@ it is displayed along with the global value."
(when obsolete
(setq extra-line t)
(princ " This variable is obsolete")
(if (cdr obsolete) (princ (format " since %s" (cdr obsolete))))
(if (nth 2 obsolete)
(princ (format " since %s" (nth 2 obsolete))))
(princ (cond ((stringp use) (concat ";\n " use))
(use (format ";\n use `%s' instead." (car obsolete)))
(t ".")))

8
lisp/international/ccl.el
View File

@ -280,10 +280,10 @@ the current loop.")
;;;###autoload
(defun ccl-compile (ccl-program)
"Return the compiled code of CCL-PROGRAM as a vector of integers."
(if (or (null (consp ccl-program))
(null (integerp (car ccl-program)))
(null (listp (car (cdr ccl-program)))))
(error "CCL: Invalid CCL program: %s" ccl-program))
(unless (and (consp ccl-program)
(integerp (car ccl-program))
(listp (car (cdr ccl-program))))
(error "CCL: Invalid CCL program: %s" ccl-program))
(if (null (vectorp ccl-program-vector))
(setq ccl-program-vector (make-vector 8192 0)))
(setq ccl-loop-head nil ccl-breaks nil)

35
lisp/international/quail.el
View File

@ -2253,12 +2253,10 @@ are shown (at most to the depth specified `quail-completion-max-depth')."
;; Give temporary modes such as isearch a chance to turn off.
(run-hooks 'mouse-leave-buffer-hook)
(let ((buffer (window-buffer))
choice
base-size)
choice)
(with-current-buffer (window-buffer (posn-window (event-start event)))
(if completion-reference-buffer
(setq buffer completion-reference-buffer))
(setq base-size completion-base-size)
(save-excursion
(goto-char (posn-point (event-start event)))
(let (beg end)
@ -2272,26 +2270,23 @@ are shown (at most to the depth specified `quail-completion-max-depth')."
(setq end (or (next-single-property-change end 'mouse-face)
(point-max)))
(setq choice (buffer-substring beg end)))))
; (let ((owindow (selected-window)))
; (select-window (posn-window (event-start event)))
; (if (and (one-window-p t 'selected-frame)
; (window-dedicated-p (selected-window)))
; ;; This is a special buffer's frame
; (iconify-frame (selected-frame))
; (or (window-dedicated-p (selected-window))
; (bury-buffer)))
; (select-window owindow))
;; (let ((owindow (selected-window)))
;; (select-window (posn-window (event-start event)))
;; (if (and (one-window-p t 'selected-frame)
;; (window-dedicated-p (selected-window)))
;; ;; This is a special buffer's frame
;; (iconify-frame (selected-frame))
;; (or (window-dedicated-p (selected-window))
;; (bury-buffer)))
;; (select-window owindow))
(quail-delete-region)
(quail-choose-completion-string choice buffer base-size)
(setq quail-current-str choice)
;; FIXME: We need to pass `base-position' here.
;; FIXME: why do we need choose-completion-string with all its
;; completion-specific logic?
(choose-completion-string choice buffer)
(quail-terminate-translation)))
;; BASE-SIZE here is for compatibility with an (unused) arg of a
;; previous implementation.
(defun quail-choose-completion-string (choice &optional buffer base-size)
(setq quail-current-str choice)
;; FIXME: We need to pass `base-position' here.
(choose-completion-string choice buffer))
(defun quail-build-decode-map (map-list key decode-map num
&optional maxnum ignores)
"Build a decoding map.

636
lisp/ldefs-boot.el
View File

File diff suppressed because it is too large Load Diff

5
lisp/mail/emacsbug.el
View File

@ -331,6 +331,7 @@ usually do not have translators to read other languages for them.\n\n")
;; It's the default mail mode, so it seems OK to use its features.
(autoload 'message-bogus-recipient-p "message")
(defvar message-send-mail-function)
(defun report-emacs-bug-hook ()
"Do some checking before sending a bug report."
@ -343,6 +344,10 @@ usually do not have translators to read other languages for them.\n\n")
report-emacs-bug-orig-text)
(error "No text entered in bug report"))
(or report-emacs-bug-no-confirmation
;; mailclient.el does not handle From (at present).
(if (derived-mode-p 'message-mode)
(eq message-send-mail-function 'message-send-mail-with-mailclient)
(eq send-mail-function 'mailclient-send-it))
;; Not narrowing to the headers, but that's OK.
(let ((from (mail-fetch-field "From")))
(and (or (not from)

3
lisp/mail/sendmail.el
View File

@ -470,7 +470,8 @@ by Emacs.)")
(put 'mail-mailer-swallows-blank-line 'risky-local-variable t) ; gets evalled
(make-obsolete-variable 'mail-mailer-swallows-blank-line
"no need to set this on any modern system." "24.1")
"no need to set this on any modern system."
"24.1" 'set)
(defvar mail-mode-syntax-table
;; define-derived-mode will make it inherit from text-mode-syntax-table.

133
lisp/minibuffer.el
View File

@ -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)
@ -1640,6 +1657,34 @@ The completion method is determined by `completion-at-point-functions'."
(define-key map "\t" 'exit-minibuffer)
(define-key map "?" 'self-insert-and-exit))
(defvar minibuffer-inactive-mode-map
(let ((map (make-keymap)))
(suppress-keymap map)
(define-key map "e" 'find-file-other-frame)
(define-key map "f" 'find-file-other-frame)
(define-key map "b" 'switch-to-buffer-other-frame)
(define-key map "i" 'info)
(define-key map "m" 'mail)
(define-key map "n" 'make-frame)
(define-key map [mouse-1] (lambda () (interactive)
(with-current-buffer "*Messages*"
(goto-char (point-max))
(display-buffer (current-buffer)))))
;; So the global down-mouse-1 binding doesn't clutter the execution of the
;; above mouse-1 binding.
(define-key map [down-mouse-1] #'ignore)
map)
"Keymap for use in the minibuffer when it is not active.
The non-mouse bindings in this keymap can only be used in minibuffer-only
frames, since the minibuffer can normally not be selected when it is
not active.")
(define-derived-mode minibuffer-inactive-mode nil "InactiveMinibuffer"
:abbrev-table nil ;abbrev.el is not loaded yet during dump.
;; Note: this major mode is called from minibuf.c.
"Major mode to use in the minibuffer when it is not active.
This is only used when the minibuffer area has no active minibuffer.")
;;; Completion tables.
(defun minibuffer--double-dollars (str)
@ -1673,8 +1718,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 +1729,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
@ -1927,7 +1974,11 @@ and `read-file-name-function'."
;; minibuffer-completing-file-name is a variable used internally in minibuf.c
;; to determine whether to use minibuffer-local-filename-completion-map or
;; minibuffer-local-completion-map. It shouldn't be exported to Elisp.
(make-obsolete-variable 'minibuffer-completing-file-name nil "24.1")
;; FIXME: Actually, it is also used in rfn-eshadow.el we'd otherwise have to
;; use (eq minibuffer-completion-table #'read-file-name-internal), which is
;; probably even worse. Maybe We should add some read-file-name-setup-hook
;; instead, but for now, let's keep this non-obsolete.
;;(make-obsolete-variable 'minibuffer-completing-file-name nil "24.1" 'get)
(defun read-file-name-default (prompt &optional dir default-filename mustmatch initial predicate)
"Default method for reading file names.
@ -2299,7 +2350,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 +2449,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.

17
lisp/mouse.el
View File

@ -278,7 +278,7 @@ The contents are the items that would be in the menu bar whether or
not it is actually displayed."
(interactive "@e \nP")
(run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
(popup-menu (mouse-menu-bar-map) event prefix))
(popup-menu (mouse-menu-bar-map) (unless (integerp event) event) prefix))
(make-obsolete 'mouse-popup-menubar 'mouse-menu-bar-map "23.1")
(defun mouse-popup-menubar-stuff (event prefix)
@ -790,18 +790,9 @@ remains active. Otherwise, it remains until the next input event.
If the click is in the echo area, display the `*Messages*' buffer."
(interactive "e")
(let ((w (posn-window (event-start start-event))))
(if (and (window-minibuffer-p w)
(not (minibuffer-window-active-p w)))
(save-excursion
;; Swallow the up-event.
(read-event)
(set-buffer (get-buffer-create "*Messages*"))
(goto-char (point-max))
(display-buffer (current-buffer)))
;; Give temporary modes such as isearch a chance to turn off.
(run-hooks 'mouse-leave-buffer-hook)
(mouse-drag-track start-event t))))
;; Give temporary modes such as isearch a chance to turn off.
(run-hooks 'mouse-leave-buffer-hook)
(mouse-drag-track start-event t))
(defun mouse-posn-property (pos property)

9
lisp/net/rcirc.el
View File

@ -314,11 +314,11 @@ Called with 5 arguments, PROCESS, SENDER, RESPONSE, TARGET and TEXT."
:type 'boolean
:group 'rcirc)
(defcustom rcirc-decode-coding-system nil
(defcustom rcirc-decode-coding-system 'utf-8
"Coding system used to decode incoming irc messages.
If nil automatically detect the coding system."
Set to 'undecided if you want the encoding of the incoming
messages autodetected."
:type 'coding-system
:version "24.1"
:group 'rcirc)
(defcustom rcirc-encode-coding-system 'utf-8
@ -1482,8 +1482,7 @@ record activity."
(old-point (point-marker))
(fill-start (marker-position rcirc-prompt-start-marker)))
(setq text (decode-coding-string text (or rcirc-decode-coding-system
(detect-coding-string text t))))
(setq text (decode-coding-string text rcirc-decode-coding-system))
(unless (string= sender (rcirc-nick process))
;; mark the line with overlay arrow
(unless (or (marker-position overlay-arrow-position)

6
lisp/net/tramp-gvfs.el
View File

@ -541,7 +541,7 @@ is no information where to trace the message.")
"Like `copy-file' for Tramp files."
(with-parsed-tramp-file-name
(if (tramp-tramp-file-p filename) filename newname) nil
(with-progress-reporter
(tramp-with-progress-reporter
v 0 (format "Copying %s to %s" filename newname)
(condition-case err
(let ((args
@ -745,7 +745,7 @@ is no information where to trace the message.")
"Like `rename-file' for Tramp files."
(with-parsed-tramp-file-name
(if (tramp-tramp-file-p filename) filename newname) nil
(with-progress-reporter
(tramp-with-progress-reporter
v 0 (format "Renaming %s to %s" filename newname)
(condition-case err
(rename-file
@ -1203,7 +1203,7 @@ connection if a previous connection has died for some reason."
(tramp-gvfs-object-path
(tramp-make-tramp-file-name method user host ""))))
(with-progress-reporter
(tramp-with-progress-reporter
vec 3
(if (zerop (length user))
(format "Opening connection for %s using %s" host method)

28
lisp/net/tramp-sh.el
View File

@ -1945,7 +1945,7 @@ file names."
(tramp-error
v 'file-already-exists "File %s already exists" newname))
(with-progress-reporter
(tramp-with-progress-reporter
v 0 (format "%s %s to %s"
(if (eq op 'copy) "Copying" "Renaming")
filename newname)
@ -2454,7 +2454,8 @@ This is like `dired-recursive-delete-directory' for Tramp files."
nil)
((and suffix (nth 2 suffix))
;; We found an uncompression rule.
(with-progress-reporter v 0 (format "Uncompressing %s" file)
(tramp-with-progress-reporter
v 0 (format "Uncompressing %s" file)
(when (tramp-send-command-and-check
v (concat (nth 2 suffix) " "
(tramp-shell-quote-argument localname)))
@ -2465,7 +2466,7 @@ This is like `dired-recursive-delete-directory' for Tramp files."
(t
;; We don't recognize the file as compressed, so compress it.
;; Try gzip.
(with-progress-reporter v 0 (format "Compressing %s" file)
(tramp-with-progress-reporter v 0 (format "Compressing %s" file)
(when (tramp-send-command-and-check
v (concat "gzip -f "
(tramp-shell-quote-argument localname)))
@ -2948,7 +2949,7 @@ the result will be a local, non-Tramp, filename."
;; Use inline encoding for file transfer.
(rem-enc
(save-excursion
(with-progress-reporter
(tramp-with-progress-reporter
v 3 (format "Encoding remote file %s" filename)
(tramp-barf-unless-okay
v (format rem-enc (tramp-shell-quote-argument localname))
@ -2962,7 +2963,7 @@ the result will be a local, non-Tramp, filename."
(with-temp-buffer
(set-buffer-multibyte nil)
(insert-buffer-substring (tramp-get-buffer v))
(with-progress-reporter
(tramp-with-progress-reporter
v 3 (format "Decoding remote file %s with function %s"
filename loc-dec)
(funcall loc-dec (point-min) (point-max))
@ -2980,7 +2981,7 @@ the result will be a local, non-Tramp, filename."
(let (file-name-handler-alist
(coding-system-for-write 'binary))
(write-region (point-min) (point-max) tmpfile2))
(with-progress-reporter
(tramp-with-progress-reporter
v 3 (format "Decoding remote file %s with command %s"
filename loc-dec)
(unwind-protect
@ -3205,7 +3206,7 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file."
(set-buffer-multibyte nil)
;; Use encoding function or command.
(if (functionp loc-enc)
(with-progress-reporter
(tramp-with-progress-reporter
v 3 (format "Encoding region using function `%s'"
loc-enc)
(let ((coding-system-for-read 'binary))
@ -3223,7 +3224,7 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file."
(tramp-compat-temporary-file-directory)))
(funcall loc-enc (point-min) (point-max))))
(with-progress-reporter
(tramp-with-progress-reporter
v 3 (format "Encoding region using command `%s'"
loc-enc)
(unless (zerop (tramp-call-local-coding-command
@ -3237,7 +3238,7 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file."
;; Send buffer into remote decoding command which
;; writes to remote file. Because this happens on
;; the remote host, we cannot use the function.
(with-progress-reporter
(tramp-with-progress-reporter
v 3
(format "Decoding region into remote file %s" filename)
(goto-char (point-max))
@ -3337,7 +3338,7 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file."
"Like `vc-registered' for Tramp files."
(tramp-compat-with-temp-message ""
(with-parsed-tramp-file-name file nil
(with-progress-reporter
(tramp-with-progress-reporter
v 3 (format "Checking `vc-registered' for %s" file)
;; There could be new files, created by the vc backend. We
@ -3431,7 +3432,7 @@ Only send the definition if it has not already been done."
(let* ((p (tramp-get-connection-process vec))
(scripts (tramp-get-connection-property p "scripts" nil)))
(unless (member name scripts)
(with-progress-reporter vec 5 (format "Sending script `%s'" name)
(tramp-with-progress-reporter vec 5 (format "Sending script `%s'" name)
;; The script could contain a call of Perl. This is masked with `%s'.
(tramp-barf-unless-okay
vec
@ -3595,7 +3596,8 @@ file exists and nonzero exit status otherwise."
(defun tramp-open-shell (vec shell)
"Opens shell SHELL."
(with-progress-reporter vec 5 (format "Opening remote shell `%s'" shell)
(tramp-with-progress-reporter
vec 5 (format "Opening remote shell `%s'" shell)
;; Find arguments for this shell.
(let ((tramp-end-of-output tramp-initial-end-of-output)
(alist tramp-sh-extra-args)
@ -4247,7 +4249,7 @@ connection if a previous connection has died for some reason."
;; We call `tramp-get-buffer' in order to get a debug buffer for
;; messages from the beginning.
(tramp-get-buffer vec)
(with-progress-reporter
(tramp-with-progress-reporter
vec 3
(if (zerop (length (tramp-file-name-user vec)))
(format "Opening connection for %s using %s"

10
lisp/net/tramp-smb.el
View File

@ -342,7 +342,7 @@ KEEP-DATE is not handled in case NEWNAME resides on an SMB server.
PRESERVE-UID-GID and PRESERVE-SELINUX-CONTEXT are completely ignored."
(setq filename (expand-file-name filename)
newname (expand-file-name newname))
(with-progress-reporter
(tramp-with-progress-reporter
(tramp-dissect-file-name (if (file-remote-p filename) filename newname))
0 (format "Copying %s to %s" filename newname)
@ -600,7 +600,7 @@ PRESERVE-UID-GID and PRESERVE-SELINUX-CONTEXT are completely ignored."
v 'file-error
"Cannot make local copy of non-existing file `%s'" filename))
(let ((tmpfile (tramp-compat-make-temp-file filename)))
(with-progress-reporter
(tramp-with-progress-reporter
v 3 (format "Fetching %s to tmp file %s" filename tmpfile)
(unless (tramp-smb-send-command
v (format "get \"%s\" \"%s\""
@ -837,7 +837,7 @@ target of the symlink differ."
"Like `rename-file' for Tramp files."
(setq filename (expand-file-name filename)
newname (expand-file-name newname))
(with-progress-reporter
(tramp-with-progress-reporter
(tramp-dissect-file-name (if (file-remote-p filename) filename newname))
0 (format "Renaming %s to %s" filename newname)
@ -926,7 +926,7 @@ errors for shares like \"C$/\", which are common in Microsoft Windows."
(list start end tmpfile append 'no-message lockname confirm)
(list start end tmpfile append 'no-message lockname)))
(with-progress-reporter
(tramp-with-progress-reporter
v 3 (format "Moving tmp file %s to %s" tmpfile filename)
(unwind-protect
(unless (tramp-smb-send-command
@ -1289,7 +1289,7 @@ connection if a previous connection has died for some reason."
(setq args (append args (list "-s" tramp-smb-conf))))
;; OK, let's go.
(with-progress-reporter
(tramp-with-progress-reporter
vec 3
(format "Opening connection for //%s%s/%s"
(if (not (zerop (length user))) (concat user "@") "")

11
lisp/net/tramp.el
View File

@ -1452,11 +1452,12 @@ If VAR is nil, then we bind `v' to the structure and `method', `user',
(when (string-match message (or (current-message) ""))
(tramp-compat-funcall 'progress-reporter-update reporter value))))
(defmacro with-progress-reporter (vec level message &rest body)
(defmacro tramp-with-progress-reporter (vec level message &rest body)
"Executes BODY, spinning a progress reporter with MESSAGE.
If LEVEL does not fit for visible messages, or if this is a
nested call of the macro, there are only traces without a visible
progress reporter."
(declare (indent 3) (debug t))
`(let (pr tm)
(tramp-message ,vec ,level "%s..." ,message)
;; We start a pulsing progress reporter after 3 seconds. Feature
@ -1479,10 +1480,8 @@ progress reporter."
(if tm (tramp-compat-funcall 'cancel-timer tm))
(tramp-message ,vec ,level "%s...done" ,message))))
(put 'with-progress-reporter 'lisp-indent-function 3)
(put 'with-progress-reporter 'edebug-form-spec t)
(tramp-compat-font-lock-add-keywords
'emacs-lisp-mode '("\\<with-progress-reporter\\>"))
'emacs-lisp-mode '("\\<tramp-with-progress-reporter\\>"))
(eval-and-compile ;; Silence compiler.
(if (memq system-type '(cygwin windows-nt))
@ -2881,7 +2880,7 @@ User is always nil."
;; useful for "rsync".
(setq tramp-temp-buffer-file-name local-copy))
(with-progress-reporter
(tramp-with-progress-reporter
v 3 (format "Inserting local temp file `%s'" local-copy)
;; We must ensure that `file-coding-system-alist'
;; matches `local-copy'.
@ -2932,7 +2931,7 @@ User is always nil."
(if (not (file-exists-p file))
nil
(let ((tramp-message-show-message (not nomessage)))
(with-progress-reporter v 0 (format "Loading %s" file)
(tramp-with-progress-reporter v 0 (format "Loading %s" file)
(let ((local-copy (file-local-copy file)))
;; MUST-SUFFIX doesn't exist on XEmacs, so let it default to nil.
(unwind-protect

5
lisp/proced.el
View File

@ -1735,8 +1735,9 @@ After sending the signal, this command runs the normal hook
(pnum (if (= 1 (length process-alist))
"1 process"
(format "%d processes" (length process-alist))))
(completion-annotate-function
(lambda (s) (cdr (assoc s proced-signal-list)))))
(completion-extra-properties
'(:annotation-function
(lambda (s) (cdr (assoc s proced-signal-list))))))
(setq signal
(completing-read (concat "Send signal [" pnum
"] (default TERM): ")

15
lisp/server.el
View File

@ -235,9 +235,10 @@ If local sockets are not supported, this is nil.")
(defun server-clients-with (property value)
"Return a list of clients with PROPERTY set to VALUE."
(let (result)
(dolist (proc server-clients result)
(dolist (proc server-clients)
(when (equal value (process-get proc property))
(push proc result)))))
(push proc result)))
result))
(defun server-add-client (proc)
"Create a client for process PROC, if it doesn't already have one.
@ -1322,10 +1323,11 @@ specifically for the clients and did not exist before their request for it."
"Ask before killing a server buffer."
(or (not server-buffer-clients)
(let ((res t))
(dolist (proc server-buffer-clients res)
(dolist (proc server-buffer-clients)
(when (and (memq proc server-clients)
(eq (process-status proc) 'open))
(setq res nil))))
(setq res nil)))
res)
(yes-or-no-p (format "Buffer `%s' still has clients; kill it? "
(buffer-name (current-buffer))))))
@ -1333,10 +1335,11 @@ specifically for the clients and did not exist before their request for it."
"Ask before exiting Emacs if it has live clients."
(or (not server-clients)
(let (live-client)
(dolist (proc server-clients live-client)
(dolist (proc server-clients)
(when (memq t (mapcar 'buffer-live-p (process-get
proc 'buffers)))
(setq live-client t))))
(setq live-client t)))
live-client)
(yes-or-no-p "This Emacs session has clients; exit anyway? ")))
(defun server-kill-buffer ()

43
lisp/simple.el
View File

@ -967,13 +967,11 @@ rather than line counts."
(concat " in " (buffer-name buffer))
"")))
;; Read the argument, offering that number (if any) as default.
(list (read-from-minibuffer (format (if default "Goto line%s (%s): "
"Goto line%s: ")
buffer-prompt
default)
nil nil t
'minibuffer-history
default)
(list (read-number (format (if default "Goto line%s (%s): "
"Goto line%s: ")
buffer-prompt
default)
default)
buffer))))
;; Switch to the desired buffer, one way or another.
(if buffer
@ -1158,7 +1156,7 @@ in *Help* buffer. See also the command `describe-char'."
(defvar minibuffer-completing-symbol nil
"Non-nil means completing a Lisp symbol in the minibuffer.")
(make-obsolete-variable 'minibuffer-completing-symbol nil "24.1")
(make-obsolete-variable 'minibuffer-completing-symbol nil "24.1" 'get)
(defvar minibuffer-default nil
"The current default value or list of default values in the minibuffer.
@ -2815,25 +2813,21 @@ The return value is always nil."
`universal-argument-other-key' uses this to discard those events
from (this-command-keys), and reread only the final command.")
(defvar overriding-map-is-bound nil
"Non-nil when `overriding-terminal-local-map' is `universal-argument-map'.")
(defvar saved-overriding-map nil
(defvar saved-overriding-map t
"The saved value of `overriding-terminal-local-map'.
That variable gets restored to this value on exiting \"universal
argument mode\".")
(defun ensure-overriding-map-is-bound ()
"Check `overriding-terminal-local-map' is `universal-argument-map'."
(unless overriding-map-is-bound
(defun save&set-overriding-map (map)
"Set `overriding-terminal-local-map' to MAP."
(when (eq saved-overriding-map t)
(setq saved-overriding-map overriding-terminal-local-map)
(setq overriding-terminal-local-map universal-argument-map)
(setq overriding-map-is-bound t)))
(setq overriding-terminal-local-map map)))
(defun restore-overriding-map ()
"Restore `overriding-terminal-local-map' to its saved value."
(setq overriding-terminal-local-map saved-overriding-map)
(setq overriding-map-is-bound nil))
(setq saved-overriding-map t))
(defun universal-argument ()
"Begin a numeric argument for the following command.
@ -2848,7 +2842,7 @@ These commands include \\[set-mark-command] and \\[start-kbd-macro]."
(interactive)
(setq prefix-arg (list 4))
(setq universal-argument-num-events (length (this-command-keys)))
(ensure-overriding-map-is-bound))
(save&set-overriding-map universal-argument-map))
;; A subsequent C-u means to multiply the factor by 4 if we've typed
;; nothing but C-u's; otherwise it means to terminate the prefix arg.
@ -2873,7 +2867,7 @@ These commands include \\[set-mark-command] and \\[start-kbd-macro]."
(t
(setq prefix-arg '-)))
(setq universal-argument-num-events (length (this-command-keys)))
(ensure-overriding-map-is-bound))
(save&set-overriding-map universal-argument-map))
(defun digit-argument (arg)
"Part of the numeric argument for the next command.
@ -2892,7 +2886,7 @@ These commands include \\[set-mark-command] and \\[start-kbd-macro]."
(t
(setq prefix-arg digit))))
(setq universal-argument-num-events (length (this-command-keys)))
(ensure-overriding-map-is-bound))
(save&set-overriding-map universal-argument-map))
;; For backward compatibility, minus with no modifiers is an ordinary
;; command if digits have already been entered.
@ -5177,8 +5171,8 @@ Returns t if it really did any work."
(or (null fill-prefix) (string= fill-prefix "")))
(let ((prefix
(fill-context-prefix
(save-excursion (backward-paragraph 1) (point))
(save-excursion (forward-paragraph 1) (point)))))
(save-excursion (fill-forward-paragraph -1) (point))
(save-excursion (fill-forward-paragraph 1) (point)))))
(and prefix (not (equal prefix ""))
;; Use auto-indentation rather than a guessed empty prefix.
(not (and fill-indent-according-to-mode
@ -5660,7 +5654,8 @@ At top-level, as an editor command, this simply beeps."
(if (fboundp 'kmacro-keyboard-quit)
(kmacro-keyboard-quit))
(setq defining-kbd-macro nil)
(signal 'quit nil))
(let ((debug-on-quit nil))
(signal 'quit nil)))
(defvar buffer-quit-function nil
"Function to call to \"quit\" the current buffer, or nil if none.

8
lisp/subr.el
View File

@ -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
@ -2919,6 +2926,7 @@ with the buffer BUFNAME temporarily current. It runs the hook
buffer temporarily current, and the window that was used to display it
temporarily selected. But it doesn't run `temp-buffer-show-hook'
if it uses `temp-buffer-show-function'."
(declare (debug t))
(let ((old-dir (make-symbol "old-dir"))
(buf (make-symbol "buf")))
`(let* ((,old-dir default-directory)

2
lisp/thingatpt.el
View File

@ -402,7 +402,7 @@ with angle brackets.")
(re-search-forward "[ \t]+\\|\n" nil 'move arg)
(while (< arg 0)
(if (re-search-backward "[ \t]+\\|\n" nil 'move)
(or (eq (char-after (match-beginning 0)) 10)
(or (eq (char-after (match-beginning 0)) ?\n)
(skip-chars-backward " \t")))
(setq arg (1+ arg)))))

14
lisp/url/ChangeLog
View File

@ -1,3 +1,17 @@
2011-06-01 Glenn Morris <rgm@gnu.org>
* url-queue.el (url-queue-parallel-processes, url-queue-timeout):
Add :version tag for options that will be new in 24.1.
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

126
lisp/url/url-future.el Normal file
View File

@ -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

4
lisp/url/url-queue.el
View File

@ -31,13 +31,15 @@
(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."
:version "24.1"
:type 'integer
:group 'url)
(defcustom url-queue-timeout 5
"How long to let a job live once it's started (in seconds)."
:version "24.1"
:type 'integer
:group 'url)

36
src/ChangeLog
View File

@ -1,3 +1,37 @@
2011-06-01 Dan Nicolaescu <dann@ics.uci.edu>
Make it possible to build with GCC-4.6+ -O2 -flto.
* emacs.c (__malloc_initialize_hook): Mark as EXTERNALLY_VISIBLE.
2011-06-01 Stefan Monnier <monnier@iro.umontreal.ca>
* minibuf.c (get_minibuffer, read_minibuf_unwind):
Call minibuffer-inactive-mode.
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>
Remove arbitrary limit of 2**31 entries in hash tables. (Bug#8771)
@ -205,7 +239,7 @@
merge count_size_as_multibyte, parse_str_to_multibyte
* character.c, character.h (count_size_as_multibyte):
Renamed from parse_str_to_multibyte; all uses changed.
Rename from parse_str_to_multibyte; all uses changed.
Check for integer overflow.
* insdel.c, lisp.h (count_size_as_multibyte): Remove,
since it's now a duplicate of the other. This is more of

10
src/bytecode.c
View File

@ -144,7 +144,7 @@ Lisp_Object Qbytecode;
#define Bcurrent_column 0151
#define Bindent_to 0152
#ifdef BYTE_CODE_SAFE
#define Bscan_buffer 0153 /* No longer generated as of v18 */
#define Bscan_buffer 0153 /* No longer generated as of v18. */
#endif
#define Beolp 0154
#define Beobp 0155
@ -956,7 +956,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
save_restriction_save ());
break;
case Bcatch: /* FIXME: ill-suited for lexbind */
case Bcatch: /* FIXME: ill-suited for lexbind. */
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
@ -966,11 +966,11 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
break;
}
case Bunwind_protect: /* FIXME: avoid closure for lexbind */
case Bunwind_protect: /* FIXME: avoid closure for lexbind. */
record_unwind_protect (Fprogn, POP);
break;
case Bcondition_case: /* FIXME: ill-suited for lexbind */
case Bcondition_case: /* FIXME: ill-suited for lexbind. */
{
Lisp_Object handlers, body;
handlers = POP;
@ -1779,8 +1779,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
PUSH (*ptr);
break;
}
/* stack-set-0 = discard; stack-set-1 = discard-1-preserve-tos. */
case Bstack_set:
/* stack-set-0 = discard; stack-set-1 = discard-1-preserve-tos. */
{
Lisp_Object *ptr = top - (FETCH);
*ptr = POP;

4
src/data.c
View File

@ -3220,8 +3220,4 @@ init_data (void)
return;
#endif /* CANNOT_DUMP */
signal (SIGFPE, arith_error);
#ifdef uts
signal (SIGEMT, arith_error);
#endif /* uts */
}

9
src/dispnew.c
View File

@ -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

2
src/emacs.c
View File

@ -678,7 +678,7 @@ malloc_initialize_hook (void)
}
}
void (*__malloc_initialize_hook) (void) = malloc_initialize_hook;
void (*__malloc_initialize_hook) (void) EXTERNALLY_VISIBLE = malloc_initialize_hook;
#endif /* DOUG_LEA_MALLOC */

2
src/frame.c
View File

@ -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;
}

2
src/makefile.w32-in
View File

@ -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 \

71
src/minibuf.c
View File

@ -160,7 +160,7 @@ without invoking the usual minibuffer commands. */)
}
/* Actual minibuffer invocation. */
/* Actual minibuffer invocation. */
static Lisp_Object read_minibuf_unwind (Lisp_Object);
static Lisp_Object run_exit_minibuf_hook (Lisp_Object);
@ -266,7 +266,7 @@ read_minibuf_noninteractive (Lisp_Object map, Lisp_Object initial,
error ("Error reading from stdin");
}
/* If Lisp form desired instead of string, parse it. */
/* If Lisp form desired instead of string, parse it. */
if (expflag)
val = string_to_object (val, CONSP (defalt) ? XCAR (defalt) : defalt);
@ -743,7 +743,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
}
}
/* If Lisp form desired instead of string, parse it. */
/* If Lisp form desired instead of string, parse it. */
if (expflag)
val = string_to_object (val, defalt);
@ -755,7 +755,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
/* Return a buffer to be used as the minibuffer at depth `depth'.
depth = 0 is the lowest allowed argument, and that is the value
used for nonrecursive minibuffer invocations */
used for nonrecursive minibuffer invocations. */
Lisp_Object
get_minibuffer (int depth)
@ -793,7 +793,10 @@ get_minibuffer (int depth)
reset_buffer (XBUFFER (buf));
record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
Fset_buffer (buf);
Fkill_all_local_variables ();
if (!NILP (Ffboundp (intern ("minibuffer-inactive-mode"))))
call0 (intern ("minibuffer-inactive-mode"));
else
Fkill_all_local_variables ();
unbind_to (count, Qnil);
}
@ -808,7 +811,7 @@ run_exit_minibuf_hook (Lisp_Object data)
}
/* This function is called on exiting minibuffer, whether normally or
not, and it restores the current window, buffer, etc. */
not, and it restores the current window, buffer, etc. */
static Lisp_Object
read_minibuf_unwind (Lisp_Object data)
@ -868,6 +871,12 @@ read_minibuf_unwind (Lisp_Object data)
windows_or_buffers_changed++;
XSETFASTINT (XWINDOW (window)->last_modified, 0);
XSETFASTINT (XWINDOW (window)->last_overlay_modified, 0);
/* In case the previous minibuffer displayed in this miniwindow is
dead, we may keep displaying this buffer (tho it's inactive), so reset it,
to make sure we don't leave around bindings and stuff which only
made sense during the read_minibuf invocation. */
call0 (intern ("minibuffer-inactive-mode"));
return Qnil;
}
@ -978,7 +987,7 @@ Such arguments are used as in `read-from-minibuffer'.) */)
Qnil);
}
/* Functions that use the minibuffer to read various things. */
/* Functions that use the minibuffer to read various things. */
DEFUN ("read-string", Fread_string, Sread_string, 1, 5, 0,
doc: /* Read a string from the minibuffer, prompting with string PROMPT.
@ -1146,7 +1155,7 @@ function, instead of the usual behavior. */)
args[1] = prompt;
args[2] = def;
args[3] = require_match;
result = Ffuncall(4, args);
result = Ffuncall (4, args);
}
return unbind_to (count, result);
}
@ -1233,10 +1242,10 @@ is used to further constrain the set of candidates. */)
while (1)
{
/* Get the next element of the alist, obarray, or hash-table. */
/* Exit the loop if the elements are all used up. */
/* Get the next element of the alist, obarray, or hash-table. */
/* Exit the loop if the elements are all used up. */
/* elt gets the alist element or symbol.
eltstring gets the name to check as a completion. */
eltstring gets the name to check as a completion. */
if (type == list_table)
{
@ -1278,7 +1287,7 @@ is used to further constrain the set of candidates. */)
elt = eltstring = HASH_KEY (XHASH_TABLE (collection), idx++);
}
/* Is this element a possible completion? */
/* Is this element a possible completion? */
if (SYMBOLP (eltstring))
eltstring = Fsymbol_name (eltstring);
@ -1291,7 +1300,7 @@ is used to further constrain the set of candidates. */)
completion_ignore_case ? Qt : Qnil),
EQ (Qt, tem)))
{
/* Yes. */
/* Yes. */
Lisp_Object regexps;
/* Ignore this element if it fails to match all the regexps. */
@ -1313,7 +1322,7 @@ is used to further constrain the set of candidates. */)
}
/* Ignore this element if there is a predicate
and the predicate doesn't like it. */
and the predicate doesn't like it. */
if (!NILP (predicate))
{
@ -1415,7 +1424,7 @@ is used to further constrain the set of candidates. */)
}
if (NILP (bestmatch))
return Qnil; /* No completions found */
return Qnil; /* No completions found. */
/* If we are ignoring case, and there is no exact match,
and no additional text was supplied,
don't change the case of what the user typed. */
@ -1429,7 +1438,7 @@ is used to further constrain the set of candidates. */)
return Qt;
XSETFASTINT (zero, 0); /* Else extract the part in which */
XSETFASTINT (end, bestmatchsize); /* all completions agree */
XSETFASTINT (end, bestmatchsize); /* all completions agree. */
return Fsubstring (bestmatch, zero, end);
}
@ -1496,10 +1505,10 @@ with a space are ignored unless STRING itself starts with a space. */)
while (1)
{
/* Get the next element of the alist, obarray, or hash-table. */
/* Exit the loop if the elements are all used up. */
/* Get the next element of the alist, obarray, or hash-table. */
/* Exit the loop if the elements are all used up. */
/* elt gets the alist element or symbol.
eltstring gets the name to check as a completion. */
eltstring gets the name to check as a completion. */
if (type == 1)
{
@ -1541,7 +1550,7 @@ with a space are ignored unless STRING itself starts with a space. */)
elt = eltstring = HASH_KEY (XHASH_TABLE (collection), idx++);
}
/* Is this element a possible completion? */
/* Is this element a possible completion? */
if (SYMBOLP (eltstring))
eltstring = Fsymbol_name (eltstring);
@ -1561,7 +1570,7 @@ with a space are ignored unless STRING itself starts with a space. */)
completion_ignore_case ? Qt : Qnil),
EQ (Qt, tem)))
{
/* Yes. */
/* Yes. */
Lisp_Object regexps;
/* Ignore this element if it fails to match all the regexps. */
@ -1583,7 +1592,7 @@ with a space are ignored unless STRING itself starts with a space. */)
}
/* Ignore this element if there is a predicate
and the predicate doesn't like it. */
and the predicate doesn't like it. */
if (!NILP (predicate))
{
@ -1604,7 +1613,7 @@ with a space are ignored unless STRING itself starts with a space. */)
}
if (NILP (tem)) continue;
}
/* Ok => put it on the list. */
/* Ok => put it on the list. */
allmatches = Fcons (eltstring, allmatches);
}
}
@ -1810,9 +1819,9 @@ the values STRING, PREDICATE and `lambda'. */)
if (SYMBOLP (tail))
while (1)
{
if (EQ((Fcompare_strings (string, make_number (0), Qnil,
if (EQ (Fcompare_strings (string, make_number (0), Qnil,
Fsymbol_name (tail),
make_number (0) , Qnil, Qt)),
make_number (0) , Qnil, Qt),
Qt))
{
tem = tail;
@ -1836,11 +1845,11 @@ the values STRING, PREDICATE and `lambda'. */)
tem = HASH_KEY (h, i);
else
for (i = 0; i < HASH_TABLE_SIZE (h); ++i)
if (!NILP (HASH_HASH (h, i)) &&
EQ (Fcompare_strings (string, make_number (0), Qnil,
HASH_KEY (h, i), make_number (0) , Qnil,
completion_ignore_case ? Qt : Qnil),
Qt))
if (!NILP (HASH_HASH (h, i))
&& EQ (Fcompare_strings (string, make_number (0), Qnil,
HASH_KEY (h, i), make_number (0) , Qnil,
completion_ignore_case ? Qt : Qnil),
Qt))
{
tem = HASH_KEY (h, i);
break;
@ -1887,7 +1896,7 @@ If the argument FLAG is nil, invoke `try-completion', if it's t, invoke
`all-completions', otherwise invoke `test-completion'.
The arguments STRING and PREDICATE are as in `try-completion',
`all-completions', and `test-completion'. */)
`all-completions', and `test-completion'. */)
(Lisp_Object string, Lisp_Object predicate, Lisp_Object flag)
{
if (NILP (flag))