summaryrefslogtreecommitdiff
path: root/lisp
diff options
context:
space:
mode:
authorTom Tromey <tromey@redhat.com>2013-07-26 14:02:53 -0600
committerTom Tromey <tromey@redhat.com>2013-07-26 14:02:53 -0600
commitcc231cbe45d27a1906d268fb72d3b4105a2e9c65 (patch)
treec011828e2a3a18e77eaa8849e3cccb805d798f42 /lisp
parentb34a529f177a6ea32da5cb1254f91bf9d71838db (diff)
parentfec9206062b420aca84f53d05a72c3ee43244022 (diff)
downloademacs-cc231cbe45d27a1906d268fb72d3b4105a2e9c65.tar.gz
merge from trunk
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog464
-rw-r--r--lisp/ChangeLog.104
-rw-r--r--lisp/ChangeLog.152
-rw-r--r--lisp/ChangeLog.164
-rw-r--r--lisp/ChangeLog.74
-rw-r--r--lisp/Makefile.in3
-rw-r--r--lisp/align.el39
-rw-r--r--lisp/ansi-color.el10
-rw-r--r--lisp/autorevert.el17
-rw-r--r--lisp/bookmark.el15
-rw-r--r--lisp/cedet/semantic/bovine/el.el2
-rw-r--r--lisp/desktop.el689
-rw-r--r--lisp/dired-x.el28
-rw-r--r--lisp/dired.el2
-rw-r--r--lisp/dos-w32.el21
-rw-r--r--lisp/edmacro.el3
-rw-r--r--lisp/emacs-lisp/autoload.el65
-rw-r--r--lisp/emacs-lisp/debug.el145
-rw-r--r--lisp/emacs-lisp/edebug.el210
-rw-r--r--lisp/emacs-lisp/nadvice.el2
-rw-r--r--lisp/emacs-lisp/package.el2
-rw-r--r--lisp/emacs-lisp/pcase.el14
-rw-r--r--lisp/epa-mail.el191
-rw-r--r--lisp/epa.el15
-rw-r--r--lisp/ffap.el3
-rw-r--r--lisp/filenotify.el32
-rw-r--r--lisp/files.el224
-rw-r--r--lisp/frame.el44
-rw-r--r--lisp/gnus/ChangeLog46
-rw-r--r--lisp/gnus/ChangeLog.12
-rw-r--r--lisp/gnus/ChangeLog.24
-rw-r--r--lisp/gnus/gnus-art.el19
-rw-r--r--lisp/gnus/gnus-msg.el4
-rw-r--r--lisp/gnus/gnus-start.el20
-rw-r--r--lisp/gnus/gnus-sum.el2
-rw-r--r--lisp/gnus/gnus.el4
-rw-r--r--lisp/gnus/registry.el2
-rw-r--r--lisp/ido.el75
-rw-r--r--lisp/image-dired.el50
-rw-r--r--lisp/international/mule.el40
-rw-r--r--lisp/lpr.el116
-rw-r--r--lisp/mail/mailalias.el4
-rw-r--r--lisp/mh-e/ChangeLog.134
-rw-r--r--lisp/net/eww.el2
-rw-r--r--lisp/net/shr.el14
-rw-r--r--lisp/net/tramp-adb.el2
-rw-r--r--lisp/net/tramp-compat.el4
-rw-r--r--lisp/net/tramp-gvfs.el2
-rw-r--r--lisp/net/tramp-sh.el3
-rw-r--r--lisp/net/tramp-smb.el2
-rw-r--r--lisp/net/tramp.el17
-rw-r--r--lisp/org/ChangeLog6
-rw-r--r--lisp/org/org-freemind.el2
-rw-r--r--lisp/printing.el48
-rw-r--r--lisp/progmodes/cc-engine.el32
-rw-r--r--lisp/progmodes/gdb-mi.el13
-rw-r--r--lisp/progmodes/python.el9
-rw-r--r--lisp/progmodes/ruby-mode.el46
-rw-r--r--lisp/progmodes/sh-script.el1
-rw-r--r--lisp/progmodes/sql.el91
-rw-r--r--lisp/progmodes/subword.el12
-rw-r--r--lisp/ps-mule.el1
-rw-r--r--lisp/ps-print.el138
-rw-r--r--lisp/shell.el18
-rw-r--r--lisp/simple.el44
-rw-r--r--lisp/subr.el102
-rw-r--r--lisp/url/ChangeLog12
-rw-r--r--lisp/url/url-http.el282
-rw-r--r--lisp/vc/vc-dir.el1
-rw-r--r--lisp/window.el3
-rw-r--r--lisp/winner.el17
71 files changed, 2181 insertions, 1419 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 81bcb1d033c..65bbc8a305b 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,451 @@
+2013-07-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/nadvice.el (advice--called-interactively-skip): Use the new
+ `base' arg of backtrace-frame.
+
+2013-07-26 Eli Zaretskii <eliz@gnu.org>
+
+ * simple.el (list-processes): Doc fix.
+
+2013-07-26 Juanma Barranquero <lekktu@gmail.com>
+
+ * desktop.el (desktop--select-frame):
+ Try harder to reuse the initial frame.
+
+2013-07-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/edebug.el: Use backtrace-eval to handle lexical variables.
+ (edebug-eval): Use backtrace-eval.
+ (edebug--display, edebug--recursive-edit): Don't let-bind the
+ edebug-outer-* vars that keep track of variables we locally let-bind.
+ (edebug-outside-excursion): Don't restore outside values of locally
+ let-bound vars.
+ (edebug--display): Use user-error.
+ (cl-lexical-debug, cl-debug-env): Remove.
+
+2013-07-26 Juanma Barranquero <lekktu@gmail.com>
+
+ * desktop.el (desktop-restore-frames): Call `sit-for' once all frames
+ are restored to be sure that they are visible before deleting any
+ remaining ones.
+
+2013-07-26 Matthias Meulien <orontee@gmail.com>
+
+ * vc/vc-dir.el (vc-dir-mode-map): Add binding for vc-print-root-log.
+
+2013-07-26 Richard Stallman <rms@gnu.org>
+
+ Add aliases for encrypting mail.
+ * epa.el (epa-mail-aliases): New option.
+ * epa-mail.el (epa-mail-encrypt): Rewrite to be callable from programs.
+ Bind inhibit-read-only so read-only text doesn't ruin everything.
+ (epa-mail-default-recipients): New subroutine broken out.
+ Handle epa-mail-aliases.
+
+2013-07-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Add support for lexical variables to the debugger's `e' command.
+ * emacs-lisp/debug.el (debug): Don't let-bind the debugger-outer-*
+ vars, except for debugger-outer-match-data.
+ (debugger-frame-number): Move check for "on a function call" from
+ callers into it. Add `skip-base' argument.
+ (debugger-frame, debugger-frame-clear): Simplify accordingly.
+ (debugger-env-macro): Only reset the state stored in non-variables,
+ i.e. current-buffer and match-data.
+ (debugger-eval-expression): Rewrite using backtrace-eval.
+ * subr.el (internal--called-interactively-p--get-frame): Remove.
+ (called-interactively-p):
+ * emacs-lisp/edebug.el (edebug--called-interactively-skip): Use the new
+ `base' arg of backtrace-frame instead.
+
+2013-07-26 Glenn Morris <rgm@gnu.org>
+
+ * align.el (align-regexp): Doc fix. (Bug#14857)
+ (align-region): Explicit error if subexpression missing/does not match.
+
+ * simple.el (global-visual-line-mode):
+ Do not duplicate the mode lighter. (Bug#14858)
+
+2013-07-25 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (display-buffer): In display-buffer bind
+ split-window-keep-point to t, bug#14829.
+
+2013-07-25 Juanma Barranquero <lekktu@gmail.com>
+
+ * desktop.el: Rename internal "desktop-X" frame params to "desktop--X".
+ (desktop-filter-parameters-alist, desktop--filter-restore-desktop-parm)
+ (desktop--filter-save-desktop-parm, desktop--process-minibuffer-frames)
+ (desktop--select-frame, desktop--sort-states, desktop-restore-frames):
+ Change accordingly.
+ (desktop--select-frame, desktop--sort-states, desktop-restore-frames):
+ Use pcase-let, pcase-let* to deobfuscate access to desktop--mini values.
+
+2013-07-25 Glenn Morris <rgm@gnu.org>
+
+ * dired-x.el (dired-mark-extension): Convert comment to doc string.
+
+2013-07-25 Juanma Barranquero <lekktu@gmail.com>
+
+ * desktop.el (desktop--make-frame): Do not pass the `fullscreen'
+ parameter to modify-frame-parameters if the value has not changed;
+ this is a workaround for bug#14949.
+ (desktop--make-frame): On cl-delete-if call, check parameter name,
+ not full parameter.
+
+2013-07-24 Juanma Barranquero <lekktu@gmail.com>
+
+ * desktop.el (desktop-restoring-frames-p): Return a true boolean.
+ (desktop-restore-frames): Warn when deleting an existing frame failed.
+
+2013-07-24 Glenn Morris <rgm@gnu.org>
+
+ * ffap.el (ffap-machine-p): Handle "not known" response. (Bug#14929)
+
+2013-07-24 Michael Albinus <michael.albinus@gmx.de>
+
+ * filenotify.el (file-notify-supported-p):
+ * net/tramp-sh.el (tramp-sh-handle-file-notify-supported-p):
+ Remove functions.
+
+ * autorevert.el (auto-revert-use-notify):
+ (auto-revert-notify-add-watch):
+ * net/tramp.el (tramp-file-name-for-operation):
+ * net/tramp-adb.el (tramp-adb-file-name-handler-alist):
+ * net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist):
+ * net/tramp-sh.el (tramp-sh-file-name-handler-alist):
+ * net/tramp-smb.el (tramp-smb-file-name-handler-alist):
+ Remove `file-notify-supported-p' entry.
+
+2013-07-24 Glenn Morris <rgm@gnu.org>
+
+ * printing.el: Replace all uses of deleted ps-windows-system,
+ ps-lp-system, ps-flatten-list with lpr- versions.
+
+2013-07-24 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/pcase.el (pcase--u1): Verify if self-quoting values can be
+ checked with memq (bug#14935).
+
+ * files.el (revert-buffer-function): Use a non-nil default.
+ (revert-buffer-preserve-modes): Declare var to
+ provide access to the `preserve-modes' argument.
+ (revert-buffer): Let-bind it.
+ (revert-buffer--default): New function, extracted from revert-buffer.
+
+2013-07-24 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lpr.el: Signal print errors more prominently.
+ (print-region-function): Don't default to nil.
+ (lpr-print-region): New function, extracted from print-region-1.
+ Check lpr's return value and signal an error in case of problem.
+ (print-region-1): Use it.
+ * ps-print.el (ps-windows-system, ps-lp-system): Remove. Use the lpr-*
+ versions instead.
+ (ps-printer-name): Default to nil.
+ (ps-printer-name-option): Default to lpr-printer-switch.
+ (ps-print-region-function): Don't default to nil.
+ (ps-postscript-code-directory): Simplify default.
+ (ps-do-despool): Use lpr-print-region to properly check the outcome.
+ (ps-string-list, ps-eval-switch, ps-flatten-list)
+ (ps-flatten-list-1): Remove.
+ (ps-multibyte-buffer): Avoid setq.
+ * dos-w32.el (direct-print-region-helper): Use proper regexp operators.
+ (print-region-function, ps-print-region-function): Don't set them here.
+
+2013-07-24 Xue Fuqiao <xfq.free@gmail.com>
+
+ * ido.el (ido-fractionp):
+ (ido-cache-ftp-work-directory-time, ido-max-prospects, ido-mode)
+ (ido-max-file-prompt-width, ido-unc-hosts-cache)
+ (ido-max-directory-size, ido-max-dir-file-cache)
+ (ido-decorations): Doc fix.
+
+ * ansi-color.el: Fix old URL.
+
+2013-07-23 Michael R. Mauger <michael@mauger.com>
+
+ * progmodes/sql.el Version 3.3
+ (sql-product-alist): Improve oracle :prompt-cont-regexp.
+ (sql-starts-with-prompt-re, sql-ends-with-prompt-re): New functions.
+ (sql-interactive-remove-continuation-prompt): Rewrite, use
+ functions above. Fix continuation prompt and complete output line
+ handling.
+ (sql-redirect-one, sql-execute): Use `read-only-mode' on
+ redirected output buffer.
+ (sql-mode): Restore deleted code (Bug#13591).
+
+2013-07-23 Juanma Barranquero <lekktu@gmail.com>
+
+ * desktop.el (desktop-clear, desktop-list*): Fix previous change.
+
+2013-07-23 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-handle-file-notify-add-watch): New defun.
+
+ * net/tramp-adb.el (tramp-adb-file-name-handler-alist):
+ * net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist):
+ * net/tramp-smb.el (tramp-smb-file-name-handler-alist): Use it.
+
+2013-07-23 Juanma Barranquero <lekktu@gmail.com>
+
+ * desktop.el (desktop-clear): Simplify; remove useless checks
+ against invalid buffer names.
+ (desktop-list*): Use cl-list*.
+ (desktop-buffer-info, desktop-create-buffer): Simplify.
+
+2013-07-23 Leo Liu <sdl.web@gmail.com>
+
+ * bookmark.el (bookmark-make-record): Restore NAME as a default
+ value. (Bug#14933)
+
+2013-07-22 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/autoload.el (autoload--setup-output): New function,
+ extracted from autoload--insert-text.
+ (autoload--insert-text): Remove.
+ (autoload--print-cookie-text): New function, extracted from
+ autoload--insert-cookie-text.
+ (autoload--insert-cookie-text): Remove.
+ (autoload-generate-file-autoloads): Adjust calls accordingly.
+
+ * winner.el (winner-hook-installed-p): Remove.
+ (winner-mode): Simplify accordingly.
+
+ * subr.el (add-to-list): Fix compiler-macro when `append' is
+ not constant. Don't use `cl-member' for the base case.
+
+ * progmodes/subword.el: Fix boundary case (bug#13758).
+ (subword-forward-regexp): Make it a constant. Wrap optional \\W in its
+ own group.
+ (subword-backward-regexp): Make it a constant.
+ (subword-forward-internal): Don't treat a trailing capital as the
+ beginning of a word.
+
+2013-07-22 Ari Roponen <ari.roponen@gmail.com> (tiny change)
+
+ * emacs-lisp/package.el (package-menu-mode): Don't modify the
+ global value of tabulated-list-revert-hook (bug#14930).
+
+2013-07-22 Juanma Barranquero <lekktu@gmail.com>
+
+ * desktop.el: Require 'cl-lib.
+ (desktop-before-saving-frames-functions): New hook.
+ (desktop--process-minibuffer-frames): Set desktop-mini parameter only
+ for frames being saved. Rename from desktop--save-minibuffer-frames.
+ (desktop-save-frames): Run hook desktop-before-saving-frames-functions.
+ Do not save frames with non-nil `desktop-dont-save' parameter.
+ Filter out deleted frames.
+ (desktop--find-frame): Use cl-find-if.
+ (desktop--select-frame): Use cl-(first|second|third) to access values
+ of desktop-mini.
+ (desktop--make-frame): Use cl-delete-if.
+ (desktop--sort-states): Fix sorting of minibuffer-owning frames.
+ (desktop-restore-frames): Use cl-(first|second|third) to access values
+ of desktop-mini. Look for visible frame at the end, not while
+ restoring frames.
+
+ * dired-x.el (dired-mark-unmarked-files, dired-virtual)
+ (dired-guess-default, dired-mark-sexp, dired-filename-at-point):
+ Use string-match-p, looking-at-p (bug#14927).
+
+2013-07-21 Juanma Barranquero <lekktu@gmail.com>
+
+ * desktop.el (desktop-saved-frame-states):
+ Rename from desktop--saved-states; all users changed.
+ (desktop-save-frames): Rename from desktop--save-frames.
+ Do not save state to desktop file.
+ (desktop-save): Save desktop-saved-frame-states to desktop file
+ and reset to nil.
+ (desktop-restoring-frames-p): New function.
+ (desktop-restore-frames): Use it. Rename from desktop--restore-frames.
+ (desktop-read): Use desktop-restoring-frames-p. Do not try to fix
+ buffer-lists when restoring frames. Suggested by Martin Rudalics.
+
+ * desktop.el: Correctly restore iconified frames.
+ (desktop--filter-iconified-position): New function.
+ (desktop-filter-parameters-alist): Add entries for `top' and `left'.
+
+2013-07-20 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/gdb-mi.el (gdb-delete-handler, gdb-stopped):
+ Let `message' do the formatting.
+ (def-gdb-preempt-display-buffer): Add explicit format.
+
+ * image-dired.el (image-dired-track-original-file):
+ Use with-current-buffer.
+ (image-dired-track-thumbnail): Use with-current-buffer.
+ Avoid changing point of wrong window.
+
+ * image-dired.el (image-dired-track-original-file):
+ Avoid changing point of wrong window. (Bug#14909)
+
+2013-07-20 Richard Copley <rcopley@gmail.com> (tiny change)
+
+ * progmodes/gdb-mi.el (gdb-done-or-error):
+ Guard against "%" in gdb output. (Bug#14127)
+
+2013-07-20 Andreas Schwab <schwab@linux-m68k.org>
+
+ * progmodes/sh-script.el (sh-read-variable): Remove interactive spec.
+ (Bug#14826)
+
+ * international/mule.el (coding-system-iso-2022-flags): Fix last
+ change.
+
+2013-07-20 Kenichi Handa <handa@gnu.org>
+
+ * international/mule.el (coding-system-iso-2022-flags):
+ Add `8-bit-level-4'. (Bug#8522)
+
+2013-07-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/shr.el (shr-mouse-browse-url): New command and keystroke
+ (bug#14815).
+
+ * net/eww.el (eww-process-text-input): Allow inputting when the
+ point is at the start of the line, as the properties aren't
+ front-sticky.
+
+ * net/shr.el (shr-make-table-1): Ensure that we don't infloop on
+ degenerate widths.
+
+2013-07-19 Richard Stallman <rms@gnu.org>
+
+ * epa.el (epa-popup-info-window): Doc fix.
+
+ * subr.el (split-string): New arg TRIM.
+
+2013-07-18 Juanma Barranquero <lekktu@gmail.com>
+
+ * frame.el (blink-cursor-timer-function, blink-cursor-suspend):
+ Add check for W32 (followup to 2013-07-16T11:41:06Z!jan.h.d@swipnet.se).
+
+2013-07-18 Michael Albinus <michael.albinus@gmx.de>
+
+ * filenotify.el (file-notify--library): Rename from
+ `file-notify-support'. Do not autoload. Adapt all uses.
+ (file-notify-supported-p): New defun.
+
+ * autorevert.el (auto-revert-use-notify):
+ Use `file-notify-supported-p' instead of `file-notify-support'.
+ Adapt docstring.
+ (auto-revert-notify-add-watch): Use `file-notify-supported-p'.
+
+ * net/tramp.el (tramp-file-name-for-operation):
+ Add `file-notify-supported-p'.
+
+ * net/tramp-sh.el (tramp-sh-handle-file-notify-supported-p):
+ New defun.
+ (tramp-sh-file-name-handler-alist): Add it as handler for
+ `file-notify-supported-p '.
+
+ * net/tramp-adb.el (tramp-adb-file-name-handler-alist):
+ * net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist):
+ * net/tramp-smb.el (tramp-smb-file-name-handler-alist):
+ Add `ignore' as handler for `file-notify-*' functions.
+
+2013-07-17 Eli Zaretskii <eliz@gnu.org>
+
+ * simple.el (line-move-partial, line-move): Don't start vscroll or
+ scroll-up if the current line is not taller than the window.
+ (Bug#14881)
+
+2013-07-16 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-font-lock-keywords): Do not
+ highlight question marks in the method names as strings.
+ (ruby-block-beg-keywords): Inline.
+ (ruby-font-lock-keyword-beg-re): Extract from
+ `ruby-font-lock-keywords'.
+
+2013-07-16 Jan Djärv <jan.h.d@swipnet.se>
+
+ * frame.el (blink-cursor-blinks): New defcustom.
+ (blink-cursor-blinks-done): New defvar.
+ (blink-cursor-start): Set blink-cursor-blinks-done to 1.
+ (blink-cursor-timer-function): Check if number of blinks has been
+ done on X and NS.
+ (blink-cursor-suspend, blink-cursor-check): New defuns.
+
+2013-07-15 Glenn Morris <rgm@gnu.org>
+
+ * edmacro.el (edmacro-format-keys): Fix previous change.
+
+2013-07-15 Paul Eggert <eggert@cs.ucla.edu>
+
+ * shell.el (explicit-bash-args): Remove obsolete hack for Bash 1.x.
+ The hack didn't work outside English locales anyway.
+
+2013-07-15 Juanma Barranquero <lekktu@gmail.com>
+
+ * simple.el (define-alternatives): Rename from alternatives-define,
+ per RMS' suggestion.
+
+2013-07-14 Juanma Barranquero <lekktu@gmail.com>
+
+ * desktop.el (desktop-restore-frames): Change default to t.
+ (desktop-restore-in-current-display): Now offer more options.
+ (desktop-restoring-reuses-frames): New customization option.
+ (desktop--saved-states): Doc fix.
+ (desktop-filter-parameters-alist): New variable, renamed and expanded
+ from desktop--excluded-frame-parameters.
+ (desktop--target-display): New variable.
+ (desktop-switch-to-gui-p, desktop-switch-to-tty-p)
+ (desktop--filter-tty*, desktop--filter-*-color)
+ (desktop--filter-minibuffer, desktop--filter-restore-desktop-parm)
+ (desktop--filter-save-desktop-parm)
+ (desktop-restore-in-original-display-p): New functions.
+ (desktop--filter-frame-parms): Use new desktop-filter-parameters-alist.
+ (desktop--save-minibuffer-frames): New function, inspired by a similar
+ function from Martin Rudalics.
+ (desktop--save-frames): Call it; play nice with desktop-globals-to-save.
+ (desktop--restore-in-this-display-p): Remove.
+ (desktop--find-frame): Rename from desktop--find-frame-in-display
+ and add predicate argument.
+ (desktop--make-full-frame): Remove, integrated into desktop--make-frame.
+ (desktop--reuse-list): New variable.
+ (desktop--select-frame, desktop--make-frame, desktop--sort-states):
+ New functions.
+ (desktop--restore-frames): Add support for "minibuffer-special" frames.
+
+2013-07-14 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-sh-handle-vc-registered): Use `ignore-error'.
+
+2013-07-13 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-font-lock-keywords):
+ Highlight conversion methods on Kernel.
+
+2013-07-13 Alan Mackenzie <acm@muc.de>
+
+ * progmodes/cc-engine.el (c-forward-decl-or-cast-1): Label CASE 13
+ and comment it out. This out-commenting enables certain C++
+ declarations to be parsed correctly.
+
+2013-07-13 Eli Zaretskii <eliz@gnu.org>
+
+ * international/mule.el (define-coding-system): Doc fix.
+
+ * simple.el (default-font-height): Don't call font-info if the
+ frame's default font didn't change since the frame was created.
+ (Bug#14838)
+
+2013-07-13 Leo Liu <sdl.web@gmail.com>
+
+ * ido.el (ido-read-file-name): Guard against non-symbol value.
+
+2013-07-13 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * progmodes/python.el (python-imenu--build-tree): Fix corner case
+ in nested defuns.
+
+2013-07-13 Leo Liu <sdl.web@gmail.com>
+
+ * ido.el (ido-exhibit): Handle ido-enter-matching-directory before
+ ido-set-matches call. (Bug#6852)
+
2013-07-12 Dmitry Gutov <dgutov@yandex.ru>
* progmodes/ruby-mode.el (ruby-percent-literals-beg-re):
@@ -128,17 +576,17 @@
* net/tramp.el (tramp-current-connection): New defvar, moved from
tramp-sh.el.
- (tramp-message-show-progress-reporter-message): Removed, not
+ (tramp-message-show-progress-reporter-message): Remove, not
needed anymore.
- (tramp-error-with-buffer): Show message in minibuffer. Discard
- input before waiting. Reset connection timestamp.
+ (tramp-error-with-buffer): Show message in minibuffer.
+ Discard input before waiting. Reset connection timestamp.
(with-tramp-progress-reporter): Improve messages.
(tramp-process-actions): Use progress reporter. Delete process in
case of error. Improve messages.
- * net/tramp-sh.el (tramp-barf-if-no-shell-prompt): Use
- condition-case. Call `tramp-error-with-buffer' with vector and buffer.
- (tramp-current-connection): Removed.
+ * net/tramp-sh.el (tramp-barf-if-no-shell-prompt): Use condition-case.
+ Call `tramp-error-with-buffer' with vector and buffer.
+ (tramp-current-connection): Remove.
(tramp-maybe-open-connection): The car of
`tramp-current-connection' are the first 3 slots of the vector.
@@ -3442,8 +3890,8 @@
(prolog-char-quote-workaround):
* progmodes/cperl-mode.el (cperl-under-as-char):
* progmodes/vhdl-mode.el (vhdl-underscore-is-part-of-word):
- Mark as obsolete.
- (vhdl-mode-syntax-table, vhdl-mode-ext-syntax-table): Initialize in
+ Mark as obsolete.
+ (vhdl-mode-syntax-table, vhdl-mode-ext-syntax-table): Initialize in
their declaration.
(vhdl-mode-syntax-table-init): Remove.
diff --git a/lisp/ChangeLog.10 b/lisp/ChangeLog.10
index 2d331a2819d..30afe9ce970 100644
--- a/lisp/ChangeLog.10
+++ b/lisp/ChangeLog.10
@@ -5182,7 +5182,7 @@
inserted.
(Info-hide-note-references): Fix doc and customize type.
-2003-03-02 Matt Swift <swift@alum.mit.edu>
+2003-03-02 Matthew Swift <swift@alum.mit.edu>
* emacs-lisp/lisp-mode.el (emacs-lisp-docstring-fill-column):
New custom variable.
@@ -5228,7 +5228,7 @@
(tramp-send-region): Correct debug message.
(tramp-bug): Add `tramp-chunksize'.
-2003-02-26 Matt Swift <swift@alum.mit.edu>
+2003-02-26 Matthew Swift <swift@alum.mit.edu>
* startup.el: Streamline code in several functions for efficiency
and readability. Rephrase booleans to avoid `(not noninteractive)'.
diff --git a/lisp/ChangeLog.15 b/lisp/ChangeLog.15
index 4d0ff9a40e2..afa2bce104e 100644
--- a/lisp/ChangeLog.15
+++ b/lisp/ChangeLog.15
@@ -5119,7 +5119,7 @@
(x-setup-function-keys, xw-defined-colors): Merge x- and w32-
definitions here.
-2010-10-24 T.V. Raman <tv.raman.tv@gmail.com> (tiny change)
+2010-10-24 T. V. Raman <tv.raman.tv@gmail.com> (tiny change)
* net/mairix.el (mairix-searches-mode-map):
* mail/mspools.el (mspools-mode-map): Fix 2010-10-10 change.
diff --git a/lisp/ChangeLog.16 b/lisp/ChangeLog.16
index d6d1bac43c2..7692a0fffa8 100644
--- a/lisp/ChangeLog.16
+++ b/lisp/ChangeLog.16
@@ -4569,7 +4569,7 @@
* bookmark.el (bookmark-completing-read): Set the completion category
to `bookmark' (bug#11131).
-2012-10-26 Bastien <bzg@altern.org>
+2012-10-26 Bastien Guerry <bzg@altern.org>
Stefan Monnier <monnier@iro.umontreal.ca>
* face-remap.el: Use lexical-binding.
@@ -9712,7 +9712,7 @@
* international/mule-cmds.el (mule-menu-keymap)
(set-language-environment, set-locale-environment): Doc tweaks.
-2012-06-16 Aurelien Aptel <aurelien.aptel@gmail.com>
+2012-06-16 Aurélien Aptel <aurelien.aptel@gmail.com>
* cus-face.el (custom-face-attributes): Add wave-style underline
attribute.
diff --git a/lisp/ChangeLog.7 b/lisp/ChangeLog.7
index 4eec1795789..f52fdd7e194 100644
--- a/lisp/ChangeLog.7
+++ b/lisp/ChangeLog.7
@@ -7617,7 +7617,7 @@
Delete the binding for toggle-enable-multibyte-characters.
(mule-menu-keymap): Delete the menu item for it.
-1997-12-17 Peter Galbraith <galbraith@mixing.qc.dfo.ca>
+1997-12-17 Peter S Galbraith <galbraith@mixing.qc.dfo.ca>
* simple.el (copy-region-as-kill):
Deactivate mark in transient-mark-mode.
@@ -19637,7 +19637,7 @@
* term/x-win.el (function-key-map): Define iso-lefttab.
-1997-03-24 Vince Del Vecchio <vdelvecc@spd.analog.com>
+1997-03-24 Vincent Del Vecchio <vdelvecc@spd.analog.com>
* mh-utils.el (mh-find-progs): When looking for mh-lib, construct
likely paths based on mh-progs rather than using a static list.
diff --git a/lisp/Makefile.in b/lisp/Makefile.in
index f93f2d32ef4..066e15368da 100644
--- a/lisp/Makefile.in
+++ b/lisp/Makefile.in
@@ -1,4 +1,5 @@
-# Maintenance productions for the Lisp directory
+### @configure_input@
+
# Copyright (C) 2000-2013 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
diff --git a/lisp/align.el b/lisp/align.el
index 1b62042be75..3d2ca192245 100644
--- a/lisp/align.el
+++ b/lisp/align.el
@@ -906,15 +906,8 @@ on the format of these lists."
;;;###autoload
(defun align-regexp (beg end regexp &optional group spacing repeat)
"Align the current region using an ad-hoc rule read from the minibuffer.
-BEG and END mark the limits of the region. This function will prompt
-for the REGEXP to align with. If no prefix arg was specified, you
-only need to supply the characters to be lined up and any preceding
-whitespace is replaced. If a prefix arg was specified, the full
-regexp with parenthesized whitespace should be supplied; it will also
-prompt for which parenthesis GROUP within REGEXP to modify, the amount
-of SPACING to use, and whether or not to REPEAT the rule throughout
-the line. See `align-rules-list' for more information about these
-options.
+BEG and END mark the limits of the region. Interactively, this function
+prompts for the regular expression REGEXP to align with.
For example, let's say you had a list of phone numbers, and wanted to
align them so that the opening parentheses would line up:
@@ -925,8 +918,29 @@ align them so that the opening parentheses would line up:
Joe (123) 456-7890
There is no predefined rule to handle this, but you could easily do it
-using a REGEXP like \"(\". All you would have to do is to mark the
-region, call `align-regexp' and type in that regular expression."
+using a REGEXP like \"(\". Interactively, all you would have to do is
+to mark the region, call `align-regexp' and enter that regular expression.
+
+REGEXP must contain at least one parenthesized subexpression, typically
+whitespace of the form \"\\\\(\\\\s-*\\\\)\". In normal interactive use,
+this is automatically added to the start of your regular expression after
+you enter it. You only need to supply the characters to be lined up, and
+any preceding whitespace is replaced.
+
+If you specify a prefix argument (or use this function non-interactively),
+you must enter the full regular expression, including the subexpression.
+The function also then prompts for which subexpression parenthesis GROUP
+\(default 1) within REGEXP to modify, the amount of SPACING (default
+`align-default-spacing') to use, and whether or not to REPEAT the rule
+throughout the line.
+
+See `align-rules-list' for more information about these options.
+
+The non-interactive form of the previous example would look something like:
+ \(align-regexp (point-min) (point-max) \"\\\\(\\\\s-*\\\\)(\")
+
+This function is a nothing more than a small wrapper that helps you
+construct a rule to pass to `align-region', which does the real work."
(interactive
(append
(list (region-beginning) (region-end))
@@ -1498,6 +1512,9 @@ aligner would have dealt with are."
(setq rule-beg (match-beginning first)
save-match-data (match-data))
+ (or rule-beg
+ (error "No match for subexpression %s" first))
+
;; unless the `valid' attribute is set, and tells
;; us that the rule is not valid at this point in
;; the code..
diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el
index bbe44f9b20b..105352117b7 100644
--- a/lisp/ansi-color.el
+++ b/lisp/ansi-color.el
@@ -40,11 +40,11 @@
;;
;; SGR control sequences are defined in section 3.8.117 of the ECMA-48
;; standard (identical to ISO/IEC 6429), which is freely available as a
-;; PDF file <URL:http://www.ecma.ch/ecma1/STAND/ECMA-048.HTM>. The
-;; "Graphic Rendition Combination Mode (GRCM)" implemented is
-;; "cumulative mode" as defined in section 7.2.8. Cumulative mode means
-;; that whenever possible, SGR control sequences are combined (ie. blue
-;; and bold).
+;; PDF file <URL:http://www.ecma-international.org/publications/standards/Ecma-048.htm>.
+;; The "Graphic Rendition Combination Mode (GRCM)" implemented is
+;; "cumulative mode" as defined in section 7.2.8. Cumulative mode
+;; means that whenever possible, SGR control sequences are combined
+;; (ie. blue and bold).
;; The basic functions are:
;;
diff --git a/lisp/autorevert.el b/lisp/autorevert.el
index 00e88fc4a3d..1617a31cd82 100644
--- a/lisp/autorevert.el
+++ b/lisp/autorevert.el
@@ -271,21 +271,18 @@ This variable becomes buffer local when set in any fashion.")
:type 'boolean
:version "24.4")
-(defcustom auto-revert-use-notify (and file-notify-support t)
+(defcustom auto-revert-use-notify t
"If non-nil Auto Revert Mode uses file notification functions.
-This requires Emacs being compiled with file notification
-support (see `file-notify-support'). You should set this variable
-through Custom."
+You should set this variable through Custom."
:group 'auto-revert
:type 'boolean
:set (lambda (variable value)
- (set-default variable (and file-notify-support value))
+ (set-default variable value)
(unless (symbol-value variable)
- (when file-notify-support
- (dolist (buf (buffer-list))
- (with-current-buffer buf
- (when (symbol-value 'auto-revert-notify-watch-descriptor)
- (auto-revert-notify-rm-watch)))))))
+ (dolist (buf (buffer-list))
+ (with-current-buffer buf
+ (when (symbol-value 'auto-revert-notify-watch-descriptor)
+ (auto-revert-notify-rm-watch))))))
:initialize 'custom-initialize-default
:version "24.4")
diff --git a/lisp/bookmark.el b/lisp/bookmark.el
index cab81c3b135..b1cdedb83c5 100644
--- a/lisp/bookmark.el
+++ b/lisp/bookmark.el
@@ -481,19 +481,18 @@ equivalently just return ALIST without NAME.")
(defun bookmark-make-record ()
"Return a new bookmark record (NAME . ALIST) for the current location."
(let ((record (funcall bookmark-make-record-function)))
+ ;; Set up default name if the function does not provide one.
+ (unless (stringp (car record))
+ (if (car record) (push nil record))
+ (setcar record (or bookmark-current-bookmark (bookmark-buffer-name))))
;; Set up defaults.
(bookmark-prop-set
record 'defaults
(delq nil (delete-dups (append (bookmark-prop-get record 'defaults)
(list bookmark-current-bookmark
- (bookmark-buffer-name))))))
- ;; Set up default name.
- (if (stringp (car record))
- ;; The function already provided a default name.
- record
- (if (car record) (push nil record))
- (setcar record (or bookmark-current-bookmark (bookmark-buffer-name)))
- record)))
+ (car record)
+ (bookmark-buffer-name))))))
+ record))
(defun bookmark-store (name alist no-overwrite)
"Store the bookmark NAME with data ALIST.
diff --git a/lisp/cedet/semantic/bovine/el.el b/lisp/cedet/semantic/bovine/el.el
index 07e0e08bbaf..0bbe3c61d76 100644
--- a/lisp/cedet/semantic/bovine/el.el
+++ b/lisp/cedet/semantic/bovine/el.el
@@ -474,7 +474,7 @@ Return a bovination list to use."
((and name (file-exists-p (concat name ".el.gz")))
;; This is the linux distro case.
(concat name ".el.gz"))
- ;; source file does not exists
+ ;; Source file does not exist.
(name
(message "semantic: cannot find source file %s" (concat name ".el")))
(t
diff --git a/lisp/desktop.el b/lisp/desktop.el
index 322b95715a2..d5895a8de57 100644
--- a/lisp/desktop.el
+++ b/lisp/desktop.el
@@ -33,6 +33,7 @@
;; - the mark & mark-active
;; - buffer-read-only
;; - some local variables
+;; - frame and window configuration
;; To use this, use customize to turn on desktop-save-mode or add the
;; following line somewhere in your init file:
@@ -127,12 +128,13 @@
;; ---------------------------------------------------------------------------
;; TODO:
;;
-;; Save window configuration.
;; Recognize more minor modes.
;; Save mark rings.
;;; Code:
+(require 'cl-lib)
+
(defvar desktop-file-version "206"
"Version number of desktop file format.
Written into the desktop file and used at desktop read to provide
@@ -369,16 +371,36 @@ modes are restored automatically; they should not be listed here."
:type '(repeat symbol)
:group 'desktop)
-(defcustom desktop-restore-frames nil
+(defcustom desktop-restore-frames t
"When non-nil, save window/frame configuration to desktop file."
:type 'boolean
:group 'desktop
:version "24.4")
(defcustom desktop-restore-in-current-display nil
- "When non-nil, frames are restored in the current display.
-Otherwise they are restored, if possible, in their original displays."
- :type 'boolean
+ "If t, frames are restored in the current display.
+If nil, frames are restored, if possible, in their original displays.
+If `delete', frames on other displays are deleted instead of restored."
+ :type '(choice (const :tag "Restore in current display" t)
+ (const :tag "Restore in original display" nil)
+ (const :tag "Delete frames in other displays" 'delete))
+ :group 'desktop
+ :version "24.4")
+
+(defcustom desktop-restoring-reuses-frames t
+ "If t, restoring frames reuses existing frames.
+If nil, existing frames are deleted.
+If `keep', existing frames are kept and not reused."
+ :type '(choice (const :tag "Reuse existing frames" t)
+ (const :tag "Delete existing frames" nil)
+ (const :tag "Keep existing frames" 'keep))
+ :group 'desktop
+ :version "24.4")
+
+(defcustom desktop-before-saving-frames-functions nil
+ "Abnormal hook run before saving frames.
+Functions in this hook are called with one argument, a live frame."
+ :type 'hook
:group 'desktop
:version "24.4")
@@ -565,8 +587,9 @@ DIRNAME omitted or nil means use `desktop-dirname'."
"Checksum of the last auto-saved contents of the desktop file.
Used to avoid writing contents unchanged between auto-saves.")
-(defvar desktop--saved-states nil
- "Internal use only.")
+(defvar desktop-saved-frame-states nil
+ "Saved state of all frames.
+Only valid during frame saving & restoring; intended for internal use.")
;; ----------------------------------------------------------------------------
;; Desktop file conflict detection
@@ -621,22 +644,17 @@ Furthermore, it clears the variables listed in `desktop-globals-to-clear'."
(if (symbolp var)
(eval `(setq-default ,var nil))
(eval `(setq-default ,(car var) ,(cdr var)))))
- (let ((buffers (buffer-list))
- (preserve-regexp (concat "^\\("
+ (let ((preserve-regexp (concat "^\\("
(mapconcat (lambda (regexp)
(concat "\\(" regexp "\\)"))
desktop-clear-preserve-buffers
"\\|")
"\\)$")))
- (while buffers
- (let ((bufname (buffer-name (car buffers))))
- (or
- (null bufname)
- (string-match-p preserve-regexp bufname)
- ;; Don't kill buffers made for internal purposes.
- (and (not (equal bufname "")) (eq (aref bufname 0) ?\s))
- (kill-buffer (car buffers))))
- (setq buffers (cdr buffers))))
+ (dolist (buffer (buffer-list))
+ (let ((bufname (buffer-name buffer)))
+ (unless (or (eq (aref bufname 0) ?\s) ;; Don't kill internal buffers
+ (string-match-p preserve-regexp bufname))
+ (kill-buffer buffer)))))
(delete-other-windows))
;; ----------------------------------------------------------------------------
@@ -673,15 +691,7 @@ is nil, ask the user where to save the desktop."
;; ----------------------------------------------------------------------------
(defun desktop-list* (&rest args)
- (if (null (cdr args))
- (car args)
- (setq args (nreverse args))
- (let ((value (cons (nth 1 args) (car args))))
- (setq args (cdr (cdr args)))
- (while args
- (setq value (cons (car args) value))
- (setq args (cdr args)))
- value)))
+ (and args (apply #'cl-list* args)))
;; ----------------------------------------------------------------------------
(defun desktop-buffer-info (buffer)
@@ -713,16 +723,14 @@ is nil, ask the user where to save the desktop."
(when (functionp desktop-save-buffer)
(funcall desktop-save-buffer desktop-dirname))
;; local variables
- (let ((locals desktop-locals-to-save)
- (loclist (buffer-local-variables))
- (ll))
- (while locals
- (let ((here (assq (car locals) loclist)))
- (if here
- (setq ll (cons here ll))
- (when (member (car locals) loclist)
- (setq ll (cons (car locals) ll)))))
- (setq locals (cdr locals)))
+ (let ((loclist (buffer-local-variables))
+ (ll nil))
+ (dolist (local desktop-locals-to-save)
+ (let ((here (assq local loclist)))
+ (cond (here
+ (push here ll))
+ ((member local loclist)
+ (push local ll)))))
ll)))
;; ----------------------------------------------------------------------------
@@ -869,43 +877,224 @@ DIRNAME must be the directory in which the desktop file will be saved."
;; ----------------------------------------------------------------------------
-(defconst desktop--excluded-frame-parameters
- '(buffer-list
- buffer-predicate
- buried-buffer-list
- explicit-name
- font
- font-backend
- minibuffer
- name
- outer-window-id
- parent-id
- window-id
- window-system)
- "Frame parameters not saved or restored.")
-
-(defun desktop--filter-frame-parms (frame)
- "Return frame parameters of FRAME.
-Parameters in `desktop--excluded-frame-parameters' are excluded.
+(defvar desktop-filter-parameters-alist
+ '((background-color . desktop--filter-*-color)
+ (buffer-list . t)
+ (buffer-predicate . t)
+ (buried-buffer-list . t)
+ (desktop--font . desktop--filter-restore-desktop-parm)
+ (desktop--fullscreen . desktop--filter-restore-desktop-parm)
+ (desktop--height . desktop--filter-restore-desktop-parm)
+ (desktop--width . desktop--filter-restore-desktop-parm)
+ (font . desktop--filter-save-desktop-parm)
+ (font-backend . t)
+ (foreground-color . desktop--filter-*-color)
+ (fullscreen . desktop--filter-save-desktop-parm)
+ (height . desktop--filter-save-desktop-parm)
+ (left . desktop--filter-iconified-position)
+ (minibuffer . desktop--filter-minibuffer)
+ (name . t)
+ (outer-window-id . t)
+ (parent-id . t)
+ (top . desktop--filter-iconified-position)
+ (tty . desktop--filter-tty*)
+ (tty-type . desktop--filter-tty*)
+ (width . desktop--filter-save-desktop-parm)
+ (window-id . t)
+ (window-system . t))
+ "Alist of frame parameters and filtering functions.
+
+Each element is a cons (PARAM . FILTER), where PARAM is a parameter
+name (a symbol identifying a frame parameter), and FILTER can be t
+\(meaning the parameter is removed from the parameter list on saving
+and restoring), or a function that will be called with three args:
+
+ CURRENT a cons (PARAM . VALUE), where PARAM is the one being
+ filtered and VALUE is its current value
+ PARAMETERS the complete alist of parameters being filtered
+ SAVING non-nil if filtering before saving state, nil otherwise
+
+The FILTER function must return:
+ nil CURRENT is removed from the list
+ t CURRENT is left as is
+ (PARAM' . VALUE') replace CURRENT with this
+
+Frame parameters not on this list are passed intact.")
+
+(defvar desktop--target-display nil
+ "Either (minibuffer . VALUE) or nil.
+This refers to the current frame config being processed inside
+`frame--restore-frames' and its auxiliary functions (like filtering).
+If nil, there is no need to change the display.
+If non-nil, display parameter to use when creating the frame.
+Internal use only.")
+
+(defun desktop-switch-to-gui-p (parameters)
+ "True when switching to a graphic display.
+Return t if PARAMETERS describes a text-only terminal and
+the target is a graphic display; otherwise return nil.
+Only meaningful when called from a filtering function in
+`desktop-filter-parameters-alist'."
+ (and desktop--target-display ; we're switching
+ (null (cdr (assq 'display parameters))) ; from a tty
+ (cdr desktop--target-display))) ; to a GUI display
+
+(defun desktop-switch-to-tty-p (parameters)
+ "True when switching to a text-only terminal.
+Return t if PARAMETERS describes a graphic display and
+the target is a text-only terminal; otherwise return nil.
+Only meaningful when called from a filtering function in
+`desktop-filter-parameters-alist'."
+ (and desktop--target-display ; we're switching
+ (cdr (assq 'display parameters)) ; from a GUI display
+ (null (cdr desktop--target-display)))) ; to a tty
+
+(defun desktop--filter-tty* (_current parameters saving)
+ ;; Remove tty and tty-type parameters when switching
+ ;; to a GUI frame.
+ (or saving
+ (not (desktop-switch-to-gui-p parameters))))
+
+(defun desktop--filter-*-color (current parameters saving)
+ ;; Remove (foreground|background)-color parameters
+ ;; when switching to a GUI frame if they denote an
+ ;; "unspecified" color.
+ (or saving
+ (not (desktop-switch-to-gui-p parameters))
+ (not (stringp (cdr current)))
+ (not (string-match-p "^unspecified-[fb]g$" (cdr current)))))
+
+(defun desktop--filter-minibuffer (current _parameters saving)
+ ;; When minibuffer is a window, save it as minibuffer . t
+ (or (not saving)
+ (if (windowp (cdr current))
+ '(minibuffer . t)
+ t)))
+
+(defun desktop--filter-restore-desktop-parm (current parameters saving)
+ ;; When switching to a GUI frame, convert desktop--XXX parameter to XXX
+ (or saving
+ (not (desktop-switch-to-gui-p parameters))
+ (let ((val (cdr current)))
+ (if (eq val :desktop-processed)
+ nil
+ (cons (intern (substring (symbol-name (car current))
+ 9)) ;; (length "desktop--")
+ val)))))
+
+(defun desktop--filter-save-desktop-parm (current parameters saving)
+ ;; When switching to a tty frame, save parameter XXX as desktop--XXX so it
+ ;; can be restored in a subsequent GUI session, unless it already exists.
+ (cond (saving t)
+ ((desktop-switch-to-tty-p parameters)
+ (let ((sym (intern (format "desktop--%s" (car current)))))
+ (if (assq sym parameters)
+ nil
+ (cons sym (cdr current)))))
+ ((desktop-switch-to-gui-p parameters)
+ (let* ((dtp (assq (intern (format "desktop--%s" (car current)))
+ parameters))
+ (val (cdr dtp)))
+ (if (eq val :desktop-processed)
+ nil
+ (setcdr dtp :desktop-processed)
+ (cons (car current) val))))
+ (t t)))
+
+(defun desktop--filter-iconified-position (_current parameters saving)
+ ;; When saving an iconified frame, top & left are meaningless,
+ ;; so remove them to allow restoring to a default position.
+ (not (and saving (eq (cdr (assq 'visibility parameters)) 'icon))))
+
+(defun desktop-restore-in-original-display-p ()
+ "True if saved frames' displays should be honored."
+ (cond ((daemonp) t)
+ ((eq system-type 'windows-nt) nil)
+ (t (null desktop-restore-in-current-display))))
+
+(defun desktop--filter-frame-parms (parameters saving)
+ "Filter frame parameters and return filtered list.
+PARAMETERS is a parameter alist as returned by `frame-parameters'.
+If SAVING is non-nil, filtering is happening before saving frame state;
+otherwise, filtering is being done before restoring frame state.
+Parameters are filtered according to the setting of
+`desktop-filter-parameters-alist' (which see).
Internal use only."
- (let (params)
- (dolist (param (frame-parameters frame))
- (unless (memq (car param) desktop--excluded-frame-parameters)
- (push param params)))
- params))
-
-(defun desktop--save-frames ()
- "Save window/frame state, as a global variable.
-Intended to be called from `desktop-save'.
-Internal use only."
- (setq desktop--saved-states
+ (let ((filtered nil))
+ (dolist (param parameters)
+ (let ((filter (cdr (assq (car param) desktop-filter-parameters-alist)))
+ this)
+ (cond (;; no filter: pass param
+ (null filter)
+ (push param filtered))
+ (;; filter = t; skip param
+ (eq filter t))
+ (;; filter func returns nil: skip param
+ (null (setq this (funcall filter param parameters saving))))
+ (;; filter func returns t: pass param
+ (eq this t)
+ (push param filtered))
+ (;; filter func returns a new param: use it
+ t
+ (push this filtered)))))
+ ;; Set the display parameter after filtering, so that filter functions
+ ;; have access to its original value.
+ (when desktop--target-display
+ (let ((display (assq 'display filtered)))
+ (if display
+ (setcdr display (cdr desktop--target-display))
+ (push desktop--target-display filtered))))
+ filtered))
+
+(defun desktop--process-minibuffer-frames (frames)
+ ;; Adds a desktop--mini parameter to frames
+ ;; desktop--mini is a list (MINIBUFFER NUMBER DEFAULT?) where
+ ;; MINIBUFFER t if the frame (including minibuffer-only) owns a minibuffer
+ ;; NUMBER if MINIBUFFER = t, an ID for the frame; if nil, the ID of
+ ;; the frame containing the minibuffer used by this frame
+ ;; DEFAULT? if t, this frame is the value of default-minibuffer-frame
+ (let ((count 0))
+ ;; Reset desktop--mini for all frames
+ (dolist (frame (frame-list))
+ (set-frame-parameter frame 'desktop--mini nil))
+ ;; Number all frames with its own minibuffer
+ (dolist (frame (minibuffer-frame-list))
+ (set-frame-parameter frame 'desktop--mini
+ (list t
+ (cl-incf count)
+ (eq frame default-minibuffer-frame))))
+ ;; Now link minibufferless frames with their minibuffer frames
+ (dolist (frame frames)
+ (unless (frame-parameter frame 'desktop--mini)
+ (let ((mb-frame (window-frame (minibuffer-window frame))))
+ ;; Frames whose minibuffer frame has been filtered out will have
+ ;; desktop--mini = nil, so desktop-restore-frames will restore them
+ ;; according to their minibuffer parameter. Set up desktop--mini
+ ;; for the rest.
+ (when (memq mb-frame frames)
+ (set-frame-parameter frame 'desktop--mini
+ (list nil
+ (cl-second (frame-parameter mb-frame 'desktop--mini))
+ nil))))))))
+
+(defun desktop-save-frames ()
+ "Save frame state in `desktop-saved-frame-states'.
+Runs the hook `desktop-before-saving-frames-functions'.
+Frames with a non-nil `desktop-dont-save' parameter are not saved."
+ (setq desktop-saved-frame-states
(and desktop-restore-frames
- (mapcar (lambda (frame)
- (cons (desktop--filter-frame-parms frame)
- (window-state-get (frame-root-window frame) t)))
- (cons (selected-frame)
- (delq (selected-frame) (frame-list))))))
- (desktop-outvar 'desktop--saved-states))
+ (let ((frames (cl-delete-if
+ (lambda (frame)
+ (run-hook-with-args 'desktop-before-saving-frames-functions frame)
+ (frame-parameter frame 'desktop-dont-save))
+ (frame-list))))
+ ;; In case some frame was deleted by a hook function
+ (setq frames (cl-delete-if-not #'frame-live-p frames))
+ (desktop--process-minibuffer-frames frames)
+ (mapcar (lambda (frame)
+ (cons (desktop--filter-frame-parms (frame-parameters frame) t)
+ (window-state-get (frame-root-window frame) t)))
+ frames)))))
;;;###autoload
(defun desktop-save (dirname &optional release auto-save)
@@ -947,8 +1136,11 @@ and don't save the buffer if they are the same."
(insert "\n;; Global section:\n")
;; Called here because we save the window/frame state as a global
;; variable for compatibility with previous Emacsen.
- (desktop--save-frames)
+ (desktop-save-frames)
+ (unless (memq 'desktop-saved-frame-states desktop-globals-to-save)
+ (desktop-outvar 'desktop-saved-frame-states))
(mapc (function desktop-outvar) desktop-globals-to-save)
+ (setq desktop-saved-frame-states nil) ; after saving desktop-globals-to-save
(when (memq 'kill-ring desktop-globals-to-save)
(insert
"(setq kill-ring-yank-pointer (nthcdr "
@@ -1006,71 +1198,242 @@ This function also sets `desktop-dirname' to nil."
(defvar desktop-lazy-timer nil)
;; ----------------------------------------------------------------------------
-(defun desktop--restore-in-this-display-p ()
- (or desktop-restore-in-current-display
- (and (eq system-type 'windows-nt) (not (display-graphic-p)))))
-
-(defun desktop--find-frame-in-display (frames display)
- (let (result)
- (while (and frames (not result))
- (if (equal display (frame-parameter (car frames) 'display))
- (setq result (car frames))
- (setq frames (cdr frames))))
- result))
-
-(defun desktop--make-full-frame (full display config)
- (let ((width (and (eq full 'fullheight) (cdr (assq 'width config))))
- (height (and (eq full 'fullwidth) (cdr (assq 'height config))))
- (params '((visibility)))
+(defvar desktop--reuse-list nil
+ "Internal use only.")
+
+(defun desktop--find-frame (predicate display &rest args)
+ "Find a suitable frame in `desktop--reuse-list'.
+Look through frames whose display property matches DISPLAY and
+return the first one for which (PREDICATE frame ARGS) returns t.
+If PREDICATE is nil, it is always satisfied. Internal use only.
+This is an auxiliary function for `desktop--select-frame'."
+ (cl-find-if (lambda (frame)
+ (and (equal (frame-parameter frame 'display) display)
+ (or (null predicate)
+ (apply predicate frame args))))
+ desktop--reuse-list))
+
+(defun desktop--select-frame (display frame-cfg)
+ "Look for an existing frame to reuse.
+DISPLAY is the display where the frame will be shown, and FRAME-CFG
+is the parameter list of the frame being restored. Internal use only."
+ (if (eq desktop-restoring-reuses-frames t)
+ (let ((frame nil)
+ mini)
+ ;; There are no fancy heuristics there. We could implement some
+ ;; based on frame size and/or position, etc., but it is not clear
+ ;; that any "gain" (in the sense of reduced flickering, etc.) is
+ ;; worth the added complexity. In fact, the code below mainly
+ ;; tries to work nicely when M-x desktop-read is used after a desktop
+ ;; session has already been loaded. The other main use case, which
+ ;; is the initial desktop-read upon starting Emacs, should usually
+ ;; only have one, or very few, frame(s) to reuse.
+ (cond ((null display)
+ ;; When the target is tty, every existing frame is reusable.
+ (setq frame (desktop--find-frame nil display)))
+ ((car (setq mini (cdr (assq 'desktop--mini frame-cfg))))
+ ;; If the frame has its own minibuffer, let's see whether
+ ;; that frame has already been loaded (which can happen after
+ ;; M-x desktop-read).
+ (setq frame (desktop--find-frame
+ (lambda (f m)
+ (equal (frame-parameter f 'desktop--mini) m))
+ display mini))
+ ;; If it has not been loaded, and it is not a minibuffer-only frame,
+ ;; let's look for an existing non-minibuffer-only frame to reuse.
+ (unless (or frame (eq (cdr (assq 'minibuffer frame-cfg)) 'only))
+ (setq frame (desktop--find-frame
+ (lambda (f)
+ (let ((w (frame-parameter f 'minibuffer)))
+ (and (window-live-p w)
+ (window-minibuffer-p w)
+ (eq (window-frame w) f))))
+ display))))
+ (mini
+ ;; For minibufferless frames, check whether they already exist,
+ ;; and that they are linked to the right minibuffer frame.
+ (setq frame (desktop--find-frame
+ (lambda (f n)
+ (pcase-let (((and m `(,hasmini ,num))
+ (frame-parameter f 'desktop--mini)))
+ (and m
+ (null hasmini)
+ (= num n)
+ (equal (cl-second (frame-parameter
+ (window-frame (minibuffer-window f))
+ 'desktop--mini))
+ n))))
+ display (cl-second mini))))
+ (t
+ ;; Default to just finding a frame in the same display.
+ (setq frame (desktop--find-frame nil display))))
+ ;; If found, remove from the list.
+ (when frame
+ (setq desktop--reuse-list (delq frame desktop--reuse-list)))
frame)
- (when width
- (setq params (append `((user-size . t) (width . ,width)) params)
- config (assq-delete-all 'height config)))
- (when height
- (setq params (append `((user-size . t) (height . ,height)) params)
- config (assq-delete-all 'width config)))
- (setq frame (make-frame-on-display display params))
- (modify-frame-parameters frame config)
+ nil))
+
+(defun desktop--make-frame (frame-cfg window-cfg)
+ "Set up a frame according to its saved state.
+That means either creating a new frame or reusing an existing one.
+FRAME-CFG is the parameter list of the new frame; WINDOW-CFG is
+its window state. Internal use only."
+ (let* ((fullscreen (cdr (assq 'fullscreen frame-cfg)))
+ (lines (assq 'tool-bar-lines frame-cfg))
+ (filtered-cfg (desktop--filter-frame-parms frame-cfg nil))
+ (display (cdr (assq 'display filtered-cfg))) ;; post-filtering
+ alt-cfg frame)
+
+ ;; This works around bug#14795 (or feature#14795, if not a bug :-)
+ (setq filtered-cfg (assq-delete-all 'tool-bar-lines filtered-cfg))
+ (push '(tool-bar-lines . 0) filtered-cfg)
+
+ (when fullscreen
+ ;; Currently Emacs has the limitation that it does not record the size
+ ;; and position of a frame before maximizing it, so we cannot save &
+ ;; restore that info. Instead, when restoring, we resort to creating
+ ;; invisible "fullscreen" frames of default size and then maximizing them
+ ;; (and making them visible) which at least is somewhat user-friendly
+ ;; when these frames are later de-maximized.
+ (let ((width (and (eq fullscreen 'fullheight) (cdr (assq 'width filtered-cfg))))
+ (height (and (eq fullscreen 'fullwidth) (cdr (assq 'height filtered-cfg))))
+ (visible (assq 'visibility filtered-cfg)))
+ (setq filtered-cfg (cl-delete-if (lambda (p)
+ (memq p '(visibility fullscreen width height)))
+ filtered-cfg :key #'car))
+ (when width
+ (setq filtered-cfg (append `((user-size . t) (width . ,width))
+ filtered-cfg)))
+ (when height
+ (setq filtered-cfg (append `((user-size . t) (height . ,height))
+ filtered-cfg)))
+ ;; These are parameters to apply after creating/setting the frame.
+ (push visible alt-cfg)
+ (push (cons 'fullscreen fullscreen) alt-cfg)))
+
+ ;; Time to select or create a frame an apply the big bunch of parameters
+ (if (setq frame (desktop--select-frame display filtered-cfg))
+ (modify-frame-parameters frame
+ (if (eq (frame-parameter frame 'fullscreen) fullscreen)
+ ;; Workaround for bug#14949
+ (assq-delete-all 'fullscreen filtered-cfg)
+ filtered-cfg))
+ (setq frame (make-frame-on-display display filtered-cfg)))
+
+ ;; Let's give the finishing touches (visibility, tool-bar, maximization).
+ (when lines (push lines alt-cfg))
+ (when alt-cfg (modify-frame-parameters frame alt-cfg))
+ ;; Now restore window state.
+ (window-state-put window-cfg (frame-root-window frame) 'safe)
frame))
-(defun desktop--restore-frames ()
+(defun desktop--sort-states (state1 state2)
+ ;; Order: default minibuffer frame
+ ;; other frames with minibuffer, ascending ID
+ ;; minibufferless frames, ascending ID
+ (pcase-let ((`(,_p1 ,hasmini1 ,num1 ,default1) (assq 'desktop--mini (car state1)))
+ (`(,_p2 ,hasmini2 ,num2 ,default2) (assq 'desktop--mini (car state2))))
+ (cond (default1 t)
+ (default2 nil)
+ ((eq hasmini1 hasmini2) (< num1 num2))
+ (t hasmini1))))
+
+(defun desktop-restoring-frames-p ()
+ "True if calling `desktop-restore-frames' will actually restore frames."
+ (and desktop-restore-frames desktop-saved-frame-states t))
+
+(defun desktop-restore-frames ()
"Restore window/frame configuration.
-Internal use only."
- (when (and desktop-restore-frames desktop--saved-states)
- (let ((frames (frame-list))
- (current (frame-parameter nil 'display))
- (selected nil))
- (dolist (state desktop--saved-states)
+This function depends on the value of `desktop-saved-frame-states'
+being set (usually, by reading it from the desktop)."
+ (when (desktop-restoring-frames-p)
+ (let* ((frame-mb-map nil) ;; Alist of frames with their own minibuffer
+ (delete-saved (eq desktop-restore-in-current-display 'delete))
+ (forcing (not (desktop-restore-in-original-display-p)))
+ (target (and forcing (cons 'display (frame-parameter nil 'display)))))
+
+ ;; Sorting saved states allows us to easily restore minibuffer-owning frames
+ ;; before minibufferless ones.
+ (setq desktop-saved-frame-states (sort desktop-saved-frame-states
+ #'desktop--sort-states))
+ ;; Potentially all existing frames are reusable. Later we will decide which ones
+ ;; to reuse, and how to deal with any leftover.
+ (setq desktop--reuse-list (frame-list))
+
+ (dolist (state desktop-saved-frame-states)
(condition-case err
- (let* ((config (car state))
- (display (if (desktop--restore-in-this-display-p)
- (setcdr (assq 'display config) current)
- (cdr (assq 'display config))))
- (full (cdr (assq 'fullscreen config)))
- (frame (and (not full)
- (desktop--find-frame-in-display frames display))))
- (cond (full
- ;; treat fullscreen/maximized frames specially
- (setq frame (desktop--make-full-frame full display config)))
- (frame
- ;; found a frame in the right display -- reuse
- (setq frames (delq frame frames))
- (modify-frame-parameters frame config))
- (t
- ;; no frames in the display -- make a new one
- (setq frame (make-frame-on-display display config))))
- ;; restore windows
- (window-state-put (cdr state) (frame-root-window frame) 'safe)
- (unless selected (setq selected frame)))
+ (pcase-let* ((`(,frame-cfg . ,window-cfg) state)
+ ((and d-mini `(,hasmini ,num ,default))
+ (cdr (assq 'desktop--mini frame-cfg)))
+ (frame nil) (to-tty nil))
+ ;; Only set target if forcing displays and the target display is different.
+ (if (or (not forcing)
+ (equal target (or (assq 'display frame-cfg) '(display . nil))))
+ (setq desktop--target-display nil)
+ (setq desktop--target-display target
+ to-tty (null (cdr target))))
+ ;; Time to restore frames and set up their minibuffers as they were.
+ ;; We only skip a frame (thus deleting it) if either:
+ ;; - we're switching displays, and the user chose the option to delete, or
+ ;; - we're switching to tty, and the frame to restore is minibuffer-only.
+ (unless (and desktop--target-display
+ (or delete-saved
+ (and to-tty
+ (eq (cdr (assq 'minibuffer frame-cfg)) 'only))))
+
+ ;; Restore minibuffers. Some of this stuff could be done in a filter
+ ;; function, but it would be messy because restoring minibuffers affects
+ ;; global state; it's best to do it here than add a bunch of global
+ ;; variables to pass info back-and-forth to/from the filter function.
+ (cond
+ ((null d-mini)) ;; No desktop--mini. Process as normal frame.
+ (to-tty) ;; Ignore minibuffer stuff and process as normal frame.
+ (hasmini ;; Frame has minibuffer (or it is minibuffer-only).
+ (when (eq (cdr (assq 'minibuffer frame-cfg)) 'only)
+ (setq frame-cfg (append '((tool-bar-lines . 0) (menu-bar-lines . 0))
+ frame-cfg))))
+ (t ;; Frame depends on other frame's minibuffer window.
+ (let ((mb-frame (cdr (assq num frame-mb-map))))
+ (unless (frame-live-p mb-frame)
+ (error "Minibuffer frame %s not found" num))
+ (let ((mb-param (assq 'minibuffer frame-cfg))
+ (mb-window (minibuffer-window mb-frame)))
+ (unless (and (window-live-p mb-window)
+ (window-minibuffer-p mb-window))
+ (error "Not a minibuffer window %s" mb-window))
+ (if mb-param
+ (setcdr mb-param mb-window)
+ (push (cons 'minibuffer mb-window) frame-cfg))))))
+ ;; OK, we're ready at last to create (or reuse) a frame and
+ ;; restore the window config.
+ (setq frame (desktop--make-frame frame-cfg window-cfg))
+ ;; Set default-minibuffer if required.
+ (when default (setq default-minibuffer-frame frame))
+ ;; Store NUM/frame to assign to minibufferless frames.
+ (when hasmini (push (cons num frame) frame-mb-map))))
(error
- (message "Error restoring frame: %S" (error-message-string err)))))
- (when selected
- ;; make sure the original selected frame is visible and selected
- (unless (or (frame-parameter selected 'visibility) (daemonp))
- (modify-frame-parameters selected '((visibility . t))))
- (select-frame-set-input-focus selected)
- ;; delete any remaining frames
- (mapc #'delete-frame frames)))))
+ (delay-warning 'desktop (error-message-string err) :error))))
+
+ ;; In case we try to delete the initial frame, we want to make sure that
+ ;; other frames are already visible (discussed in thread for bug#14841).
+ (sit-for 0 t)
+
+ ;; Delete remaining frames, but do not fail if some resist being deleted.
+ (unless (eq desktop-restoring-reuses-frames 'keep)
+ (dolist (frame desktop--reuse-list)
+ (condition-case err
+ (delete-frame frame)
+ (error
+ (delay-warning 'desktop (error-message-string err))))))
+ (setq desktop--reuse-list nil)
+ ;; Make sure there's at least one visible frame, and select it.
+ (unless (or (daemonp)
+ (cl-find-if #'frame-visible-p (frame-list)))
+ (let ((visible (if (frame-live-p default-minibuffer-frame)
+ default-minibuffer-frame
+ (car (frame-list)))))
+ (make-frame-visible visible)
+ (select-frame-set-input-focus visible))))))
;;;###autoload
(defun desktop-read (&optional dirname)
@@ -1131,16 +1494,17 @@ Using it may cause conflicts. Use it anyway? " owner)))))
(file-error (message "Couldn't record use of desktop file")
(sit-for 1))))
- ;; `desktop-create-buffer' puts buffers at end of the buffer list.
- ;; We want buffers existing prior to evaluating the desktop (and
- ;; not reused) to be placed at the end of the buffer list, so we
- ;; move them here.
- (mapc 'bury-buffer
- (nreverse (cdr (memq desktop-first-buffer (nreverse (buffer-list))))))
- (switch-to-buffer (car (buffer-list)))
+ (unless (desktop-restoring-frames-p)
+ ;; `desktop-create-buffer' puts buffers at end of the buffer list.
+ ;; We want buffers existing prior to evaluating the desktop (and
+ ;; not reused) to be placed at the end of the buffer list, so we
+ ;; move them here.
+ (mapc 'bury-buffer
+ (nreverse (cdr (memq desktop-first-buffer (nreverse (buffer-list))))))
+ (switch-to-buffer (car (buffer-list))))
(run-hooks 'desktop-delay-hook)
(setq desktop-delay-hook nil)
- (desktop--restore-frames)
+ (desktop-restore-frames)
(run-hooks 'desktop-after-read-hook)
(message "Desktop: %d buffer%s restored%s%s."
desktop-buffer-ok-count
@@ -1152,18 +1516,19 @@ Using it may cause conflicts. Use it anyway? " owner)))))
(format ", %d to restore lazily"
(length desktop-buffer-args-list))
""))
- ;; Bury the *Messages* buffer to not reshow it when burying
- ;; the buffer we switched to above.
- (when (buffer-live-p (get-buffer "*Messages*"))
- (bury-buffer "*Messages*"))
- ;; Clear all windows' previous and next buffers, these have
- ;; been corrupted by the `switch-to-buffer' calls in
- ;; `desktop-restore-file-buffer' (bug#11556). This is a
- ;; brute force fix and should be replaced by a more subtle
- ;; strategy eventually.
- (walk-window-tree (lambda (window)
- (set-window-prev-buffers window nil)
- (set-window-next-buffers window nil)))
+ (unless (desktop-restoring-frames-p)
+ ;; Bury the *Messages* buffer to not reshow it when burying
+ ;; the buffer we switched to above.
+ (when (buffer-live-p (get-buffer "*Messages*"))
+ (bury-buffer "*Messages*"))
+ ;; Clear all windows' previous and next buffers, these have
+ ;; been corrupted by the `switch-to-buffer' calls in
+ ;; `desktop-restore-file-buffer' (bug#11556). This is a
+ ;; brute force fix and should be replaced by a more subtle
+ ;; strategy eventually.
+ (walk-window-tree (lambda (window)
+ (set-window-prev-buffers window nil)
+ (set-window-next-buffers window nil))))
t))
;; No desktop file found.
(desktop-clear)
@@ -1387,17 +1752,15 @@ integer, start a new timer to call `desktop-auto-save' in that many seconds."
(set-mark desktop-buffer-mark)))
;; Never override file system if the file really is read-only marked.
(when desktop-buffer-read-only (setq buffer-read-only desktop-buffer-read-only))
- (while desktop-buffer-locals
- (let ((this (car desktop-buffer-locals)))
- (if (consp this)
- ;; an entry of this form `(symbol . value)'
- (progn
- (make-local-variable (car this))
- (set (car this) (cdr this)))
- ;; an entry of the form `symbol'
- (make-local-variable this)
- (makunbound this)))
- (setq desktop-buffer-locals (cdr desktop-buffer-locals))))))))
+ (dolist (this desktop-buffer-locals)
+ (if (consp this)
+ ;; an entry of this form `(symbol . value)'
+ (progn
+ (make-local-variable (car this))
+ (set (car this) (cdr this)))
+ ;; an entry of the form `symbol'
+ (make-local-variable this)
+ (makunbound this))))))))
;; ----------------------------------------------------------------------------
;; Backward compatibility -- update parameters to 205 standards.
diff --git a/lisp/dired-x.el b/lisp/dired-x.el
index 2a9bc167a9c..0c432593909 100644
--- a/lisp/dired-x.el
+++ b/lisp/dired-x.el
@@ -331,9 +331,9 @@ See also the functions:
;; Mark files with some extension.
(defun dired-mark-extension (extension &optional marker-char)
"Mark all files with a certain EXTENSION for use in later commands.
-A `.' is *not* automatically prepended to the string entered."
- ;; EXTENSION may also be a list of extensions instead of a single one.
- ;; Optional MARKER-CHAR is marker to use.
+A `.' is *not* automatically prepended to the string entered.
+EXTENSION may also be a list of extensions instead of a single one.
+Optional MARKER-CHAR is marker to use."
(interactive "sMarking extension: \nP")
(or (listp extension)
(setq extension (list extension)))
@@ -563,10 +563,10 @@ Optional fourth argument LOCALP is as in `dired-get-filename'."
(dired-mark-if
(and
;; not already marked
- (looking-at " ")
+ (looking-at-p " ")
;; uninteresting
(let ((fn (dired-get-filename localp t)))
- (and fn (string-match regexp fn))))
+ (and fn (string-match-p regexp fn))))
msg)))
@@ -610,7 +610,7 @@ you can relist single subdirs using \\[dired-do-redisplay]."
(interactive
(list (read-string "Virtual Dired directory: " (dired-virtual-guess-dir))))
(goto-char (point-min))
- (or (looking-at " ")
+ (or (looking-at-p " ")
;; if not already indented, do it now:
(indent-region (point-min) (point-max) 2))
(or dirname (setq dirname default-directory))
@@ -627,7 +627,7 @@ you can relist single subdirs using \\[dired-do-redisplay]."
;; If raw ls listing (not a saved old dired buffer), give it a
;; decent subdir headerline:
(goto-char (point-min))
- (or (looking-at dired-subdir-regexp)
+ (or (looking-at-p dired-subdir-regexp)
(insert " "
(directory-file-name (file-name-directory default-directory))
":\n"))
@@ -1089,13 +1089,13 @@ See `dired-guess-shell-alist-user'."
(setq elt (car alist)
regexp (car elt)
alist (cdr alist))
- (if (string-match regexp file)
+ (if (string-match-p regexp file)
(setq cmds (cdr elt)
alist nil)))
;; If more than one file, see if all of FILES match regular expression.
(while (and flist
- (string-match regexp (car flist)))
+ (string-match-p regexp (car flist)))
(setq flist (cdr flist)))
;; If flist is still non-nil, then do not guess since this means that not
@@ -1500,7 +1500,7 @@ to mark all zero length files."
(or
(dired-move-to-end-of-filename t)
(point)))
- sym (if (looking-at " -> ")
+ sym (if (looking-at-p " -> ")
(buffer-substring (progn (forward-char 4) (point))
(line-end-position))
""))
@@ -1564,12 +1564,12 @@ Point should be in or after a filename."
(save-excursion
;; First see if just past a filename.
(or (eobp) ; why?
- (when (looking-at "[] \t\n[{}()]") ; whitespace or some parens
+ (when (looking-at-p "[] \t\n[{}()]") ; whitespace or some parens
(skip-chars-backward " \n\t\r({[]})")
(or (bobp) (backward-char 1))))
(let ((filename-chars "-.[:alnum:]_/:$+@")
start prefix)
- (if (looking-at (format "[%s]" filename-chars))
+ (if (looking-at-p (format "[%s]" filename-chars))
(progn
(skip-chars-backward filename-chars)
(setq start (point)
@@ -1577,11 +1577,11 @@ Point should be in or after a filename."
;; This is something to do with ange-ftp filenames.
;; It convert foo@bar to /foo@bar.
;; But when does the former occur in dired buffers?
- (and (string-match
+ (and (string-match-p
"^\\w+@"
(buffer-substring start (line-end-position)))
"/"))
- (if (string-match "[/~]" (char-to-string (preceding-char)))
+ (if (string-match-p "[/~]" (char-to-string (preceding-char)))
(setq start (1- start)))
(skip-chars-forward filename-chars))
(error "No file found around point!"))
diff --git a/lisp/dired.el b/lisp/dired.el
index 70fee538670..c871761bb3c 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -4367,7 +4367,7 @@ instead.
;;;***
-;;;### (autoloads nil "dired-x" "dired-x.el" "4b863621846609105c0371f8ffb8c1cf")
+;;;### (autoloads nil "dired-x" "dired-x.el" "1419d865898f84c17f172320e578380c")
;;; Generated autoloads from dired-x.el
(autoload 'dired-jump "dired-x" "\
diff --git a/lisp/dos-w32.el b/lisp/dos-w32.el
index ff4a3ad66f0..0573caa6c23 100644
--- a/lisp/dos-w32.el
+++ b/lisp/dos-w32.el
@@ -257,10 +257,10 @@ filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"."
;; Function to actually send data to the printer port.
;; Supports writing directly, and using various programs.
(defun direct-print-region-helper (printer
- start end
- lpr-prog
- _delete-text _buf _display
- rest)
+ start end
+ lpr-prog
+ _delete-text _buf _display
+ rest)
(let* (;; Ignore case when matching known external program names.
(case-fold-search t)
;; Convert / to \ in printer name, for sake of external programs.
@@ -295,12 +295,14 @@ filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"."
(unwind-protect
(cond
;; nprint.exe is the standard print command on Netware
- ((string-match-p "^nprint\\(\\.exe\\)?$" (file-name-nondirectory lpr-prog))
+ ((string-match-p "\\`nprint\\(\\.exe\\)?\\'"
+ (file-name-nondirectory lpr-prog))
(write-region start end tempfile nil 0)
(call-process lpr-prog nil errbuf nil
tempfile (concat "P=" printer)))
;; print.exe is a standard command on NT
- ((string-match-p "^print\\(\\.exe\\)?$" (file-name-nondirectory lpr-prog))
+ ((string-match-p "\\`print\\(\\.exe\\)?\\'"
+ (file-name-nondirectory lpr-prog))
;; Be careful not to invoke print.exe on MS-DOS or Windows 9x
;; though, because it is a TSR program there (hangs Emacs).
(or (and (eq system-type 'windows-nt)
@@ -369,7 +371,7 @@ indicates a specific program should be invoked."
(write-region-annotate-functions
(cons
(lambda (_start end)
- (if (not (char-equal (char-before end) ?\C-l))
+ (if (not (char-equal (char-before end) ?\f))
`((,end . "\f"))))
write-region-annotate-functions))
(printer (or (and (boundp 'dos-printer)
@@ -383,9 +385,7 @@ indicates a specific program should be invoked."
(direct-print-region-helper printer start end lpr-prog
delete-text buf display rest)))
-(defvar print-region-function)
(defvar lpr-headers-switches)
-(setq print-region-function 'direct-print-region-function)
;; Set this to nil if you have a port of the `pr' program
;; (e.g., from GNU Textutils), or if you have an `lpr'
@@ -416,9 +416,6 @@ indicates a specific program should be invoked."
(direct-print-region-helper printer start end lpr-prog
delete-text buf display rest)))
-(defvar ps-print-region-function)
-(setq ps-print-region-function 'direct-ps-print-region-function)
-
;(setq ps-lpr-command "gs")
;(setq ps-lpr-switches '("-q" "-dNOPAUSE" "-sDEVICE=epson" "-r240x60"
diff --git a/lisp/edmacro.el b/lisp/edmacro.el
index 67992d16527..73662951188 100644
--- a/lisp/edmacro.el
+++ b/lisp/edmacro.el
@@ -562,7 +562,8 @@ doubt, use whitespace."
(unless (string-match " " desc)
(let ((times 1) (pos bind-len))
(while (not (cl-mismatch rest-mac rest-mac
- 0 bind-len pos (+ bind-len pos)))
+ :start1 0 :end1 bind-len
+ :start2 pos :end2 (+ bind-len pos)))
(cl-incf times)
(cl-incf pos bind-len))
(when (> times 1)
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index 22713c6589c..e531bc0bdae 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -436,33 +436,26 @@ Return non-nil in the case where no autoloads were added at point."
(defvar print-readably)
-(defun autoload--insert-text (output-start otherbuf outbuf absfile
- load-name printfun)
- ;; If not done yet, figure out where to insert this text.
- (unless (marker-buffer output-start)
- (let ((outbuf
- (or (if otherbuf
- ;; A file-local setting of
- ;; autoload-generated-file says we
- ;; should ignore OUTBUF.
- nil
- outbuf)
- (autoload-find-destination absfile load-name)
- ;; The file has autoload cookies, but they're
- ;; already up-to-date. If OUTFILE is nil, the
- ;; entries are in the expected OUTBUF,
- ;; otherwise they're elsewhere.
- (throw 'done otherbuf))))
- (with-current-buffer outbuf
- (move-marker output-start (point) outbuf))))
- (let ((standard-output (marker-buffer output-start)))
- (funcall printfun)))
-(defun autoload--insert-cookie-text (output-start otherbuf outbuf absfile
- load-name file)
- (autoload--insert-text
- output-start otherbuf outbuf absfile load-name
- (lambda ()
+(defun autoload--setup-output (otherbuf outbuf absfile load-name)
+ (let ((outbuf
+ (or (if otherbuf
+ ;; A file-local setting of
+ ;; autoload-generated-file says we
+ ;; should ignore OUTBUF.
+ nil
+ outbuf)
+ (autoload-find-destination absfile load-name)
+ ;; The file has autoload cookies, but they're
+ ;; already up-to-date. If OUTFILE is nil, the
+ ;; entries are in the expected OUTBUF,
+ ;; otherwise they're elsewhere.
+ (throw 'done otherbuf))))
+ (with-current-buffer outbuf
+ (point-marker))))
+
+(defun autoload--print-cookie-text (output-start load-name file)
+ (let ((standard-output (marker-buffer output-start)))
(search-forward generate-autoload-cookie)
(skip-chars-forward " \t")
(if (eolp)
@@ -490,7 +483,7 @@ Return non-nil in the case where no autoloads were added at point."
;; Eat one space.
(forward-char 1))
(point))
- (progn (forward-line 1) (point))))))))
+ (progn (forward-line 1) (point)))))))
(defvar autoload-builtin-package-versions nil)
@@ -553,23 +546,25 @@ Return non-nil if and only if FILE adds no autoloads to OUTFILE
(setq package (or (lm-header "package")
(file-name-sans-extension
(file-name-nondirectory file))))
- (setq output-start (make-marker))
- (autoload--insert-text
- output-start otherbuf outbuf absfile load-name
- (lambda ()
+ (setq output-start (autoload--setup-output
+ otherbuf outbuf absfile load-name))
+ (let ((standard-output (marker-buffer output-start))
+ (print-quoted t))
(princ `(push (purecopy
',(cons (intern package) version))
package--builtin-versions))
- (newline))))))
+ (newline)))))
(goto-char (point-min))
(while (not (eobp))
(skip-chars-forward " \t\n\f")
(cond
((looking-at (regexp-quote generate-autoload-cookie))
- (unless output-start (setq output-start (make-marker)))
- (autoload--insert-cookie-text
- output-start otherbuf outbuf absfile load-name file))
+ ;; If not done yet, figure out where to insert this text.
+ (unless output-start
+ (setq output-start (autoload--setup-output
+ otherbuf outbuf absfile load-name)))
+ (autoload--print-cookie-text output-start load-name file))
((looking-at ";")
;; Don't read the comment.
(forward-line 1))
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 0728e86d072..aee48eef668 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -102,22 +102,6 @@ The value used here is passed to `quit-restore-window'."
This is to optimize `debugger-make-xrefs'.")
(defvar debugger-outer-match-data)
-(defvar debugger-outer-load-read-function)
-(defvar debugger-outer-overriding-local-map)
-(defvar debugger-outer-overriding-terminal-local-map)
-(defvar debugger-outer-track-mouse)
-(defvar debugger-outer-last-command)
-(defvar debugger-outer-this-command)
-(defvar debugger-outer-unread-command-events)
-(defvar debugger-outer-unread-post-input-method-events)
-(defvar debugger-outer-last-input-event)
-(defvar debugger-outer-last-command-event)
-(defvar debugger-outer-last-nonmenu-event)
-(defvar debugger-outer-last-event-frame)
-(defvar debugger-outer-standard-input)
-(defvar debugger-outer-standard-output)
-(defvar debugger-outer-inhibit-redisplay)
-(defvar debugger-outer-cursor-in-echo-area)
(defvar debugger-will-be-back nil
"Non-nil if we expect to get back in the debugger soon.")
@@ -174,24 +158,6 @@ first will be printed into the backtrace buffer."
;; Save the outer values of these vars for the `e' command
;; before we replace the values.
(debugger-outer-match-data (match-data))
- (debugger-outer-load-read-function load-read-function)
- (debugger-outer-overriding-local-map overriding-local-map)
- (debugger-outer-overriding-terminal-local-map
- overriding-terminal-local-map)
- (debugger-outer-track-mouse track-mouse)
- (debugger-outer-last-command last-command)
- (debugger-outer-this-command this-command)
- (debugger-outer-unread-command-events unread-command-events)
- (debugger-outer-unread-post-input-method-events
- unread-post-input-method-events)
- (debugger-outer-last-input-event last-input-event)
- (debugger-outer-last-command-event last-command-event)
- (debugger-outer-last-nonmenu-event last-nonmenu-event)
- (debugger-outer-last-event-frame last-event-frame)
- (debugger-outer-standard-input standard-input)
- (debugger-outer-standard-output standard-output)
- (debugger-outer-inhibit-redisplay inhibit-redisplay)
- (debugger-outer-cursor-in-echo-area cursor-in-echo-area)
(debugger-with-timeout-suspend (with-timeout-suspend)))
;; Set this instead of binding it, so that `q'
;; will not restore it.
@@ -294,26 +260,6 @@ first will be printed into the backtrace buffer."
(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
- ;; in case the user set them with the `e' command.
- (setq load-read-function debugger-outer-load-read-function)
- (setq overriding-local-map debugger-outer-overriding-local-map)
- (setq overriding-terminal-local-map
- debugger-outer-overriding-terminal-local-map)
- (setq track-mouse debugger-outer-track-mouse)
- (setq last-command debugger-outer-last-command)
- (setq this-command debugger-outer-this-command)
- (setq unread-command-events debugger-outer-unread-command-events)
- (setq unread-post-input-method-events
- debugger-outer-unread-post-input-method-events)
- (setq last-input-event debugger-outer-last-input-event)
- (setq last-command-event debugger-outer-last-command-event)
- (setq last-nonmenu-event debugger-outer-last-nonmenu-event)
- (setq last-event-frame debugger-outer-last-event-frame)
- (setq standard-input debugger-outer-standard-input)
- (setq standard-output debugger-outer-standard-output)
- (setq inhibit-redisplay debugger-outer-inhibit-redisplay)
- (setq cursor-in-echo-area debugger-outer-cursor-in-echo-area)
(setq debug-on-next-call debugger-step-after-exit)
debugger-value)))
@@ -518,18 +464,21 @@ removes itself from that hook."
(setq debugger-jumping-flag nil)
(remove-hook 'post-command-hook 'debugger-reenable))
-(defun debugger-frame-number ()
+(defun debugger-frame-number (&optional skip-base)
"Return number of frames in backtrace before the one point points at."
(save-excursion
(beginning-of-line)
+ (if (looking-at " *;;;\\|[a-z]")
+ (error "This line is not a function call"))
(let ((opoint (point))
(count 0))
- (while (not (eq (cadr (backtrace-frame count)) 'debug))
- (setq count (1+ count)))
- ;; Skip debug--implement-debug-on-entry frame.
- (when (eq 'debug--implement-debug-on-entry
- (cadr (backtrace-frame (1+ count))))
- (setq count (+ 2 count)))
+ (unless skip-base
+ (while (not (eq (cadr (backtrace-frame count)) 'debug))
+ (setq count (1+ count)))
+ ;; Skip debug--implement-debug-on-entry frame.
+ (when (eq 'debug--implement-debug-on-entry
+ (cadr (backtrace-frame (1+ count))))
+ (setq count (+ 2 count))))
(goto-char (point-min))
(when (looking-at "Debugger entered--\\(Lisp error\\|returning value\\):")
(goto-char (match-end 0))
@@ -551,12 +500,8 @@ removes itself from that hook."
"Request entry to debugger when this frame exits.
Applies to the frame whose line point is on in the backtrace."
(interactive)
- (save-excursion
- (beginning-of-line)
- (if (looking-at " *;;;\\|[a-z]")
- (error "This line is not a function call")))
- (beginning-of-line)
(backtrace-debug (debugger-frame-number) t)
+ (beginning-of-line)
(if (= (following-char) ? )
(let ((inhibit-read-only t))
(delete-char 1)
@@ -567,12 +512,8 @@ Applies to the frame whose line point is on in the backtrace."
"Do not enter debugger when this frame exits.
Applies to the frame whose line point is on in the backtrace."
(interactive)
- (save-excursion
- (beginning-of-line)
- (if (looking-at " *;;;\\|[a-z]")
- (error "This line is not a function call")))
- (beginning-of-line)
(backtrace-debug (debugger-frame-number) nil)
+ (beginning-of-line)
(if (= (following-char) ?*)
(let ((inhibit-read-only t))
(delete-char 1)
@@ -583,59 +524,33 @@ Applies to the frame whose line point is on in the backtrace."
"Run BODY in original environment."
(declare (indent 0))
`(save-excursion
- (if (null (buffer-name debugger-old-buffer))
+ (if (null (buffer-live-p debugger-old-buffer))
;; old buffer deleted
(setq debugger-old-buffer (current-buffer)))
(set-buffer debugger-old-buffer)
- (let ((load-read-function debugger-outer-load-read-function)
- (overriding-terminal-local-map
- debugger-outer-overriding-terminal-local-map)
- (overriding-local-map debugger-outer-overriding-local-map)
- (track-mouse debugger-outer-track-mouse)
- (last-command debugger-outer-last-command)
- (this-command debugger-outer-this-command)
- (unread-command-events debugger-outer-unread-command-events)
- (unread-post-input-method-events
- debugger-outer-unread-post-input-method-events)
- (last-input-event debugger-outer-last-input-event)
- (last-command-event debugger-outer-last-command-event)
- (last-nonmenu-event debugger-outer-last-nonmenu-event)
- (last-event-frame debugger-outer-last-event-frame)
- (standard-input debugger-outer-standard-input)
- (standard-output debugger-outer-standard-output)
- (inhibit-redisplay debugger-outer-inhibit-redisplay)
- (cursor-in-echo-area debugger-outer-cursor-in-echo-area))
- (set-match-data debugger-outer-match-data)
- (prog1
- (progn ,@body)
- (setq debugger-outer-match-data (match-data))
- (setq debugger-outer-load-read-function load-read-function)
- (setq debugger-outer-overriding-terminal-local-map
- overriding-terminal-local-map)
- (setq debugger-outer-overriding-local-map overriding-local-map)
- (setq debugger-outer-track-mouse track-mouse)
- (setq debugger-outer-last-command last-command)
- (setq debugger-outer-this-command this-command)
- (setq debugger-outer-unread-command-events unread-command-events)
- (setq debugger-outer-unread-post-input-method-events
- unread-post-input-method-events)
- (setq debugger-outer-last-input-event last-input-event)
- (setq debugger-outer-last-command-event last-command-event)
- (setq debugger-outer-last-nonmenu-event last-nonmenu-event)
- (setq debugger-outer-last-event-frame last-event-frame)
- (setq debugger-outer-standard-input standard-input)
- (setq debugger-outer-standard-output standard-output)
- (setq debugger-outer-inhibit-redisplay inhibit-redisplay)
- (setq debugger-outer-cursor-in-echo-area cursor-in-echo-area)
- ))))
+ (set-match-data debugger-outer-match-data)
+ (prog1
+ (progn ,@body)
+ (setq debugger-outer-match-data (match-data)))))
(defun debugger-eval-expression (exp)
- "Eval an expression, in an environment like that outside the debugger."
+ "Eval an expression, in an environment like that outside the debugger.
+The environment used is the one when entering the activation frame at point."
(interactive
(list (read-from-minibuffer "Eval: "
nil read-expression-map t
'read-expression-history)))
- (debugger-env-macro (eval-expression exp)))
+ (let ((nframe (condition-case nil (1+ (debugger-frame-number 'skip-base))
+ (error 0))) ;; If on first line.
+ (base (if (eq 'debug--implement-debug-on-entry
+ (cadr (backtrace-frame 1 'debug)))
+ 'debug--implement-debug-on-entry 'debug)))
+ (debugger-env-macro
+ (let ((val (backtrace-eval exp nframe base)))
+ (prog1
+ (prin1 val t)
+ (let ((str (eval-expression-print-format val)))
+ (if str (princ str t))))))))
(defvar debugger-mode-map
(let ((map (make-keymap))
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index 36c72f3a3bd..ae20e5270e1 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -2088,8 +2088,6 @@ expressions; a `progn' form will be returned enclosing these forms."
(defvar edebug-coverage) ; the coverage results of each expression of function.
(defvar edebug-buffer) ; which buffer the function is in.
-(defvar edebug-outside-executing-macro)
-(defvar edebug-outside-defining-kbd-macro)
(defvar edebug-execution-mode 'step) ; Current edebug mode set by user.
(defvar edebug-next-execution-mode nil) ; Use once instead of initial mode.
@@ -2097,12 +2095,6 @@ expressions; a `progn' form will be returned enclosing these forms."
(defvar edebug-outside-debug-on-error) ; the value of debug-on-error outside
(defvar edebug-outside-debug-on-quit) ; the value of debug-on-quit outside
-
-(defvar edebug-outside-pre-command-hook)
-(defvar edebug-outside-post-command-hook)
-
-(defvar cl-lexical-debug) ;; Defined in cl.el
-
;;; Handling signals
(defun edebug-signal (signal-name signal-data)
@@ -2154,10 +2146,7 @@ error is signaled again."
;; Binding these may not be the right thing to do.
;; We want to allow the global values to be changed.
(debug-on-error (or debug-on-error edebug-on-error))
- (debug-on-quit edebug-on-quit)
-
- ;; Lexical bindings must be uncompiled for this to work.
- (cl-lexical-debug t))
+ (debug-on-quit edebug-on-quit))
(unwind-protect
(let ((signal-hook-function 'edebug-signal))
(setq edebug-execution-mode (or edebug-next-execution-mode
@@ -2386,9 +2375,6 @@ MSG is printed after `::::} '."
(defvar edebug-window-data) ; window and window-start for current function
(defvar edebug-outside-windows) ; outside window configuration
(defvar edebug-eval-buffer) ; for the evaluation list.
-(defvar edebug-outside-o-a-p) ; outside overlay-arrow-position
-(defvar edebug-outside-o-a-s) ; outside overlay-arrow-string
-(defvar edebug-outside-c-i-e-a) ; outside cursor-in-echo-area
(defvar edebug-outside-d-c-i-n-s-w) ; outside default-cursor-in-non-selected-windows
(defvar edebug-eval-list nil) ;; List of expressions to evaluate.
@@ -2398,8 +2384,6 @@ MSG is printed after `::::} '."
;; Emacs 19 adds an arg to mark and mark-marker.
(defalias 'edebug-mark-marker 'mark-marker)
-(defvar edebug-outside-unread-command-events)
-
(defun edebug--display (value offset-index arg-mode)
(unless (marker-position edebug-def-mark)
;; The buffer holding the source has been killed.
@@ -2421,7 +2405,6 @@ MSG is printed after `::::} '."
(edebug-outside-buffer (current-buffer))
(edebug-outside-point (point))
(edebug-outside-mark (edebug-mark))
- (edebug-outside-unread-command-events unread-command-events)
edebug-outside-windows ; Window or screen configuration.
edebug-buffer-points
@@ -2431,9 +2414,6 @@ MSG is printed after `::::} '."
edebug-trace-window
edebug-trace-window-start
- (edebug-outside-o-a-p overlay-arrow-position)
- (edebug-outside-o-a-s overlay-arrow-string)
- (edebug-outside-c-i-e-a cursor-in-echo-area)
(edebug-outside-d-c-i-n-s-w
(default-value 'cursor-in-non-selected-windows)))
(unwind-protect
@@ -2445,8 +2425,7 @@ MSG is printed after `::::} '."
)
(setq-default cursor-in-non-selected-windows t)
(if (not (buffer-name edebug-buffer))
- (let ((debug-on-error nil))
- (error "Buffer defining %s not found" edebug-function)))
+ (user-error "Buffer defining %s not found" edebug-function))
(if (eq 'after arg-mode)
;; Compute result string now before windows are modified.
@@ -2486,10 +2465,9 @@ MSG is printed after `::::} '."
;; Check whether positions are up-to-date.
;; This assumes point is never before symbol.
(if (not (memq (following-char) '(?\( ?\# ?\` )))
- (let ((debug-on-error nil))
- (error "Source has changed - reevaluate definition of %s"
- edebug-function)
- )))
+ (user-error "Source has changed - reevaluate definition of %s"
+ edebug-function)
+ ))
(setcdr edebug-window-data
(edebug-adjust-window (cdr edebug-window-data)))
@@ -2645,11 +2623,6 @@ MSG is printed after `::::} '."
(if edebug-eval-buffer (kill-buffer edebug-eval-buffer))
(with-timeout-unsuspend edebug-with-timeout-suspend)
;; Reset global variables to outside values in case they were changed.
- (setq
- unread-command-events edebug-outside-unread-command-events
- overlay-arrow-position edebug-outside-o-a-p
- overlay-arrow-string edebug-outside-o-a-s
- cursor-in-echo-area edebug-outside-c-i-e-a)
(setq-default cursor-in-non-selected-windows edebug-outside-d-c-i-n-s-w)
)))
@@ -2667,27 +2640,6 @@ MSG is printed after `::::} '."
(defvar edebug-inside-windows)
(defvar edebug-interactive-p)
-(defvar edebug-outside-map)
-(defvar edebug-outside-standard-output)
-(defvar edebug-outside-standard-input)
-(defvar edebug-outside-current-prefix-arg)
-(defvar edebug-outside-last-command)
-(defvar edebug-outside-this-command)
-
-;; Note: here we have defvars for variables that are
-;; built-in in certain versions.
-;; Each defvar makes a difference
-;; in versions where the variable is *not* built-in.
-
-;; Emacs 18 FIXME
-
-;; Emacs 19.
-(defvar edebug-outside-last-command-event)
-(defvar edebug-outside-last-input-event)
-(defvar edebug-outside-last-event-frame)
-(defvar edebug-outside-last-nonmenu-event)
-(defvar edebug-outside-track-mouse)
-
(defun edebug--recursive-edit (arg-mode)
;; Start up a recursive edit inside of edebug.
;; The current buffer is the edebug-buffer, which is put into edebug-mode.
@@ -2705,28 +2657,6 @@ MSG is printed after `::::} '."
;; The window configuration may be saved and restored
;; during a recursive-edit
edebug-inside-windows
-
- ;; Save the outside value of executing macro. (here??)
- (edebug-outside-executing-macro executing-kbd-macro)
- (edebug-outside-pre-command-hook
- (edebug-var-status 'pre-command-hook))
- (edebug-outside-post-command-hook
- (edebug-var-status 'post-command-hook))
-
- (edebug-outside-standard-output standard-output)
- (edebug-outside-standard-input standard-input)
- (edebug-outside-defining-kbd-macro defining-kbd-macro)
-
- (edebug-outside-last-command last-command)
- (edebug-outside-this-command this-command)
-
- (edebug-outside-current-prefix-arg current-prefix-arg)
-
- (edebug-outside-last-input-event last-input-event)
- (edebug-outside-last-command-event last-command-event)
- (edebug-outside-last-event-frame last-event-frame)
- (edebug-outside-last-nonmenu-event last-nonmenu-event)
- (edebug-outside-track-mouse track-mouse)
)
(unwind-protect
@@ -2757,7 +2687,7 @@ MSG is printed after `::::} '."
(overriding-local-map nil)
(overriding-terminal-local-map nil)
- ;; Bind again to outside values.
+ ;; Bind again to outside values.
(debug-on-error edebug-outside-debug-on-error)
(debug-on-quit edebug-outside-debug-on-quit)
@@ -2805,27 +2735,7 @@ MSG is printed after `::::} '."
;; gotta have a buffer to let its buffer local variables be set
(get-buffer-create " bogus edebug buffer"))
));; inner let
-
- ;; Reset global vars to outside values, in case they have been changed.
- (setq
- last-command-event edebug-outside-last-command-event
- last-command edebug-outside-last-command
- this-command edebug-outside-this-command
- current-prefix-arg edebug-outside-current-prefix-arg
- last-input-event edebug-outside-last-input-event
- last-event-frame edebug-outside-last-event-frame
- last-nonmenu-event edebug-outside-last-nonmenu-event
- track-mouse edebug-outside-track-mouse
-
- standard-output edebug-outside-standard-output
- standard-input edebug-outside-standard-input
- defining-kbd-macro edebug-outside-defining-kbd-macro)
-
- (setq executing-kbd-macro edebug-outside-executing-macro)
- (edebug-restore-status
- 'post-command-hook edebug-outside-post-command-hook)
- (edebug-restore-status
- 'pre-command-hook edebug-outside-pre-command-hook))))
+ )))
;;; Display related functions
@@ -3423,6 +3333,9 @@ edebug-mode."
(defmacro edebug-outside-excursion (&rest body)
"Evaluate an expression list in the outside context.
Return the result of the last expression."
+ ;; Only restores the non-variables context since all the variables let-bound
+ ;; by Edebug will be properly reset to the appropriate context's value by
+ ;; backtrace-eval.
(declare (debug t))
`(save-excursion ; of current-buffer
(if edebug-save-windows
@@ -3435,89 +3348,32 @@ Return the result of the last expression."
(edebug-set-windows edebug-outside-windows)))
(set-buffer edebug-buffer) ; why?
- ;; (use-local-map edebug-outside-map)
(set-match-data edebug-outside-match-data)
;; Restore outside context.
- (let (;; (edebug-inside-map (current-local-map)) ;; restore map??
- (last-command-event edebug-outside-last-command-event)
- (last-command edebug-outside-last-command)
- (this-command edebug-outside-this-command)
- (unread-command-events edebug-outside-unread-command-events)
- (current-prefix-arg edebug-outside-current-prefix-arg)
- (last-input-event edebug-outside-last-input-event)
- (last-event-frame edebug-outside-last-event-frame)
- (last-nonmenu-event edebug-outside-last-nonmenu-event)
- (track-mouse edebug-outside-track-mouse)
- (standard-output edebug-outside-standard-output)
- (standard-input edebug-outside-standard-input)
-
- (executing-kbd-macro edebug-outside-executing-macro)
- (defining-kbd-macro edebug-outside-defining-kbd-macro)
- ;; Get the values out of the saved statuses.
- (pre-command-hook (cdr edebug-outside-pre-command-hook))
- (post-command-hook (cdr edebug-outside-post-command-hook))
-
- ;; See edebug-display.
- (overlay-arrow-position edebug-outside-o-a-p)
- (overlay-arrow-string edebug-outside-o-a-s)
- (cursor-in-echo-area edebug-outside-c-i-e-a)
- )
- (setq-default cursor-in-non-selected-windows edebug-outside-d-c-i-n-s-w)
- (unwind-protect
- (with-current-buffer edebug-outside-buffer ; of edebug-buffer
- (goto-char edebug-outside-point)
- (if (marker-buffer (edebug-mark-marker))
- (set-marker (edebug-mark-marker) edebug-outside-mark))
- ,@body)
-
- ;; Back to edebug-buffer. Restore rest of inside context.
- ;; (use-local-map edebug-inside-map)
- (if edebug-save-windows
- ;; Restore inside windows.
- (edebug-set-windows edebug-inside-windows))
-
- ;; Save values that may have been changed.
- (setq
- edebug-outside-last-command-event last-command-event
- edebug-outside-last-command last-command
- edebug-outside-this-command this-command
- edebug-outside-unread-command-events unread-command-events
- edebug-outside-current-prefix-arg current-prefix-arg
- edebug-outside-last-input-event last-input-event
- edebug-outside-last-event-frame last-event-frame
- edebug-outside-last-nonmenu-event last-nonmenu-event
- edebug-outside-track-mouse track-mouse
- edebug-outside-standard-output standard-output
- edebug-outside-standard-input standard-input
-
- edebug-outside-executing-macro executing-kbd-macro
- edebug-outside-defining-kbd-macro defining-kbd-macro
-
- edebug-outside-o-a-p overlay-arrow-position
- edebug-outside-o-a-s overlay-arrow-string
- edebug-outside-c-i-e-a cursor-in-echo-area
- edebug-outside-d-c-i-n-s-w (default-value
- 'cursor-in-non-selected-windows)
- )
-
- ;; Restore the outside saved values; don't alter
- ;; the outside binding loci.
- (setcdr edebug-outside-pre-command-hook pre-command-hook)
- (setcdr edebug-outside-post-command-hook post-command-hook)
-
- (setq-default cursor-in-non-selected-windows t)
- )) ; let
- ))
-
-(defvar cl-debug-env) ; defined in cl; non-nil when lexical env used.
+ (setq-default cursor-in-non-selected-windows edebug-outside-d-c-i-n-s-w)
+ (unwind-protect
+ (with-current-buffer edebug-outside-buffer ; of edebug-buffer
+ (goto-char edebug-outside-point)
+ (if (marker-buffer (edebug-mark-marker))
+ (set-marker (edebug-mark-marker) edebug-outside-mark))
+ ,@body)
+
+ ;; Back to edebug-buffer. Restore rest of inside context.
+ ;; (use-local-map edebug-inside-map)
+ (if edebug-save-windows
+ ;; Restore inside windows.
+ (edebug-set-windows edebug-inside-windows))
+
+ ;; Save values that may have been changed.
+ (setq edebug-outside-d-c-i-n-s-w
+ (default-value 'cursor-in-non-selected-windows))
+
+ ;; Restore the outside saved values; don't alter
+ ;; the outside binding loci.
+ (setq-default cursor-in-non-selected-windows t))))
(defun edebug-eval (expr)
- ;; Are there cl lexical variables active?
- (eval (if (and (bound-and-true-p cl-debug-env)
- (fboundp 'cl-macroexpand-all))
- (cl-macroexpand-all expr cl-debug-env)
- expr)
- lexical-binding))
+ (backtrace-eval expr 0 'edebug-after))
(defun edebug-safe-eval (expr)
;; Evaluate EXPR safely.
@@ -4268,7 +4124,7 @@ With prefix argument, make it a temporary breakpoint."
(eq (nth 1 (nth 1 frame1)) '())
(eq (nth 1 frame2) 'edebug-enter))
;; `edebug-enter' calls itself on its first invocation.
- (if (eq (nth 1 (internal--called-interactively-p--get-frame i))
+ (if (eq (nth 1 (backtrace-frame i 'called-interactively-p))
'edebug-enter)
2 1)))
diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el
index 8b149aad7bb..edcfc409085 100644
--- a/lisp/emacs-lisp/nadvice.el
+++ b/lisp/emacs-lisp/nadvice.el
@@ -425,7 +425,7 @@ of the piece of advice."
(get-next-frame
(lambda ()
(setq frame1 frame2)
- (setq frame2 (internal--called-interactively-p--get-frame i))
+ (setq frame2 (backtrace-frame i #'called-interactively-p))
;; (message "Advice Frame %d = %S" i frame2)
(setq i (1+ i)))))
(when (and (eq (nth 1 frame2) 'apply)
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 32339249085..68d2880d33e 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -1393,7 +1393,7 @@ Letters do not insert themselves; instead, they are commands.
("Description" 0 nil)])
(setq tabulated-list-padding 2)
(setq tabulated-list-sort-key (cons "Status" nil))
- (add-hook 'tabulated-list-revert-hook 'package-menu--refresh)
+ (add-hook 'tabulated-list-revert-hook 'package-menu--refresh nil t)
(tabulated-list-init-header))
(defmacro package--push (pkg-desc status listname)
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 511f1480099..50c92518b02 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -659,11 +659,15 @@ Otherwise, it defers to REST which is a list of branches of the form
(memq-fine t))
(when all
(dolist (alt (cdr upat))
- (unless (or (pcase--self-quoting-p alt)
- (and (eq (car-safe alt) '\`)
- (or (symbolp (cadr alt)) (integerp (cadr alt))
- (setq memq-fine nil)
- (stringp (cadr alt)))))
+ (unless (if (pcase--self-quoting-p alt)
+ (progn
+ (unless (or (symbolp alt) (integerp alt))
+ (setq memq-fine nil))
+ t)
+ (and (eq (car-safe alt) '\`)
+ (or (symbolp (cadr alt)) (integerp (cadr alt))
+ (setq memq-fine nil)
+ (stringp (cadr alt)))))
(setq all nil))))
(if all
;; Use memq for (or `a `b `c `d) rather than a big tree.
diff --git a/lisp/epa-mail.el b/lisp/epa-mail.el
index 6ba29d3748f..896fc2a954e 100644
--- a/lisp/epa-mail.el
+++ b/lisp/epa-mail.el
@@ -109,94 +109,127 @@ If no one is selected, default secret key is used. "
(if verbose
(epa--read-signature-type)
'clear)))))
- (epa-sign-region start end signers mode))
+ (let ((inhibit-read-only t))
+ (epa-sign-region start end signers mode)))
+
+(defun epa-mail-default-recipients ()
+ "Return the default list of encryption recipients for a mail buffer."
+ (let ((config (epg-configuration))
+ recipients-string real-recipients)
+ (save-excursion
+ (goto-char (point-min))
+ (save-restriction
+ (narrow-to-region (point)
+ (if (search-forward mail-header-separator nil 0)
+ (match-beginning 0)
+ (point)))
+ (setq recipients-string
+ (mapconcat #'identity
+ (nconc (mail-fetch-field "to" nil nil t)
+ (mail-fetch-field "cc" nil nil t)
+ (mail-fetch-field "bcc" nil nil t))
+ ","))
+ (setq recipients-string
+ (mail-strip-quoted-names
+ (with-temp-buffer
+ (insert "to: " recipients-string "\n")
+ (expand-mail-aliases (point-min) (point-max))
+ (car (mail-fetch-field "to" nil nil t))))))
+
+ (setq real-recipients
+ (split-string recipients-string "," t "[ \t\n]*"))
+
+ ;; Process all the recipients thru the list of GnuPG groups.
+ ;; Expand GnuPG group names to what they stand for.
+ (setq real-recipients
+ (apply #'nconc
+ (mapcar
+ (lambda (recipient)
+ (or (epg-expand-group config recipient)
+ (list recipient)))
+ real-recipients)))
+
+ ;; Process all the recipients thru the user's list
+ ;; of encryption aliases.
+ (setq real-recipients
+ (apply #'nconc
+ (mapcar
+ (lambda (recipient)
+ (let ((tem (assoc recipient epa-mail-aliases)))
+ (if tem (cdr tem)
+ (list recipient))))
+ real-recipients)))
+ )))
;;;###autoload
-(defun epa-mail-encrypt (start end recipients sign signers)
- "Encrypt the current buffer.
-The buffer is expected to contain a mail message.
+(defun epa-mail-encrypt (&optional recipients signers)
+ "Encrypt the outgoing mail message in the current buffer.
+Takes the recipients from the text in the header in the buffer
+and translates them through `epa-mail-aliases'.
+With prefix argument, asks you to select among them interactively
+and also whether and how to sign.
-Don't use this command in Lisp programs!"
+Called from Lisp, the optional argument RECIPIENTS is a list
+of recipient addresses, t to perform symmetric encryption,
+or nil meaning use the defaults.
+
+SIGNERS is a list of keys to sign the message with."
(interactive
- (save-excursion
- (let ((verbose current-prefix-arg)
- (config (epg-configuration))
- (context (epg-make-context epa-protocol))
- recipients-string recipients recipient-key sign)
- (goto-char (point-min))
- (save-restriction
- (narrow-to-region (point)
- (if (search-forward mail-header-separator nil 0)
- (match-beginning 0)
- (point)))
- (setq recipients-string
- (mapconcat #'identity
- (nconc (mail-fetch-field "to" nil nil t)
- (mail-fetch-field "cc" nil nil t)
- (mail-fetch-field "bcc" nil nil t))
- ","))
- (setq recipients
- (mail-strip-quoted-names
- (with-temp-buffer
- (insert "to: " recipients-string "\n")
- (expand-mail-aliases (point-min) (point-max))
- (car (mail-fetch-field "to" nil nil t))))))
- (if recipients
- (setq recipients (delete ""
- (split-string recipients
- "[ \t\n]*,[ \t\n]*"))))
-
- ;; Process all the recipients thru the list of GnuPG groups.
- ;; Expand GnuPG group names to what they stand for.
- (setq recipients
- (apply #'nconc
- (mapcar
- (lambda (recipient)
- (or (epg-expand-group config recipient)
- (list recipient)))
- recipients)))
-
- (goto-char (point-min))
- (if (search-forward mail-header-separator nil t)
- (forward-line))
- (setq epa-last-coding-system-specified
- (or coding-system-for-write
- (epa--select-safe-coding-system (point) (point-max))))
- (list (point) (point-max)
- (if verbose
- (epa-select-keys
- context
- "Select recipients for encryption.
+ (let ((verbose current-prefix-arg)
+ (context (epg-make-context epa-protocol)))
+ (list (if verbose
+ (or (epa-select-keys
+ context
+ "Select recipients for encryption.
If no one is selected, symmetric encryption will be performed. "
- recipients)
- (if recipients
+ (epa-mail-default-recipients))
+ t))
+ (and verbose (y-or-n-p "Sign? ")
+ (epa-select-keys context
+ "Select keys for signing. ")))))
+ (let (start recipient-keys default-recipients)
+ (save-excursion
+ (setq recipient-keys
+ (cond ((eq recipients t)
+ nil)
+ (recipients recipients)
+ (t
+ (setq default-recipients
+ (epa-mail-default-recipients))
+ ;; Convert recipients to keys.
(apply
'nconc
(mapcar
(lambda (recipient)
- (setq recipient-key
- (epa-mail--find-usable-key
- (epg-list-keys
- (epg-make-context epa-protocol)
- (if (string-match "@" recipient)
- (concat "<" recipient ">")
- recipient))
- 'encrypt))
- (unless (or recipient-key
- (y-or-n-p
- (format
- "No public key for %s; skip it? "
- recipient)))
- (error "No public key for %s" recipient))
- (if recipient-key (list recipient-key)))
- recipients))))
- (setq sign (if verbose (y-or-n-p "Sign? ")))
- (if sign
- (epa-select-keys context
- "Select keys for signing. "))))))
- ;; Don't let some read-only text stop us from encrypting.
- (let ((inhibit-read-only t))
- (epa-encrypt-region start end recipients sign signers)))
+ (let ((recipient-key
+ (epa-mail--find-usable-key
+ (epg-list-keys
+ (epg-make-context epa-protocol)
+ (if (string-match "@" recipient)
+ (concat "<" recipient ">")
+ recipient))
+ 'encrypt)))
+ (unless (or recipient-key
+ (y-or-n-p
+ (format
+ "No public key for %s; skip it? "
+ recipient)))
+ (error "No public key for %s" recipient))
+ (if recipient-key (list recipient-key))))
+ default-recipients)))))
+
+ (goto-char (point-min))
+ (if (search-forward mail-header-separator nil t)
+ (forward-line))
+ (setq start (point))
+
+ (setq epa-last-coding-system-specified
+ (or coding-system-for-write
+ (epa--select-safe-coding-system (point) (point-max)))))
+
+ ;; Don't let some read-only text stop us from encrypting.
+ (let ((inhibit-read-only t))
+ (epa-encrypt-region start (point-max) recipient-keys signers signers))))
;;;###autoload
(defun epa-mail-import-keys ()
diff --git a/lisp/epa.el b/lisp/epa.el
index 14f8879c1c6..a99fb9230e1 100644
--- a/lisp/epa.el
+++ b/lisp/epa.el
@@ -34,8 +34,7 @@
:group 'epg)
(defcustom epa-popup-info-window t
- "If non-nil, status information from epa commands is displayed on
-the separate window."
+ "If non-nil, display status information from epa commands in another window."
:type 'boolean
:group 'epa)
@@ -49,6 +48,18 @@ the separate window."
:version "23.1"
:group 'epa)
+(defcustom epa-mail-aliases nil
+ "Alist of aliases of email addresses that stand for encryption keys.
+Each element is (ALIAS EXPANSIONS...).
+It means that when a message is addressed to ALIAS,
+instead of encrypting it for ALIAS, encrypt it for EXPANSIONS...
+If EXPANSIONS is empty, ignore ALIAS as regards encryption.
+That is a handy way to avoid warnings about addresses
+that you don't have any key for."
+ :type '(repeat (cons (string :tag "Alias") (repeat '(string :tag "Expansion"))))
+ :group 'epa
+ :version "24.4")
+
(defface epa-validity-high
'((default :weight bold)
(((class color) (background dark)) :foreground "PaleTurquoise"))
diff --git a/lisp/ffap.el b/lisp/ffap.el
index 0769469cbf2..70096248e19 100644
--- a/lisp/ffap.el
+++ b/lisp/ffap.el
@@ -459,7 +459,8 @@ Returned values:
(let ((mesg (car (cdr error))))
(cond
;; v18:
- ((string-match "^Unknown host" mesg) nil)
+ ((string-match "\\(^Unknown host\\|Name or service not known$\\)"
+ mesg) nil)
((string-match "not responding$" mesg) mesg)
;; v19:
;; (file-error "connection failed" "permission denied"
diff --git a/lisp/filenotify.el b/lisp/filenotify.el
index e170db2dd5f..d2f37b99107 100644
--- a/lisp/filenotify.el
+++ b/lisp/filenotify.el
@@ -27,8 +27,7 @@
;;; Code:
-;;;###autoload
-(defconst file-notify-support
+(defconst file-notify--library
(cond
((featurep 'gfilenotify) 'gfilenotify)
((featurep 'inotify) 'inotify)
@@ -238,7 +237,7 @@ FILE is the name of the file whose event is being reported."
(let* ((handler (find-file-name-handler file 'file-notify-add-watch))
(dir (directory-file-name
- (if (or (and (not handler) (eq file-notify-support 'w32notify))
+ (if (or (and (not handler) (eq file-notify--library 'w32notify))
(file-directory-p file))
file
(file-name-directory file))))
@@ -259,32 +258,33 @@ FILE is the name of the file whose event is being reported."
;; Check, whether Emacs has been compiled with file
;; notification support.
- (unless file-notify-support
+ (unless file-notify--library
(signal 'file-notify-error
'("No file notification package available")))
;; Determine low-level function to be called.
- (setq func (cond
- ((eq file-notify-support 'gfilenotify) 'gfile-add-watch)
- ((eq file-notify-support 'inotify) 'inotify-add-watch)
- ((eq file-notify-support 'w32notify) 'w32notify-add-watch)))
+ (setq func
+ (cond
+ ((eq file-notify--library 'gfilenotify) 'gfile-add-watch)
+ ((eq file-notify--library 'inotify) 'inotify-add-watch)
+ ((eq file-notify--library 'w32notify) 'w32notify-add-watch)))
;; Determine respective flags.
- (if (eq file-notify-support 'gfilenotify)
+ (if (eq file-notify--library 'gfilenotify)
(setq l-flags '(watch-mounts send-moved))
(when (memq 'change flags)
(setq
l-flags
(cond
- ((eq file-notify-support 'inotify) '(create modify move delete))
- ((eq file-notify-support 'w32notify)
+ ((eq file-notify--library 'inotify) '(create modify move delete))
+ ((eq file-notify--library 'w32notify)
'(file-name directory-name size last-write-time)))))
(when (memq 'attribute-change flags)
(add-to-list
'l-flags
(cond
- ((eq file-notify-support 'inotify) 'attrib)
- ((eq file-notify-support 'w32notify) 'attributes)))))
+ ((eq file-notify--library 'inotify) 'attrib)
+ ((eq file-notify--library 'w32notify) 'attributes)))))
;; Call low-level function.
(setq desc (funcall func dir l-flags 'file-notify-callback))))
@@ -311,9 +311,9 @@ DESCRIPTOR should be an object returned by `file-notify-add-watch'."
(funcall handler 'file-notify-rm-watch descriptor)
(funcall
(cond
- ((eq file-notify-support 'gfilenotify) 'gfile-rm-watch)
- ((eq file-notify-support 'inotify) 'inotify-rm-watch)
- ((eq file-notify-support 'w32notify) 'w32notify-rm-watch))
+ ((eq file-notify--library 'gfilenotify) 'gfile-rm-watch)
+ ((eq file-notify--library 'inotify) 'inotify-rm-watch)
+ ((eq file-notify--library 'w32notify) 'w32notify-rm-watch))
descriptor)))
(remhash descriptor file-notify-descriptors)))
diff --git a/lisp/files.el b/lisp/files.el
index ff4ccec2279..10d66e0b2e0 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -5246,10 +5246,12 @@ comparison."
(put 'revert-buffer-function 'permanent-local t)
-(defvar revert-buffer-function nil
+(defvar revert-buffer-function #'revert-buffer--default
"Function to use to revert this buffer, or nil to do the default.
The function receives two arguments IGNORE-AUTO and NOCONFIRM,
-which are the arguments that `revert-buffer' received.")
+which are the arguments that `revert-buffer' received.
+It also has access to the `preserve-modes' argument of `revert-buffer'
+via the `revert-buffer-preserve-modes' dynamic variable.")
(put 'revert-buffer-insert-file-contents-function 'permanent-local t)
(defvar revert-buffer-insert-file-contents-function nil
@@ -5296,6 +5298,11 @@ This is true even if a `revert-buffer-function' is being used.")
(defvar revert-buffer-internal-hook)
+;; `revert-buffer-function' was defined long ago to be a function of only
+;; 2 arguments, so we have to use a dynbind variable to pass the
+;; `preserve-modes' argument of `revert-buffer'.
+(defvar revert-buffer-preserve-modes)
+
(defun revert-buffer (&optional ignore-auto noconfirm preserve-modes)
"Replace current buffer text with the text of the visited file on disk.
This undoes all changes since the file was visited or saved.
@@ -5337,112 +5344,113 @@ non-nil, it is called instead of rereading visited file contents."
;; reversal of the argument sense. So I'm just changing the user
;; interface, but leaving the programmatic interface the same.
(interactive (list (not current-prefix-arg)))
- (if revert-buffer-function
- (let ((revert-buffer-in-progress-p t))
- (funcall revert-buffer-function ignore-auto noconfirm))
- (with-current-buffer (or (buffer-base-buffer (current-buffer))
- (current-buffer))
- (let* ((revert-buffer-in-progress-p t)
- (auto-save-p (and (not ignore-auto)
- (recent-auto-save-p)
- buffer-auto-save-file-name
- (file-readable-p buffer-auto-save-file-name)
- (y-or-n-p
- "Buffer has been auto-saved recently. Revert from auto-save file? ")))
- (file-name (if auto-save-p
- buffer-auto-save-file-name
- buffer-file-name)))
- (cond ((null file-name)
- (error "Buffer does not seem to be associated with any file"))
- ((or noconfirm
- (and (not (buffer-modified-p))
- (catch 'found
- (dolist (regexp revert-without-query)
- (when (string-match regexp file-name)
- (throw 'found t)))))
- (yes-or-no-p (format "Revert buffer from file %s? "
- file-name)))
- (run-hooks 'before-revert-hook)
- ;; If file was backed up but has changed since,
- ;; we should make another backup.
- (and (not auto-save-p)
- (not (verify-visited-file-modtime (current-buffer)))
- (setq buffer-backed-up nil))
- ;; Effectively copy the after-revert-hook status,
- ;; since after-find-file will clobber it.
- (let ((global-hook (default-value 'after-revert-hook))
- (local-hook (when (local-variable-p 'after-revert-hook)
- after-revert-hook))
- (inhibit-read-only t))
- (cond
- (revert-buffer-insert-file-contents-function
- (unless (eq buffer-undo-list t)
- ;; Get rid of all undo records for this buffer.
- (setq buffer-undo-list nil))
- ;; Don't make undo records for the reversion.
- (let ((buffer-undo-list t))
- (funcall revert-buffer-insert-file-contents-function
- file-name auto-save-p)))
- ((not (file-exists-p file-name))
- (error (if buffer-file-number
- "File %s no longer exists!"
- "Cannot revert nonexistent file %s")
- file-name))
- ((not (file-readable-p file-name))
- (error (if buffer-file-number
- "File %s no longer readable!"
- "Cannot revert unreadable file %s")
- file-name))
- (t
- ;; Bind buffer-file-name to nil
- ;; so that we don't try to lock the file.
- (let ((buffer-file-name nil))
- (or auto-save-p
- (unlock-buffer)))
- (widen)
- (let ((coding-system-for-read
- ;; Auto-saved file should be read by Emacs's
- ;; internal coding.
- (if auto-save-p 'auto-save-coding
- (or coding-system-for-read
- (and
- buffer-file-coding-system-explicit
- (car buffer-file-coding-system-explicit))))))
- (if (and (not enable-multibyte-characters)
- coding-system-for-read
- (not (memq (coding-system-base
- coding-system-for-read)
- '(no-conversion raw-text))))
- ;; As a coding system suitable for multibyte
- ;; buffer is specified, make the current
- ;; buffer multibyte.
- (set-buffer-multibyte t))
-
- ;; This force after-insert-file-set-coding
- ;; (called from insert-file-contents) to set
- ;; buffer-file-coding-system to a proper value.
- (kill-local-variable 'buffer-file-coding-system)
-
- ;; Note that this preserves point in an intelligent way.
- (if preserve-modes
- (let ((buffer-file-format buffer-file-format))
- (insert-file-contents file-name (not auto-save-p)
- nil nil t))
- (insert-file-contents file-name (not auto-save-p)
- nil nil t)))))
- ;; Recompute the truename in case changes in symlinks
- ;; have changed the truename.
- (setq buffer-file-truename
- (abbreviate-file-name (file-truename buffer-file-name)))
- (after-find-file nil nil t nil preserve-modes)
- ;; Run after-revert-hook as it was before we reverted.
- (setq-default revert-buffer-internal-hook global-hook)
- (if local-hook
- (set (make-local-variable 'revert-buffer-internal-hook)
- local-hook)
- (kill-local-variable 'revert-buffer-internal-hook))
- (run-hooks 'revert-buffer-internal-hook))
- t))))))
+ (let ((revert-buffer-in-progress-p t)
+ (revert-buffer-preserve-modes preserve-modes))
+ (funcall (or revert-buffer-function #'revert-buffer--default)
+ ignore-auto noconfirm)))
+(defun revert-buffer--default (ignore-auto noconfirm)
+ (with-current-buffer (or (buffer-base-buffer (current-buffer))
+ (current-buffer))
+ (let* ((auto-save-p (and (not ignore-auto)
+ (recent-auto-save-p)
+ buffer-auto-save-file-name
+ (file-readable-p buffer-auto-save-file-name)
+ (y-or-n-p
+ "Buffer has been auto-saved recently. Revert from auto-save file? ")))
+ (file-name (if auto-save-p
+ buffer-auto-save-file-name
+ buffer-file-name)))
+ (cond ((null file-name)
+ (error "Buffer does not seem to be associated with any file"))
+ ((or noconfirm
+ (and (not (buffer-modified-p))
+ (catch 'found
+ (dolist (regexp revert-without-query)
+ (when (string-match regexp file-name)
+ (throw 'found t)))))
+ (yes-or-no-p (format "Revert buffer from file %s? "
+ file-name)))
+ (run-hooks 'before-revert-hook)
+ ;; If file was backed up but has changed since,
+ ;; we should make another backup.
+ (and (not auto-save-p)
+ (not (verify-visited-file-modtime (current-buffer)))
+ (setq buffer-backed-up nil))
+ ;; Effectively copy the after-revert-hook status,
+ ;; since after-find-file will clobber it.
+ (let ((global-hook (default-value 'after-revert-hook))
+ (local-hook (when (local-variable-p 'after-revert-hook)
+ after-revert-hook))
+ (inhibit-read-only t))
+ (cond
+ (revert-buffer-insert-file-contents-function
+ (unless (eq buffer-undo-list t)
+ ;; Get rid of all undo records for this buffer.
+ (setq buffer-undo-list nil))
+ ;; Don't make undo records for the reversion.
+ (let ((buffer-undo-list t))
+ (funcall revert-buffer-insert-file-contents-function
+ file-name auto-save-p)))
+ ((not (file-exists-p file-name))
+ (error (if buffer-file-number
+ "File %s no longer exists!"
+ "Cannot revert nonexistent file %s")
+ file-name))
+ ((not (file-readable-p file-name))
+ (error (if buffer-file-number
+ "File %s no longer readable!"
+ "Cannot revert unreadable file %s")
+ file-name))
+ (t
+ ;; Bind buffer-file-name to nil
+ ;; so that we don't try to lock the file.
+ (let ((buffer-file-name nil))
+ (or auto-save-p
+ (unlock-buffer)))
+ (widen)
+ (let ((coding-system-for-read
+ ;; Auto-saved file should be read by Emacs's
+ ;; internal coding.
+ (if auto-save-p 'auto-save-coding
+ (or coding-system-for-read
+ (and
+ buffer-file-coding-system-explicit
+ (car buffer-file-coding-system-explicit))))))
+ (if (and (not enable-multibyte-characters)
+ coding-system-for-read
+ (not (memq (coding-system-base
+ coding-system-for-read)
+ '(no-conversion raw-text))))
+ ;; As a coding system suitable for multibyte
+ ;; buffer is specified, make the current
+ ;; buffer multibyte.
+ (set-buffer-multibyte t))
+
+ ;; This force after-insert-file-set-coding
+ ;; (called from insert-file-contents) to set
+ ;; buffer-file-coding-system to a proper value.
+ (kill-local-variable 'buffer-file-coding-system)
+
+ ;; Note that this preserves point in an intelligent way.
+ (if revert-buffer-preserve-modes
+ (let ((buffer-file-format buffer-file-format))
+ (insert-file-contents file-name (not auto-save-p)
+ nil nil t))
+ (insert-file-contents file-name (not auto-save-p)
+ nil nil t)))))
+ ;; Recompute the truename in case changes in symlinks
+ ;; have changed the truename.
+ (setq buffer-file-truename
+ (abbreviate-file-name (file-truename buffer-file-name)))
+ (after-find-file nil nil t nil revert-buffer-preserve-modes)
+ ;; Run after-revert-hook as it was before we reverted.
+ (setq-default revert-buffer-internal-hook global-hook)
+ (if local-hook
+ (set (make-local-variable 'revert-buffer-internal-hook)
+ local-hook)
+ (kill-local-variable 'revert-buffer-internal-hook))
+ (run-hooks 'revert-buffer-internal-hook))
+ t)))))
(defun recover-this-file ()
"Recover the visited file--get contents from its last auto-save file."
diff --git a/lisp/frame.el b/lisp/frame.el
index 3ac24a509a0..71e7cc10de2 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -1671,6 +1671,16 @@ left untouched. FRAME nil or omitted means use the selected frame."
:type 'number
:group 'cursor)
+(defcustom blink-cursor-blinks 10
+ "How many times to blink before using a solid cursor on NS and X.
+Use 0 or negative value to blink forever."
+ :version "24.4"
+ :type 'integer
+ :group 'cursor)
+
+(defvar blink-cursor-blinks-done 1
+ "Number of blinks done since we started blinking on NS and X")
+
(defvar blink-cursor-idle-timer nil
"Timer started after `blink-cursor-delay' seconds of Emacs idle time.
The function `blink-cursor-start' is called when the timer fires.")
@@ -1688,6 +1698,7 @@ command starts, by installing a pre-command hook."
(when (null blink-cursor-timer)
;; Set up the timer first, so that if this signals an error,
;; blink-cursor-end is not added to pre-command-hook.
+ (setq blink-cursor-blinks-done 1)
(setq blink-cursor-timer
(run-with-timer blink-cursor-interval blink-cursor-interval
'blink-cursor-timer-function))
@@ -1696,7 +1707,15 @@ command starts, by installing a pre-command hook."
(defun blink-cursor-timer-function ()
"Timer function of timer `blink-cursor-timer'."
- (internal-show-cursor nil (not (internal-show-cursor-p))))
+ (internal-show-cursor nil (not (internal-show-cursor-p)))
+ ;; Each blink is two calls to this function.
+ (when (memq window-system '(x ns w32))
+ (setq blink-cursor-blinks-done (1+ blink-cursor-blinks-done))
+ (when (and (> blink-cursor-blinks 0)
+ (<= (* 2 blink-cursor-blinks) blink-cursor-blinks-done))
+ (blink-cursor-suspend)
+ (add-hook 'post-command-hook 'blink-cursor-check))))
+
(defun blink-cursor-end ()
"Stop cursor blinking.
@@ -1709,6 +1728,29 @@ itself as a pre-command hook."
(cancel-timer blink-cursor-timer)
(setq blink-cursor-timer nil)))
+(defun blink-cursor-suspend ()
+ "Suspend cursor blinking on NS, X and W32.
+This is called when no frame has focus and timers can be suspended.
+Timers are restarted by `blink-cursor-check', which is called when a
+frame receives focus."
+ (when (memq window-system '(x ns w32))
+ (blink-cursor-end)
+ (when blink-cursor-idle-timer
+ (cancel-timer blink-cursor-idle-timer)
+ (setq blink-cursor-idle-timer nil))))
+
+(defun blink-cursor-check ()
+ "Check if cursor blinking shall be restarted.
+This is done when a frame gets focus. Blink timers may be stopped by
+`blink-cursor-suspend'."
+ (when (and blink-cursor-mode
+ (not blink-cursor-idle-timer))
+ (remove-hook 'post-command-hook 'blink-cursor-check)
+ (setq blink-cursor-idle-timer
+ (run-with-idle-timer blink-cursor-delay
+ blink-cursor-delay
+ 'blink-cursor-start))))
+
(define-obsolete-variable-alias 'blink-cursor 'blink-cursor-mode "22.1")
(define-minor-mode blink-cursor-mode
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 006b415b180..a67c55947ac 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,39 @@
+2013-07-25 Andreas Schwab <schwab@linux-m68k.org>
+
+ * gnus-art.el (gnus-button-url-regexp): Make it match url in which
+ punctuation characters follow parentheses (bug#14950).
+
+2013-07-23 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus.el (gnus-continuum-version):
+ * gnus-msg.el (gnus-extended-version): Simplify.
+
+ * gnus.el (gnus-continuum-version-1): Remove.
+ * gnus-msg.el (gnus-bug): Revert.
+
+ Calculate gnus-version correctly on Cygwin.
+
+ * gnus.el (gnus-continuum-version): Do main calculations in integers.
+ (gnus-continuum-version-1): New function, return a string.
+
+ * gnus-msg.el (gnus-extended-version, gnus-bug):
+ Use gnus-continuum-version-1 instead of gnus-continuum-version.
+
+2013-07-19 Geoff Kuenning <geoff@cs.hmc.edu> (tiny change)
+
+ * gnus-art.el (gnus-treat-predicate): Allow functions as predicates
+ (bug#13384).
+
+2013-07-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-start.el (gnus-clean-old-newsrc): Remove the newsrc cleanups
+ that were only relevant in a development version a long time ago.
+
+2013-07-18 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-shr-put-image): Make it work as well for shr.el's
+ that the old Emacs 24s bundle.
+
2013-07-10 David Engster <deng@randomsample.de>
* gnus-start.el (gnus-clean-old-newsrc): Always remove 'unexist' marks
@@ -143,7 +179,7 @@
2013-07-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus-sum.el (gnus-summary-insert-old-articles):
- Don't include unexistent messages.
+ Don't include unexisting messages.
2013-07-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -1861,7 +1897,7 @@
* nnmail.el (mail-send-and-exit): Silence the byte compiler.
-2012-06-26 Peter Munster <pmrb@free.fr>
+2012-06-26 Peter Münster <pmrb@free.fr>
* gnus-demon.el (gnus-demon-timers): Now a plist (function -> timer).
(gnus-demon-cancel): Ditto.
@@ -2088,7 +2124,7 @@
(spam-check-BBDB): Use it.
(spam-enter-ham-BBDB): Use it.
-2012-06-26 Peter Munster <pmrb@free.fr> (tiny change)
+2012-06-26 Peter Münster <pmrb@free.fr> (tiny change)
* gnus-group.el (gnus-group-get-new-news):
New parameter `one-level' for scanning exactly one level.
@@ -8451,7 +8487,7 @@
* nnimap.el (nnimap-request-group): Low higher than high to signal no
messages in empty groups.
-2010-10-01 Ted Zlatanov <tzz@lifelogs.com>
+2010-10-01 Teodor Zlatanov <tzz@lifelogs.com>
* nnimap.el (nnimap-request-group): Don't bug out when there's an empty
non-UIDNEXT group.
@@ -8592,7 +8628,7 @@
* nndraft.el (nndraft-request-expire-articles): Use the group name
instead if "nndraft". Fix found by Nils Ackermann.
-2010-09-29 Ludovic Courtes <ludo@gnu.org>
+2010-09-29 Ludovic Courtès <ludo@gnu.org>
* nnregistry.el: Add.
diff --git a/lisp/gnus/ChangeLog.1 b/lisp/gnus/ChangeLog.1
index 9043a23361e..9a71bc35b41 100644
--- a/lisp/gnus/ChangeLog.1
+++ b/lisp/gnus/ChangeLog.1
@@ -340,7 +340,7 @@
* nnmail.el (nnmail-spool-file): Allow lists of files.
-1998-08-20 Per Starback <starback@update.uu.se>
+1998-08-20 Per Starbäck <starback@update.uu.se>
* gnus/gnus-start.el (gnus-check-first-time-used): Change current
buffer before creating help group.
diff --git a/lisp/gnus/ChangeLog.2 b/lisp/gnus/ChangeLog.2
index 4ddd622ce9a..df223bd332b 100644
--- a/lisp/gnus/ChangeLog.2
+++ b/lisp/gnus/ChangeLog.2
@@ -210,7 +210,7 @@
* mml1991.el (mml1991-pgg-encrypt): Decode according to CTE before
encrypting.
-2003-12-28 Ivan Boldyrev <boldyrev@uiggm.nsc.ru> (tiny change).
+2003-12-28 Ivan Boldyrev <boldyrev@uiggm.nsc.ru> (tiny change)
* mml1991.el (mml1991-pgg-sign): Use unibyte when re-encoding.
@@ -4490,7 +4490,7 @@
* gnus-start.el (gnus-backup-startup-file): Fixed custom type.
-2003-02-24 Ted Zlatanov <tzz@lifelogs.com>
+2003-02-24 Teodor Zlatanov <tzz@lifelogs.com>
* spam.el: Disabled spam-get-article-as-filename.
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index b41ff9c0550..e65b9fb99e4 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -6197,9 +6197,14 @@ Provided for backwards compatibility."
(defun gnus-shr-put-image (data alt &optional flags)
"Put image DATA with a string ALT. Enable image to be deleted."
- (let ((image (shr-put-image data (propertize (or alt "*")
- 'gnus-image-category 'shr)
- flags)))
+ (let ((image (if flags
+ (shr-put-image data (propertize (or alt "*")
+ 'gnus-image-category 'shr)
+ flags)
+ ;; Old `shr-put-image' doesn't take the optional `flags'
+ ;; argument.
+ (shr-put-image data (propertize (or alt "*")
+ 'gnus-image-category 'shr)))))
(when image
(gnus-add-image 'shr image))))
@@ -7172,15 +7177,17 @@ groups."
"\\(?:"
;; Match paired parentheses, e.g. in Wikipedia URLs:
;; http://thread.gmane.org/47B4E3B2.3050402@gmail.com
- "[" chars punct "]+" "(" "[" chars punct "]+" "[" chars "]*)" "[" chars "]*"
+ "[" chars punct "]+" "(" "[" chars punct "]+" "[" chars "]*)"
+ "\\(?:" "[" chars punct "]+" "[" chars "]" "\\)?"
"\\|"
- "[" chars punct "]+" "[" chars "]"
+ "[" chars punct "]+" "[" chars "]"
"\\)"))
(concat ;; XEmacs 21.4 doesn't support POSIX.
"\\([-a-z0-9_=!?#$@~%&*+\\/:;.,]\\|\\w\\)+"
"\\([-a-z0-9_=#$@~%&*+\\/]\\|\\w\\)"))
"\\)")
"Regular expression that matches URLs."
+ :version "24.4"
:group 'gnus-article-buttons
:type 'regexp)
@@ -8414,6 +8421,8 @@ For example:
(not (gnus-treat-predicate (car val))))
((eq pred 'typep)
(equal (car val) gnus-treat-type))
+ ((functionp pred)
+ (funcall pred))
(t
(error "%S is not a valid predicate" pred)))))
((eq val t)
diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index e3f18662af4..0f78f2edc5f 100644
--- a/lisp/gnus/gnus-msg.el
+++ b/lisp/gnus/gnus-msg.el
@@ -1132,7 +1132,9 @@ See the variable `gnus-user-agent'."
(gnus-v
(when (memq 'gnus gnus-user-agent)
(concat "Gnus/"
- (prin1-to-string (gnus-continuum-version gnus-version) t)
+ (gnus-replace-in-string
+ (format "%1.8f" (gnus-continuum-version gnus-version))
+ "0+\\'" "")
" (" gnus-version ")")))
(emacs-v (gnus-emacs-version)))
(concat gnus-v (when (and gnus-v emacs-v) " ")
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index 94803800e0b..05cf290cac9 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -2305,24 +2305,8 @@ If FORCE is non-nil, the .newsrc file is read."
(gnus-clean-old-newsrc))))
(defun gnus-clean-old-newsrc (&optional force)
- (when gnus-newsrc-file-version
- ;; Remove totally bogus `unexists' entries. The name is
- ;; `unexist'.
- (dolist (info (cdr gnus-newsrc-alist))
- (let ((exist (assoc 'unexists (gnus-info-marks info))))
- (when exist
- (gnus-info-set-marks
- info (delete exist (gnus-info-marks info))))))
- (when (or force
- (not (string= gnus-newsrc-file-version gnus-version)))
- (message (concat "Removing unexist marks because newsrc "
- "version does not match Gnus version."))
- ;; Remove old `exist' marks from old nnimap groups.
- (dolist (info (cdr gnus-newsrc-alist))
- (let ((exist (assoc 'unexist (gnus-info-marks info))))
- (when exist
- (gnus-info-set-marks
- info (delete exist (gnus-info-marks info)))))))))
+ ;; Currently no cleanups.
+ )
(defun gnus-convert-old-newsrc ()
"Convert old newsrc formats into the current format, if needed."
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 9bae9f981bd..f3918b0a215 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -1525,7 +1525,7 @@ This list will always be a subset of gnus-newsgroup-undownloaded.")
"Range of seen articles in the current newsgroup.")
(defvar gnus-newsgroup-unexist nil
- "Range of unexistent articles in the current newsgroup.")
+ "Range of unexisting articles in the current newsgroup.")
(defvar gnus-newsgroup-articles nil
"List of articles in the current newsgroup.")
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index 8741a03b54d..409b1cc6255 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -3246,9 +3246,9 @@ If ARG, insert string at point."
0))
(string-to-number
(if (zerop major)
- (format "%s00%02d%02d"
+ (format "%1.2f00%02d%02d"
(if (member alpha '("(ding)" "d"))
- "4.99"
+ 4.99
(+ 5 (* 0.02
(abs
(- (mm-char-int (aref (downcase alpha) 0))
diff --git a/lisp/gnus/registry.el b/lisp/gnus/registry.el
index 37fe6440743..b056ac5e7f3 100644
--- a/lisp/gnus/registry.el
+++ b/lisp/gnus/registry.el
@@ -228,7 +228,7 @@ With assert non-nil, errors out if the key does not exist already."
(let ((entry (gethash key data)))
(when assert
(assert entry nil
- "Key %s does not exists in database" key))
+ "Key %s does not exist in database" key))
;; clean entry from the secondary indices
(dolist (tr tracked)
;; is this tracked symbol indexed?
diff --git a/lisp/ido.el b/lisp/ido.el
index 9c4e56544cb..d3c0e0f09f7 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -161,10 +161,10 @@
;; ---------------
;;
;; The standard way of completion with Unix-shells and Emacs is to insert a
-;; PREFIX and then hitting TAB (or another completion key). Cause of this
-;; behavior has become second nature to a lot of emacs users `ido' offers in
+;; PREFIX and then hitting TAB (or another completion key). Cause of this
+;; behavior has become second nature to a lot of Emacs users `ido' offers in
;; addition to the default substring-matching-method (look above) also the
-;; prefix-matching-method. The kind of matching is the only difference to
+;; prefix-matching-method. The kind of matching is the only difference to
;; the description of the substring-matching above.
;;
;; You can toggle prefix matching with C-p.
@@ -271,7 +271,7 @@
;; To use ido for all buffer and file selections in Emacs, customize the
;; variable `ido-everywhere'.
-;; Using ido-like behavior in other lisp packages
+;; Using ido-like behavior in other Lisp packages
;; -----------------------------------------------
;; If you don't want to rely on the `ido-everywhere' functionality,
@@ -312,7 +312,7 @@
;; so I invented a common "ido-" namespace for the merged packages.
;;
;; This version is based on ido.el version 1.57 released on
-;; gnu.emacs.sources adapted for emacs 22.1 to use command remapping
+;; gnu.emacs.sources adapted for Emacs 22.1 to use command remapping
;; and optionally hooking the read-buffer and read-file-name functions.
;;
;; Prefix matching was added by Klaus Berndl <klaus.berndl@sdm.de> based on
@@ -328,6 +328,7 @@
;; These are some things you might want to change.
(defun ido-fractionp (n)
+ "Return t if N is a fraction."
(and (numberp n) (> n 0.0) (<= n 1.0)))
(defgroup ido nil
@@ -340,13 +341,13 @@
;;;###autoload
(defcustom ido-mode nil
- "Determines for which functional group \(buffer and files) ido behavior
-should be enabled. The following values are possible:
-- `buffer': Turn only on ido buffer behavior \(switching, killing,
+ "Determines for which buffer/file Ido should be enabled.
+The following values are possible:
+- `buffer': Turn only on ido buffer behavior (switching, killing,
displaying...)
-- `file': Turn only on ido file behavior \(finding, writing, inserting...)
+- `file': Turn only on ido file behavior (finding, writing, inserting...)
- `both': Turn on ido buffer and file behavior.
-- `nil': Turn off any ido switching.
+- nil: Turn off any ido switching.
Setting this variable directly does not take effect;
use either \\[customize] or the function `ido-mode'."
@@ -528,15 +529,20 @@ Note that the non-ido equivalent command is recorded."
:group 'ido)
(defcustom ido-max-prospects 12
- "Non-zero means that the prospect list will be limited to that number of items.
-For a long list of prospects, building the full list for the minibuffer can take a
-non-negligible amount of time; setting this variable reduces that time."
+ "Upper limit of the prospect list if non-zero.
+Zero means no limit for the prospect list.
+For a long list of prospects, building the full list for the
+minibuffer can take a non-negligible amount of time; setting this
+variable reduces that time."
:type 'integer
:group 'ido)
(defcustom ido-max-file-prompt-width 0.35
- "Non-zero means that the prompt string be limited to that number of characters.
-If value is a floating point number, it specifies a fraction of the frame width."
+ "Upper limit of the prompt string.
+If value is an integer, it specifies the number of characters of
+the string.
+If value is a floating point number, it specifies a fraction of
+the frame width."
:type '(choice
(integer :tag "Characters" :value 20)
(restricted-sexp :tag "Fraction of frame width"
@@ -612,7 +618,8 @@ A tramp file name uses the following syntax: /method:user@host:filename."
(defcustom ido-cache-ftp-work-directory-time 1.0
"Maximum time to cache contents of an ftp directory (in hours).
-Use C-l in prompt to refresh list.
+\\<ido-file-completion-map>
+Use \\[ido-reread-directory] in prompt to refresh list.
If zero, ftp directories are not cached."
:type 'number
:group 'ido)
@@ -630,7 +637,7 @@ equivalent function, e.g. `find-file' rather than `ido-find-file'."
:group 'ido)
(defvar ido-unc-hosts-cache t
- "Cached value from `ido-unc-hosts' function.")
+ "Cached value from the function `ido-unc-hosts'.")
(defcustom ido-unc-hosts nil
"List of known UNC host names to complete after initial //.
@@ -658,7 +665,8 @@ Case is ignored if `ido-downcase-unc-hosts' is set."
(defcustom ido-cache-unc-host-shares-time 8.0
"Maximum time to cache shares of an UNC host (in hours).
-Use C-l in prompt to refresh list.
+\\<ido-file-completion-map>
+Use \\[ido-reread-directory] in prompt to refresh list.
If zero, UNC host shares are not cached."
:type 'number
:group 'ido)
@@ -704,20 +712,22 @@ When a (partial) file name matches this regexp, merging is inhibited."
(defcustom ido-max-dir-file-cache 100
"Maximum number of working directories to be cached.
+\\<ido-file-completion-map>
This is the size of the cache of `file-name-all-completions' results.
Each cache entry is time stamped with the modification time of the
directory. Some systems, like Windows, have unreliable directory
modification times, so you may choose to disable caching on such
systems, or explicitly refresh the cache contents using the command
-`ido-reread-directory' command (C-l) in the minibuffer.
+`ido-reread-directory' command (\\[ido-reread-directory]) in the minibuffer.
See also `ido-dir-file-cache' and `ido-save-directory-list-file'."
:type 'integer
:group 'ido)
(defcustom ido-max-directory-size nil
"Maximum size (in bytes) for directories to use ido completion.
+\\<ido-completion-map>
If you enter a directory with a size larger than this size, ido will
-not provide the normal completion. To show the completions, use C-a."
+not provide the normal completion. To show the completions, use \\[ido-toggle-ignore]."
:type '(choice (const :tag "No limit" nil)
(integer :tag "Size in bytes" 30000))
:group 'ido)
@@ -767,7 +777,8 @@ Obsolete. Set 3rd element of `ido-decorations' instead."
"List of strings used by ido to display the alternatives in the minibuffer.
There are between 11 and 13 elements in this list:
1st and 2nd elements are used as brackets around the prospect list,
-3rd element is the separator between prospects (ignored if `ido-separator' is set),
+3rd element is the separator between prospects (ignored if
+`ido-separator' is set),
4th element is the string inserted at the end of a truncated list of prospects,
5th and 6th elements are used as brackets around the common match string which
can be completed using TAB,
@@ -782,7 +793,7 @@ remaining completion. If absent, elements 5 and 6 are used instead."
:group 'ido)
(defcustom ido-use-virtual-buffers nil
- "Specify how vritual buffers should be used.
+ "Specify how virtual buffers should be used.
The value can be one of the following:
nil: No virtual buffers are used.
@@ -4482,11 +4493,6 @@ For details of keybindings, see `ido-find-file'."
(setq ido-exit 'refresh)
(exit-minibuffer))
- ;; Update the list of matches
- (setq ido-text contents)
- (ido-set-matches)
- (ido-trace "new " ido-matches)
-
(when (and ido-enter-matching-directory
ido-matches
(or (eq ido-enter-matching-directory 'first)
@@ -4500,6 +4506,11 @@ For details of keybindings, see `ido-find-file'."
(setq ido-exit 'refresh)
(exit-minibuffer))
+ ;; Update the list of matches
+ (setq ido-text contents)
+ (ido-set-matches)
+ (ido-trace "new " ido-matches)
+
(when (and (boundp 'ido-enable-virtual-buffers)
(not (eq ido-enable-virtual-buffers 'always))
(eq ido-cur-item 'buffer)
@@ -4760,16 +4771,20 @@ See `read-file-name' for additional parameters."
(let (filename)
(cond
((or (eq predicate 'file-directory-p)
- (eq (get this-command 'ido) 'dir)
+ (eq (and (symbolp this-command)
+ (get this-command 'ido)) 'dir)
(memq this-command ido-read-file-name-as-directory-commands))
(setq filename
(ido-read-directory-name prompt dir default-filename mustmatch initial)))
- ((and (not (eq (get this-command 'ido) 'ignore))
+ ((and (not (eq (and (symbolp this-command)
+ (get this-command 'ido)) 'ignore))
(not (memq this-command ido-read-file-name-non-ido))
(or (null predicate) (eq predicate 'file-exists-p)))
(let* (ido-saved-vc-hb
(ido-context-switch-command
- (if (eq (get this-command 'ido) 'find-file) nil 'ignore))
+ (if (eq (and (symbolp this-command)
+ (get this-command 'ido)) 'find-file)
+ nil 'ignore))
(vc-handled-backends (and (boundp 'vc-handled-backends) vc-handled-backends))
(minibuffer-completing-file-name t)
(ido-current-directory (ido-expand-directory dir))
diff --git a/lisp/image-dired.el b/lisp/image-dired.el
index afb940fe337..f26ad5dcd0e 100644
--- a/lisp/image-dired.el
+++ b/lisp/image-dired.el
@@ -1039,16 +1039,14 @@ With prefix argument ARG, remove tag from file at point."
See documentation for `image-dired-toggle-movement-tracking'.
Interactive use only useful if `image-dired-track-movement' is nil."
(interactive)
- (let ((old-buf (current-buffer))
- (dired-buf (image-dired-associated-dired-buffer))
- (file-name (image-dired-original-file-name)))
- (when (and (buffer-live-p dired-buf) file-name)
- (set-buffer dired-buf)
- (if (not (dired-goto-file file-name))
- (message "Could not track file")
- (set-window-point
- (image-dired-get-buffer-window dired-buf) (point)))
- (set-buffer old-buf))))
+ (let* ((dired-buf (image-dired-associated-dired-buffer))
+ (file-name (image-dired-original-file-name))
+ (window (image-dired-get-buffer-window dired-buf)))
+ (and (buffer-live-p dired-buf) file-name
+ (with-current-buffer dired-buf
+ (if (not (dired-goto-file file-name))
+ (message "Could not track file")
+ (if window (set-window-point window (point))))))))
(defun image-dired-toggle-movement-tracking ()
"Turn on and off `image-dired-track-movement'.
@@ -1065,24 +1063,22 @@ position in the other buffer."
This is almost the same as what `image-dired-track-original-file' does,
but the other way around."
(let ((file (dired-get-filename))
- (old-buf (current-buffer))
- prop-val found)
+ prop-val found window)
(when (get-buffer image-dired-thumbnail-buffer)
- (set-buffer image-dired-thumbnail-buffer)
- (goto-char (point-min))
- (while (and (not (eobp))
- (not found))
- (if (and (setq prop-val
- (get-text-property (point) 'original-file-name))
- (string= prop-val file))
- (setq found t))
- (if (not found)
- (forward-char 1)))
- (when found
- (set-window-point
- (image-dired-thumbnail-window) (point))
- (image-dired-display-thumb-properties))
- (set-buffer old-buf))))
+ (with-current-buffer image-dired-thumbnail-buffer
+ (goto-char (point-min))
+ (while (and (not (eobp))
+ (not found))
+ (if (and (setq prop-val
+ (get-text-property (point) 'original-file-name))
+ (string= prop-val file))
+ (setq found t))
+ (if (not found)
+ (forward-char 1)))
+ (when found
+ (if (setq window (image-dired-thumbnail-window))
+ (set-window-point window (point)))
+ (image-dired-display-thumb-properties))))))
(defun image-dired-dired-next-line (&optional arg)
"Call `dired-next-line', then track thumbnail.
diff --git a/lisp/international/mule.el b/lisp/international/mule.el
index 3577e0e9152..11c4db5977d 100644
--- a/lisp/international/mule.el
+++ b/lisp/international/mule.el
@@ -518,7 +518,8 @@ Return -1 if charset isn't an ISO 2022 one."
composition
euc-tw-shift
use-roman
- use-oldjis)
+ use-oldjis
+ 8-bit-level-4)
"List of symbols that control ISO-2022 encoder/decoder.
The value of the `:flags' attribute in the argument of the function
@@ -542,8 +543,9 @@ If `locking-shift' is specified, decode locking-shift code correctly
on decoding, and use locking-shift to invoke a graphic element on
encoding.
-If `single-shift' is specified, decode single-shift code correctly on
-decoding, and use single-shift to invoke a graphic element on encoding.
+If `single-shift' is specified, decode single-shift code
+correctly on decoding, and use single-shift to invoke a graphic
+element on encoding. See also `8-bit-level-4' specification.
If `designation' is specified, decode designation code correctly on
decoding, and use designation to designate a charset to a graphic
@@ -578,7 +580,13 @@ If `use-roman' is specified, JIS0201-1976-Roman is designated instead
of ASCII.
If `use-oldjis' is specified, JIS0208-1976 is designated instead of
-JIS0208-1983.")
+JIS0208-1983.
+
+If `8-bit-level-4' is specified, the decoder assumes the
+implementation level \"4\" for 8-bit codes which means that GL is
+identified as the single-shift area. The default implementation
+level for 8-bit code is \"4A\" which means that GR is identified
+as the single-shift area.")
(defun define-coding-system (name docstring &rest props)
"Define NAME (a symbol) as a coding system with DOCSTRING and attributes.
@@ -672,7 +680,7 @@ is unsuitable for the top-level media type \"text\".
VALUE must be a list of symbols that control the ISO-2022 converter.
Each must be a member of the list `coding-system-iso-2022-flags'
-\(which see). This attribute has a meaning only when `:coding-type'
+\(which see). This attribute is meaningful only when `:coding-type'
is `iso-2022'.
`:designation'
@@ -692,7 +700,7 @@ to GN. If the list contains 96, any charsets whose whose ranges are
96 long can be designated to GN. If the first element is a charset,
that charset is initially designated to GN.
-This attribute has a meaning only when `:coding-type' is `iso-2022'.
+This attribute is meaningful only when `:coding-type' is `iso-2022'.
`:bom'
@@ -712,7 +720,7 @@ are 0xFF 0xFE, use the cdr part coding system of the value.
Otherwise, treat them as bytes for a normal character. On encoding,
produce BOM bytes according to the value of `:endian'.
-This attribute has a meaning only when `:coding-type' is `utf-16' or
+This attribute is meaningful only when `:coding-type' is `utf-16' or
`utf-8'.
`:endian'
@@ -720,37 +728,37 @@ This attribute has a meaning only when `:coding-type' is `utf-16' or
VALUE must be `big' or `little' specifying big-endian and
little-endian respectively. The default value is `big'.
-This attribute has a meaning only when `:coding-type' is `utf-16'.
+This attribute is meaningful only when `:coding-type' is `utf-16'.
`:ccl-decoder'
VALUE is a symbol representing the registered CCL program used for
-decoding. This attribute has a meaning only when `:coding-type' is
+decoding. This attribute is meaningful only when `:coding-type' is
`ccl'.
`:ccl-encoder'
VALUE is a symbol representing the registered CCL program used for
-encoding. This attribute has a meaning only when `:coding-type' is
+encoding. This attribute is meaningful only when `:coding-type' is
`ccl'.
-:inhibit-null-byte-detection
+`:inhibit-null-byte-detection'
VALUE non-nil means Emacs ignore null bytes on code detection.
See the variable `inhibit-null-byte-detection'. This attribute
-has a meaning only when `:coding-type' is `undecided'.
+is meaningful only when `:coding-type' is `undecided'.
-:inhibit-iso-escape-detection
+`:inhibit-iso-escape-detection'
VALUE non-nil means Emacs ignores ISO-2022 escape sequences on
code detection. See the variable `inhibit-iso-escape-detection'.
-This attribute has a meaning only when `:coding-type' is
+This attribute is meaningful only when `:coding-type' is
`undecided'.
-:prefer-utf-8
+`:prefer-utf-8'
VALUE non-nil means Emacs prefers UTF-8 on code detection for
-non-ASCII files. This attribute has a meaning only when
+non-ASCII files. This attribute is meaningful only when
`:coding-type' is `undecided'."
(let* ((common-attrs (mapcar 'list
'(:mnemonic
diff --git a/lisp/lpr.el b/lisp/lpr.el
index 0b860ed07f1..5aed3bcc484 100644
--- a/lisp/lpr.el
+++ b/lisp/lpr.el
@@ -130,10 +130,13 @@ and print the result."
(repeat :tag "Multiple arguments" (string :tag "Argument")))
:group 'lpr)
-(defcustom print-region-function nil
+(defcustom print-region-function
+ (if (memq system-type '(ms-dos windows-nt))
+ #'direct-print-region-function
+ #'call-process-region)
"Function to call to print the region on a printer.
See definition of `print-region-1' for calling conventions."
- :type '(choice (const nil) function)
+ :type 'function
:group 'lpr)
(defcustom lpr-page-header-program "pr"
@@ -212,35 +215,24 @@ for further customization of the printer command."
(print-region-1 start end lpr-switches t))
(defun print-region-1 (start end switches page-headers)
+ (and page-headers lpr-headers-switches
+ ;; It's possible to use an lpr option to get page headers.
+ (setq switches (append (if (stringp lpr-headers-switches)
+ (list lpr-headers-switches)
+ lpr-headers-switches)
+ switches)))
;; On some MIPS system, having a space in the job name
;; crashes the printer demon. But using dashes looks ugly
;; and it seems to annoying to do for that MIPS system.
- (let ((name (concat (buffer-name) " Emacs buffer"))
- (title (concat (buffer-name) " Emacs buffer"))
- ;; Make pipes use the same coding system as
- ;; writing the buffer to a file would.
- (coding-system-for-write (or coding-system-for-write
- buffer-file-coding-system))
- (coding-system-for-read (or coding-system-for-read
- buffer-file-coding-system))
- (width tab-width)
- nswitches
- switch-string)
- (save-excursion
- (and page-headers lpr-headers-switches
- ;; It's possible to use an lpr option to get page headers.
- (setq switches (append (if (stringp lpr-headers-switches)
- (list lpr-headers-switches)
- lpr-headers-switches)
- switches)))
- (setq nswitches (lpr-flatten-list
- (mapcar 'lpr-eval-switch ; Dynamic evaluation
- switches))
- switch-string (if switches
- (concat " with options "
- (mapconcat 'identity switches " "))
- ""))
- (message "Spooling%s..." switch-string)
+ (save-excursion
+ (let ((name (concat (buffer-name) " Emacs buffer"))
+ ;; Make pipes use the same coding system as
+ ;; writing the buffer to a file would.
+ (coding-system-for-write (or coding-system-for-write
+ buffer-file-coding-system))
+ (coding-system-for-read (or coding-system-for-read
+ buffer-file-coding-system))
+ (width tab-width))
(if (/= tab-width 8)
(let ((new-coords (print-region-new-buffer start end)))
(setq start (car new-coords)
@@ -258,34 +250,48 @@ for further customization of the printer command."
(let ((new-coords (print-region-new-buffer start end)))
(apply 'call-process-region (car new-coords) (cdr new-coords)
lpr-page-header-program t t nil
- (mapcar (lambda (e) (format e title))
+ (mapcar (lambda (e) (format e name))
lpr-page-header-switches)))
(setq start (point-min)
end (point-max))))
- (let ((buf (current-buffer)))
- (with-temp-buffer
- (let ((tempbuf (current-buffer)))
- (with-current-buffer buf
- (apply (or print-region-function 'call-process-region)
- (nconc (list start end lpr-command
- nil tempbuf nil)
- (and lpr-add-switches
- (list "-J" name))
- ;; These belong in pr if we are using that.
- (and lpr-add-switches lpr-headers-switches
- (list "-T" title))
- (and (stringp printer-name)
- (list (concat lpr-printer-switch
- printer-name)))
- nswitches))))
- (if (markerp end)
- (set-marker end nil))
- (message "Spooling%s...done%s%s" switch-string
- (pcase (count-lines (point-min) (point-max))
- (0 "")
- (1 ": ")
- (_ ":\n"))
- (buffer-string)))))))
+ (lpr-print-region start end switches name))))
+
+(defun lpr-print-region (start end switches name)
+ (let ((buf (current-buffer))
+ (nswitches (lpr-flatten-list
+ (mapcar #'lpr-eval-switch ; Dynamic evaluation
+ switches)))
+ (switch-string (if switches
+ (concat " with options "
+ (mapconcat #'identity switches " "))
+ "")))
+ (message "Spooling%s..." switch-string)
+ (with-temp-buffer
+ (let ((retval
+ (let ((tempbuf (current-buffer)))
+ (with-current-buffer buf
+ (apply (or print-region-function 'call-process-region)
+ start end lpr-command
+ nil tempbuf nil
+ (nconc (and name lpr-add-switches
+ (list "-J" name))
+ ;; These belong in pr if we are using that.
+ (and name lpr-add-switches lpr-headers-switches
+ (list "-T" name))
+ (and (stringp printer-name)
+ (string< "" printer-name)
+ (list (concat lpr-printer-switch
+ printer-name)))
+ nswitches))))))
+ (if (markerp end)
+ (set-marker end nil))
+ (funcall (if (memq retval '(nil 0)) #'message #'user-error)
+ "Spooling%s...done%s%s" switch-string
+ (pcase (count-lines (point-min) (point-max))
+ (0 "")
+ (1 ": ")
+ (_ ":\n"))
+ (buffer-string))))))
;; This function copies the text between start and end
;; into a new buffer, makes that buffer current.
@@ -325,7 +331,7 @@ The characters tab, linefeed, space, return and formfeed are not affected."
;; Dynamic evaluation
(defun lpr-eval-switch (arg)
(cond ((stringp arg) arg)
- ((functionp arg) (apply arg nil))
+ ((functionp arg) (funcall arg))
((symbolp arg) (symbol-value arg))
((consp arg) (apply (car arg) (cdr arg)))
(t nil)))
@@ -342,7 +348,7 @@ The characters tab, linefeed, space, return and formfeed are not affected."
(defun lpr-flatten-list-1 (list)
(cond
- ((null list) (list))
+ ((null list) nil)
((consp list)
(append (lpr-flatten-list-1 (car list))
(lpr-flatten-list-1 (cdr list))))
diff --git a/lisp/mail/mailalias.el b/lisp/mail/mailalias.el
index c5f1e3921fa..4d9b24e0043 100644
--- a/lisp/mail/mailalias.el
+++ b/lisp/mail/mailalias.el
@@ -209,7 +209,9 @@ removed from alias expansions."
(if (re-search-forward "[ \t]*[\n,][ \t]*" end1 t)
(setq epos (match-beginning 0)
seplen (- (point) epos))
- (setq epos (marker-position end1) seplen 0))
+ ;; Handle the last name in this header field.
+ ;; We already moved END1 back across whitespace after it.
+ (setq epos (marker-position end1) seplen 0))
(let ((string (buffer-substring-no-properties pos epos))
translation)
(if (and (not (assoc string disabled-aliases))
diff --git a/lisp/mh-e/ChangeLog.1 b/lisp/mh-e/ChangeLog.1
index e57911947b1..f90d88ee0de 100644
--- a/lisp/mh-e/ChangeLog.1
+++ b/lisp/mh-e/ChangeLog.1
@@ -1403,11 +1403,11 @@
(mh-x-image-url-display): Don't display image if the URL looks
malformed.
-2003-10-04 Mark D Baushke <mdb@gnu.org>
+2003-10-04 Mark D. Baushke <mdb@gnu.org>
* mh-comp.el (mh-letter-menu): Simplify menu heading.
-2003-10-03 Mark D Baushke <mdb@gnu.org>
+2003-10-03 Mark D. Baushke <mdb@gnu.org>
* mh-mime.el (mh-mml-query-cryptographic-method): Avoid
revisionist history and still provide a good default.
@@ -3877,7 +3877,7 @@
runs checkdoc and lm-verify which is useful before releasing the
software. It can and should be expanded to do real unit tests.
-2003-04-22 Mark D Baushke <mdb@gnu.org>
+2003-04-22 Mark D. Baushke <mdb@gnu.org>
* mh-alias.el: Update Copyright.
* mh-comp.el: Ditto.
@@ -6106,7 +6106,7 @@
explicitly stated.
(mh-visit-folder): Really fix it this time.
-2003-01-01 Mark D Baushke <mdb@gnu.org>
+2003-01-01 Mark D. Baushke <mdb@gnu.org>
* mh-alias.el (mh-alias-from-has-no-alias-p): Needs the
mh-autoload comment or mh-customize may have problems finding the
@@ -6854,7 +6854,7 @@
* Makefile: Moved .PHONY rule after all rule for compatibility
with BSD/OS's old pmake.
-2002-12-03 Mark D Baushke <mdb@gnu.org>
+2002-12-03 Mark D. Baushke <mdb@gnu.org>
* mh-e.el (mh-get-new-mail): Simplify no-new-mail test.
(mh-add-cur-notation): Remove unnecessary function.
@@ -6878,7 +6878,7 @@
number of scan lines is fewer than mh-large-folders (closes SF
#646794).
-2002-12-02 Mark D Baushke <mdb@gnu.org>
+2002-12-02 Mark D. Baushke <mdb@gnu.org>
* mh-e.el (mh-add-cur-notation): New function to mark the
current message with the mh-note-cur character.
@@ -8312,7 +8312,7 @@
variable as new-file-flag.
This addresses part of SF #627015.
-2002-10-24 Mark D Baushke <mdb@gnu.org>
+2002-10-24 Mark D. Baushke <mdb@gnu.org>
* mh-comp.el (mh-forward): Fix mh-mml-compose-insert-p reference
in last commit to be mh-mml-compose-insert-flag.
@@ -8581,7 +8581,7 @@
* mh-comp.el (mh-mml-to-mime autoload): Ditto.
-2002-10-21 Mark D Baushke <mdb@gnu.org>
+2002-10-21 Mark D. Baushke <mdb@gnu.org>
* mh-mime.el (smiley-region): Use load for a non-fatal dependency
on the smiley library.
@@ -8735,7 +8735,7 @@
prompted for the number of messages to display, you got an error.
This has been fixed.
-2002-10-19 Mark D Baushke <mdb@gnu.org>
+2002-10-19 Mark D. Baushke <mdb@gnu.org>
* mh-e.el (mh-last-destination-folder): Destination of last refile
command.
@@ -8777,7 +8777,7 @@
macro mh-compat-write-file-hook to use write-file-functions for
Emacs 21.4 and local-write-file-hooks for older versions.
-2002-10-18 Mark D Baushke <mdb@gnu.org>
+2002-10-18 Mark D. Baushke <mdb@gnu.org>
* mh-utils.el (mh-invisible-headers): Add more anti-spam headers.
@@ -9079,7 +9079,7 @@
(mh-remove-xemacs-horizontal-scrollbar): New macro to avoid
compiler-warnings.
-2002-10-10 Mark D Baushke <mdb@gnu.org>
+2002-10-10 Mark D. Baushke <mdb@gnu.org>
* Makefile (EMACS_OPTIONS): New macro for command-line compile
options.
@@ -9088,13 +9088,13 @@
(COMPILE_COMMAND): Combine the compile command with its options.
(.el.elc): Use the new $(COMPILE_COMMAND).
-2002-10-10 Mark D Baushke <mdb@gnu.org>
+2002-10-10 Mark D. Baushke <mdb@gnu.org>
* mh-speed.el (mh-speed-select-attached-frame): Define a new
compatibility macro for getting to the attached-frame.
(mh-speed-update-current-folder): Use it.
-2002-10-10 Mark D Baushke <mdb@gnu.org>
+2002-10-10 Mark D. Baushke <mdb@gnu.org>
* mh-speed.el (mh-speed-update-current-folder): Use
'dframe-select-attached-frame if we are in a newer speedbar
@@ -9452,7 +9452,7 @@
present in the load-path.
* mh-mime.el (mh-require): Don't use it anymore.
-2002-07-15 Mark D Baushke <mdb@gnu.org>
+2002-07-15 Mark D. Baushke <mdb@gnu.org>
* mh-utils.el (mh-update-scan-format): Rewrite for compatibility
with XEmacs as replace-match appears not to have identical
@@ -9531,7 +9531,7 @@
* mh-mime.el (mm-destroy-parts): Add definition for old emacs.
-2002-06-30 Mark D Baushke <mdb@gnu.org>
+2002-06-30 Mark D. Baushke <mdb@gnu.org>
* mh-utils.el (mh-update-scan-format): Add documentation string.
(mh-scan-msg-format-regexp): Update the regexp to find %(msg).
@@ -9574,7 +9574,7 @@
* mh-index.el (mh-count-windows): This function works around the
lack of the window-list builtin function in emacs20.
-2002-06-29 Mark D Baushke <mdb@gnu.org>
+2002-06-29 Mark D. Baushke <mdb@gnu.org>
* mh-utils.el (mh-message-number-width): New function to scan
the last message of a folder and return its width.
@@ -9625,7 +9625,7 @@
* mh-mime.el (gnus-newsgroup-name): Initialize it to nil, so that
mm-uu-dissect doesn't cause error.
-2002-06-27 Mark D Baushke <mdb@gnu.org>
+2002-06-27 Mark D. Baushke <mdb@gnu.org>
* mh-utils.el (mh-cmd-note): Make buffer-local. Changes to this
variable should be made via the new mh-set-default-cmd-note
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index d832aa7ef3e..d65932ae7c9 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -603,7 +603,7 @@ appears in a <link> or <a> tag."
(insert " ")))
(defun eww-process-text-input (beg end length)
- (let* ((form (get-text-property end 'eww-form))
+ (let* ((form (get-text-property (min (1+ end) (point-max)) 'eww-form))
(properties (text-properties-at end))
(type (plist-get form :type)))
(when (and form
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 4506ede8722..6ddf8d2af90 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -143,6 +143,7 @@ cid: URL as the argument.")
(define-key map [tab] 'shr-next-link)
(define-key map [backtab] 'shr-previous-link)
(define-key map [follow-link] 'mouse-face)
+ (define-key map [mouse-2] 'shr-mouse-browse-url)
(define-key map "I" 'shr-insert-image)
(define-key map "w" 'shr-copy-url)
(define-key map "u" 'shr-copy-url)
@@ -657,6 +658,12 @@ size, and full-buffer size."
(forward-line 1)
(goto-char end))))))
+(defun shr-mouse-browse-url (ev)
+ "Browse the URL under the mouse cursor."
+ (interactive "e")
+ (mouse-set-point ev)
+ (shr-browse-url))
+
(defun shr-browse-url (&optional external)
"Browse the URL under point.
If EXTERNAL, browse the URL using `shr-external-browser'."
@@ -1476,9 +1483,6 @@ ones, in case fg and bg are nil."
(if column
(aref widths width-column)
10))
- ;; Sanity check for degenerate tables.
- (when (zerop width)
- (setq width 10))
(when (and fill
(setq colspan (cdr (assq :colspan (cdr column)))))
(setq colspan (string-to-number colspan))
@@ -1491,6 +1495,9 @@ ones, in case fg and bg are nil."
(setq width-column (+ width-column (1- colspan))))
(when (or column
(not fill))
+ ;; Sanity check for degenerate tables.
+ (when (zerop width)
+ (setq width 10))
(push (shr-render-td (cdr column) width fill)
tds))
(setq i (1+ i)
@@ -1499,6 +1506,7 @@ ones, in case fg and bg are nil."
(nreverse trs)))
(defun shr-render-td (cont width fill)
+ (when (= width 0) (debug))
(with-temp-buffer
(let ((bgcolor (cdr (assq :bgcolor cont)))
(fgcolor (cdr (assq :fgcolor cont)))
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 14fb8575fff..82b017fa230 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -108,6 +108,8 @@
(file-writable-p . tramp-adb-handle-file-writable-p)
(file-local-copy . tramp-adb-handle-file-local-copy)
(file-modes . tramp-handle-file-modes)
+ (file-notify-add-watch . tramp-handle-file-notify-add-watch)
+ (file-notify-rm-watch . ignore)
(expand-file-name . tramp-adb-handle-expand-file-name)
(find-backup-file-name . tramp-handle-find-backup-file-name)
(directory-files . tramp-handle-directory-files)
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index d4115352b34..2b0ea74c492 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -184,7 +184,7 @@
'file-expand-wildcards 'around 'tramp-advice-file-expand-wildcards)
(ad-activate 'file-expand-wildcards)))))
-;; `with-temp-message' does not exists in XEmacs.
+;; `with-temp-message' does not exist in XEmacs.
(if (fboundp 'with-temp-message)
(defalias 'tramp-compat-with-temp-message 'with-temp-message)
(defmacro tramp-compat-with-temp-message (message &rest body)
@@ -292,7 +292,7 @@ Not actually used. Use `(format \"%o\" i)' instead?"
(error "Non-octal junk in string `%s'" x))
(string-to-number ostr 8)))
-;; ID-FORMAT does not exists in XEmacs.
+;; ID-FORMAT does not exist in XEmacs.
(defun tramp-compat-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files (compat function)."
(cond
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index c2fdc0491b6..e25c9bd4caf 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -435,6 +435,8 @@ Every entry is a list (NAME ADDRESS).")
(file-name-nondirectory . tramp-handle-file-name-nondirectory)
;; `file-name-sans-versions' performed by default handler.
(file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
+ (file-notify-add-watch . tramp-handle-file-notify-add-watch)
+ (file-notify-rm-watch . ignore)
(file-ownership-preserved-p . ignore)
(file-readable-p . tramp-gvfs-handle-file-readable-p)
(file-regular-p . tramp-handle-file-regular-p)
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 281f497692d..c92eacd4473 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -3334,7 +3334,8 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file."
;; `process-file-side-effects' in order to keep the cache when
;; `process-file' calls appear.
(let (process-file-side-effects)
- (tramp-run-real-handler 'vc-registered (list file)))))))
+ (ignore-errors
+ (tramp-run-real-handler 'vc-registered (list file))))))))
;;;###tramp-autoload
(defun tramp-sh-file-name-handler (operation &rest args)
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 65c52ae4f3c..fee34f856dd 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -209,6 +209,8 @@ See `tramp-actions-before-shell' for more info.")
(file-name-nondirectory . tramp-handle-file-name-nondirectory)
;; `file-name-sans-versions' performed by default handler.
(file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
+ (file-notify-add-watch . tramp-handle-file-notify-add-watch)
+ (file-notify-rm-watch . ignore)
(file-ownership-preserved-p . ignore)
(file-readable-p . tramp-handle-file-exists-p)
(file-regular-p . tramp-handle-file-regular-p)
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 3513701d20e..db6a1e381a6 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -1980,8 +1980,8 @@ ARGS are the arguments OPERATION has been called with."
;; Emacs 22+ only.
'set-file-times
;; Emacs 24+ only.
- 'file-acl 'file-notify-add-watch 'file-selinux-context
- 'set-file-acl 'set-file-selinux-context
+ 'file-acl 'file-notify-add-watch
+ 'file-selinux-context 'set-file-acl 'set-file-selinux-context
;; XEmacs only.
'abbreviate-file-name 'create-file-buffer
'dired-file-modtime 'dired-make-compressed-filename
@@ -2036,8 +2036,9 @@ ARGS are the arguments OPERATION has been called with."
default-directory)
;; PROC.
((eq operation 'file-notify-rm-watch)
- (with-current-buffer (process-buffer (nth 0 args))
- default-directory))
+ (when (processp (nth 0 args))
+ (with-current-buffer (process-buffer (nth 0 args))
+ default-directory)))
;; Unknown file primitive.
(t (error "unknown file I/O primitive: %s" operation))))
@@ -3278,6 +3279,14 @@ beginning of local filename are not substituted."
;; for backward compatibility.
(expand-file-name "~/"))
+(defun tramp-handle-file-notify-add-watch (filename flags callback)
+ "Like `file-notify-add-watch' for Tramp files."
+ ;; This is the default handler. Some packages might have its own one.
+ (setq filename (expand-file-name filename))
+ (with-parsed-tramp-file-name filename nil
+ (tramp-error
+ v 'file-notify-error "File notification not supported for `%s'" filename)))
+
;;; Functions for establishing connection:
;; The following functions are actions to be taken when seeing certain
diff --git a/lisp/org/ChangeLog b/lisp/org/ChangeLog
index 16097c1c0b2..019fa8a358d 100644
--- a/lisp/org/ChangeLog
+++ b/lisp/org/ChangeLog
@@ -3983,7 +3983,7 @@
(org-export-latex-tables-tend): New options.
(org-export-latex-tables): Use the new options.
-2012-09-30 tumashu <tumashu@gmail.com> (tiny change)
+2012-09-30 Feng Shu <tumashu@gmail.com> (tiny change)
* org-exp.el (org-export-language-setup): Add simplified chinese
translation.
@@ -9437,7 +9437,7 @@
(org-update-checkbox-count-maybe): Add an optional argument passed to
org-update-checkbox-count.
-2011-07-28 Ted Zlatanov <tzz@lifelogs.com>
+2011-07-28 Teodor Zlatanov <tzz@lifelogs.com>
* org.el (org-fontify-meta-lines-and-blocks): Ignore errors.
@@ -18000,7 +18000,7 @@
* org-habit.el (org-habit-build-graph): Help-echo date when
mouse is over stars.
-2010-07-19 Jan Böker <jan.boecker@jboecker.de>
+2010-07-19 Jan Böcker <jan.boecker@jboecker.de>
* org.el (org-file-apps): Improve docstring to reflect
grouping matches.
diff --git a/lisp/org/org-freemind.el b/lisp/org/org-freemind.el
index 3b1c6863f54..2ee58501ca1 100644
--- a/lisp/org/org-freemind.el
+++ b/lisp/org/org-freemind.el
@@ -598,7 +598,7 @@ DRAWERS-REGEXP are converted to freemind notes."
(defun org-freemind-check-overwrite (file interactively)
"Check if file FILE already exists.
-If FILE does not exists return t.
+If FILE does not exist return t.
If INTERACTIVELY is non-nil ask if the file should be replaced
and return t/nil if it should/should not be replaced.
diff --git a/lisp/printing.el b/lisp/printing.el
index 18b2b89363b..2c807b078f5 100644
--- a/lisp/printing.el
+++ b/lisp/printing.el
@@ -1030,7 +1030,7 @@ Please send all bug fixes and enhancements to
(defconst pr-cygwin-system
- (and ps-windows-system (getenv "OSTYPE")
+ (and lpr-windows-system (getenv "OSTYPE")
(string-match "cygwin" (getenv "OSTYPE"))))
@@ -1414,7 +1414,7 @@ Used by `pr-menu-bind' and `pr-update-menus'.")
(eval-and-compile
(cond
- (ps-windows-system
+ (lpr-windows-system
;; GNU Emacs for Windows 9x/NT
(defun pr-menu-position (entry index horizontal)
(let ((pos (cdr (mouse-pixel-position))))
@@ -1614,7 +1614,7 @@ Used by `pr-menu-bind' and `pr-update-menus'.")
"Ensure the proper directory separator depending on the OS.
That is, if Emacs is running on DOS/Windows, ensure dos/windows-style directory
separator; otherwise, ensure unix-style directory separator."
- (if (or pr-cygwin-system ps-windows-system)
+ (if (or pr-cygwin-system lpr-windows-system)
(subst-char-in-string ?/ ?\\ path)
(subst-char-in-string ?\\ ?/ path)))
@@ -1667,7 +1667,7 @@ separator; otherwise, ensure unix-style directory separator."
(defcustom pr-path-style
(if (and (not pr-cygwin-system)
- ps-windows-system)
+ lpr-windows-system)
'windows
'unix)
"Specify which path style to use for external commands.
@@ -1778,7 +1778,7 @@ function (see it for documentation) to update text printer menu."
(defcustom pr-txt-printer-alist
(list (list 'default lpr-command nil
(cond ((boundp 'printer-name) printer-name)
- (ps-windows-system "PRN")
+ (lpr-windows-system "PRN")
(t nil)
)))
;; Examples:
@@ -1923,8 +1923,8 @@ function (see it for documentation) to update PostScript printer menu."
(defcustom pr-ps-printer-alist
(list (list 'default lpr-command nil
- (cond (ps-windows-system nil)
- (ps-lp-system "-d")
+ (cond (lpr-windows-system nil)
+ (lpr-lp-system "-d")
(t "-P"))
(or (getenv "PRINTER") (getenv "LPDEST") ps-printer-name)))
;; Examples:
@@ -2200,7 +2200,7 @@ Useful links:
;; hacked from `temporary-file-directory' variable in files.el
(file-name-as-directory
(or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP")
- (cond (ps-windows-system "c:/temp")
+ (cond (lpr-windows-system "c:/temp")
(t "/tmp")
)))))
"Specify a directory for temporary files during printing.
@@ -2232,7 +2232,7 @@ See also `pr-temp-dir' and `pr-ps-temp-file'."
(defcustom pr-gv-command
- (if ps-windows-system
+ (if lpr-windows-system
"gsview32.exe"
"gv")
"Specify path and name of the gsview/gv utility.
@@ -2273,7 +2273,7 @@ Useful links:
(defcustom pr-gs-command
- (if ps-windows-system
+ (if lpr-windows-system
"gswin32.exe"
"gs")
"Specify path and name of the ghostscript utility.
@@ -2299,7 +2299,7 @@ Useful links:
(defcustom pr-gs-switches
- (if ps-windows-system
+ (if lpr-windows-system
'("-q -dNOPAUSE -Ic:/gs/gs5.50;c:/gs/gs5.50/fonts")
'("-q -dNOPAUSE -I/usr/share/ghostscript/5.10"))
"Specify ghostscript switches. See the documentation on GS for more info.
@@ -2341,7 +2341,7 @@ Useful links:
(defcustom pr-gs-device
- (if ps-windows-system
+ (if lpr-windows-system
"mswinpr2"
"uniprint")
"Specify the ghostscript device switch value (-sDEVICE=).
@@ -4852,8 +4852,8 @@ Or choose the menu option Printing/Show Settings/printing."
(ps-comment-string "pr-ps-printer-switch" pr-ps-printer-switch)
(ps-comment-string "pr-ps-printer " pr-ps-printer)
(ps-comment-string "pr-cygwin-system " pr-cygwin-system)
- (ps-comment-string "ps-windows-system " ps-windows-system)
- (ps-comment-string "ps-lp-system " ps-lp-system)
+ (ps-comment-string "lpr-windows-system " lpr-windows-system)
+ (ps-comment-string "lpr-lp-system " lpr-lp-system)
nil
'(14 . pr-path-style)
'(14 . pr-path-alist)
@@ -5235,14 +5235,14 @@ If menu binding was not done, calls `pr-menu-bind'."
pr-ps-printer (nth 3 ps))
(or (stringp pr-ps-command)
(setq pr-ps-command
- (cond (ps-windows-system "print")
- (ps-lp-system "lp")
+ (cond (lpr-windows-system "print")
+ (lpr-lp-system "lp")
(t "lpr")
)))
(or (stringp pr-ps-printer-switch)
(setq pr-ps-printer-switch
- (cond (ps-windows-system "/D:")
- (ps-lp-system "-d")
+ (cond (lpr-windows-system "/D:")
+ (lpr-lp-system "-d")
(t "-P")
)))
(pr-eval-alist (nthcdr 4 ps)))
@@ -5260,8 +5260,8 @@ If menu binding was not done, calls `pr-menu-bind'."
pr-txt-printer (nth 2 txt)))
(or (stringp pr-txt-command)
(setq pr-txt-command
- (cond (ps-windows-system "print")
- (ps-lp-system "lp")
+ (cond (lpr-windows-system "print")
+ (lpr-lp-system "lp")
(t "lpr")
)))
(pr-update-mode-line))
@@ -5667,7 +5667,7 @@ If menu binding was not done, calls `pr-menu-bind'."
(defun pr-switches (switches mess)
(or (listp switches)
(error "%S should have a list of strings" mess))
- (ps-flatten-list ; dynamic evaluation
+ (lpr-flatten-list ; dynamic evaluation
(mapcar 'ps-eval-switch switches)))
@@ -5825,7 +5825,7 @@ If menu binding was not done, calls `pr-menu-bind'."
(defun pr-find-buffer-visiting (file)
(if (not (file-directory-p file))
- (find-buffer-visiting (if ps-windows-system
+ (find-buffer-visiting (if lpr-windows-system
(downcase file)
file))
(let ((truename (file-truename file))
@@ -5939,7 +5939,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
(pr-dosify-file-name
(or (pr-find-command command)
(pr-path-command (cond (pr-cygwin-system 'cygwin)
- (ps-windows-system 'windows)
+ (lpr-windows-system 'windows)
(t 'unix))
(file-name-nondirectory command)
nil)
@@ -5976,7 +5976,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
(defun pr-find-command (cmd)
- (if ps-windows-system
+ (if lpr-windows-system
;; windows system
(let ((ext (cons (file-name-extension cmd t)
(list ".exe" ".bat" ".com")))
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index 9077bdbb513..a3bd000a4f3 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -6892,7 +6892,7 @@ comment at the start of cc-engine.el for more info."
(while (and (looking-at c-type-decl-prefix-key)
(if (and (c-major-mode-is 'c++-mode)
(match-beginning 3))
- ;; If the second submatch matches in C++ then
+ ;; If the third submatch matches in C++ then
;; we're looking at an identifier that's a
;; prefix only if it specifies a member pointer.
(when (setq got-identifier (c-forward-name))
@@ -7193,19 +7193,23 @@ comment at the start of cc-engine.el for more info."
;; uncommon (e.g. some placements of "const" in C++) it's not worth
;; the effort to look for them.)
- (unless (or at-decl-end (looking-at "=[^=]"))
- ;; If this is a declaration it should end here or its initializer(*)
- ;; should start here, so check for allowed separation tokens. Note
- ;; that this rule doesn't work e.g. with a K&R arglist after a
- ;; function header.
- ;;
- ;; *) Don't check for C++ style initializers using parens
- ;; since those already have been matched as suffixes.
- ;;
- ;; If `at-decl-or-cast' is then we've found some other sign that
- ;; it's a declaration or cast, so then it's probably an
- ;; invalid/unfinished one.
- (throw 'at-decl-or-cast at-decl-or-cast))
+;;; 2008-04-16: commented out the next form, to allow the function to recognize
+;;; "foo (int bar)" in CC (an implicit type (in class foo) without a semicolon)
+;;; as a(n almost complete) declaration, enabling it to be fontified.
+ ;; CASE 13
+ ;; (unless (or at-decl-end (looking-at "=[^=]"))
+ ;; If this is a declaration it should end here or its initializer(*)
+ ;; should start here, so check for allowed separation tokens. Note
+ ;; that this rule doesn't work e.g. with a K&R arglist after a
+ ;; function header.
+ ;;
+ ;; *) Don't check for C++ style initializers using parens
+ ;; since those already have been matched as suffixes.
+ ;;
+ ;; If `at-decl-or-cast' is then we've found some other sign that
+ ;; it's a declaration or cast, so then it's probably an
+ ;; invalid/unfinished one.
+ ;; (throw 'at-decl-or-cast at-decl-or-cast))
;; Below are tests that only should be applied when we're certain to
;; not have parsed halfway through an expression.
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index 10472ec5815..4b51a5e7835 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -290,9 +290,8 @@ discard all handlers having a token number less than TOKEN-NUMBER."
(lambda (handler)
"Discard any HANDLER with a token number `<=' than TOKEN-NUMBER."
(when (< (gdb-handler-token-number handler) token-number)
- (message (format
- "WARNING! Discarding GDB handler with token #%d\n"
- (gdb-handler-token-number handler))))
+ (message "WARNING! Discarding GDB handler with token #%d\n"
+ (gdb-handler-token-number handler)))
(<= (gdb-handler-token-number handler) token-number))
gdb-handler-list))
@@ -1490,7 +1489,7 @@ this trigger is subscribed to `gdb-buf-publisher' and called with
split-horizontal)
`(defun ,name (&optional thread)
,(when doc doc)
- (message thread)
+ (message "%s" thread)
(gdb-preempt-existing-or-display-buffer
(gdb-get-buffer-create ,buffer thread)
,split-horizontal)))
@@ -2445,9 +2444,9 @@ current thread and update GDB buffers."
(if (or (eq gdb-switch-reasons t)
(member reason gdb-switch-reasons))
(when (not (string-equal gdb-thread-number thread-id))
- (message (concat "Switched to thread " thread-id))
+ (message "Switched to thread %s" thread-id)
(gdb-setq-thread-number thread-id))
- (message (format "Thread %s stopped" thread-id)))))
+ (message "Thread %s stopped" thread-id))))
;; Print "(gdb)" to GUD console
(when gdb-first-done-or-error
@@ -2500,7 +2499,7 @@ current thread and update GDB buffers."
;; MI error - send to minibuffer
(when (eq type 'error)
;; Skip "msg=" from `output-field'
- (message (read (substring output-field 4)))
+ (message "%s" (read (substring output-field 4)))
;; Don't send to the console twice. (If it is a console error
;; it is also in the console stream.)
(setq output-field nil)))
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index 915b52ce04d..62870f9085b 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -3091,7 +3091,12 @@ you are doing."
;; Stop collecting nodes after moving to a position with
;; indentation equaling min-indent. This is specially
;; useful for navigating nested definitions recursively.
- tree)
+ (if (> num-children 0)
+ tree
+ ;; When there are no children, the collected tree is a
+ ;; single node intended to be added in the list of defuns
+ ;; of its parent.
+ (car tree)))
(t
(python-imenu--build-tree
min-indent
@@ -3131,7 +3136,7 @@ you are doing."
(cons
(prog1
(python-imenu--build-tree
- prev-indent indent 1 (list (cons label pos)))
+ prev-indent indent 0 (list (cons label pos)))
;; Adjustment: after scanning backwards
;; for all deeper children, we need to
;; continue our scan for a parent from
diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el
index 06dffd80d88..c8fae7ba1e6 100644
--- a/lisp/progmodes/ruby-mode.el
+++ b/lisp/progmodes/ruby-mode.el
@@ -46,11 +46,6 @@
:prefix "ruby-"
:group 'languages)
-(defconst ruby-keyword-end-re
- (if (string-match "\\_>" "ruby")
- "\\_>"
- "\\>"))
-
(defconst ruby-block-beg-keywords
'("class" "module" "def" "if" "unless" "case" "while" "until" "for" "begin" "do")
"Keywords at the beginning of blocks.")
@@ -60,7 +55,7 @@
"Regexp to match the beginning of blocks.")
(defconst ruby-non-block-do-re
- (concat (regexp-opt '("while" "until" "for" "rescue") t) ruby-keyword-end-re)
+ (regexp-opt '("while" "until" "for" "rescue") 'symbols)
"Regexp to match keywords that nest without blocks.")
(defconst ruby-indent-beg-re
@@ -696,7 +691,7 @@ Can be one of `heredoc', `modifier', `expr-qstr', `expr-re'."
((looking-at (concat "\\_<\\(" ruby-block-beg-re "\\)\\_>"))
(and
(save-match-data
- (or (not (looking-at (concat "do" ruby-keyword-end-re)))
+ (or (not (looking-at "do\\_>"))
(save-excursion
(back-to-indentation)
(not (looking-at ruby-non-block-do-re)))))
@@ -1718,14 +1713,16 @@ See the definition of `ruby-font-lock-syntactic-keywords'."
"The syntax table to use for fontifying Ruby mode buffers.
See `font-lock-syntax-table'.")
+(defconst ruby-font-lock-keyword-beg-re "\\(?:^\\|[^.@$]\\|\\.\\.\\)")
+
(defconst ruby-font-lock-keywords
(list
;; functions
'("^\\s *def\\s +\\(?:[^( \t\n.]*\\.\\)?\\([^( \t\n]+\\)"
1 font-lock-function-name-face)
+ ;; keywords
(list (concat
- "\\(^\\|[^.@$]\\|\\.\\.\\)\\("
- ;; keywords
+ ruby-font-lock-keyword-beg-re
(regexp-opt
'("alias"
"and"
@@ -1760,11 +1757,14 @@ See `font-lock-syntax-table'.")
"when"
"while"
"yield")
- 'symbols)
- "\\|"
+ 'symbols))
+ 1 'font-lock-keyword-face)
+ ;; some core methods
+ (list (concat
+ ruby-font-lock-keyword-beg-re
(regexp-opt
- ;; built-in methods on Kernel
- '("__callee__"
+ '(;; built-in methods on Kernel
+ "__callee__"
"__dir__"
"__method__"
"abort"
@@ -1823,20 +1823,17 @@ See `font-lock-syntax-table'.")
"public"
"refine"
"using")
- 'symbols)
- "\\)")
- 2
- '(if (match-beginning 4)
- font-lock-builtin-face
- font-lock-keyword-face))
+ 'symbols))
+ 1 'font-lock-builtin-face)
;; Perl-ish keywords
"\\_<\\(?:BEGIN\\|END\\)\\_>\\|^__END__$"
;; here-doc beginnings
`(,ruby-here-doc-beg-re 0 (unless (ruby-singleton-class-p (match-beginning 0))
'font-lock-string-face))
;; variables
- '("\\(^\\|[^.@$]\\|\\.\\.\\)\\_<\\(nil\\|self\\|true\\|false\\)\\>"
- 2 font-lock-variable-name-face)
+ `(,(concat ruby-font-lock-keyword-beg-re
+ "\\_<\\(nil\\|self\\|true\\|false\\)\\>")
+ 1 font-lock-variable-name-face)
;; keywords that evaluate to certain values
'("\\_<__\\(?:LINE\\|ENCODING\\|FILE\\)__\\_>" 0 font-lock-variable-name-face)
;; symbols
@@ -1851,6 +1848,11 @@ See `font-lock-syntax-table'.")
'("\\(?:\\_<\\|::\\)\\([A-Z]+\\(\\w\\|_\\)*\\)"
1 (unless (eq ?\( (char-after)) font-lock-type-face))
'("\\(^\\s *\\|[\[\{\(,]\\s *\\|\\sw\\s +\\)\\(\\(\\sw\\|_\\)+\\):[^:]" 2 font-lock-constant-face)
+ ;; conversion methods on Kernel
+ (list (concat ruby-font-lock-keyword-beg-re
+ (regexp-opt '("Array" "Complex" "Float" "Hash"
+ "Integer" "Rational" "String") 'symbols))
+ 1 font-lock-builtin-face)
;; expression expansion
'(ruby-match-expression-expansion
2 font-lock-variable-name-face t)
@@ -1859,7 +1861,7 @@ See `font-lock-syntax-table'.")
1 font-lock-negation-char-face)
;; character literals
;; FIXME: Support longer escape sequences.
- '("\\?\\\\?\\S " 0 font-lock-string-face)
+ '("\\_<\\?\\\\?\\S " 0 font-lock-string-face)
)
"Additional expressions to highlight in Ruby mode.")
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index 07e9bb85c4e..29020d95226 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -2401,7 +2401,6 @@ which in this buffer is currently %s.
(defun sh-read-variable (var)
"Read a new value for indentation variable VAR."
- (interactive "*variable? ") ;; to test
(let ((minibuffer-help-form `(sh-help-string-for-variable
(quote ,var)))
val)
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el
index 940afc3d5f4..56a6f155f31 100644
--- a/lisp/progmodes/sql.el
+++ b/lisp/progmodes/sql.el
@@ -4,7 +4,7 @@
;; Author: Alex Schroeder <alex@gnu.org>
;; Maintainer: Michael Mauger <michael@mauger.com>
-;; Version: 3.2
+;; Version: 3.3
;; Keywords: comm languages processes
;; URL: http://savannah.gnu.org/projects/emacs/
@@ -233,6 +233,7 @@
(require 'regexp-opt))
(require 'custom)
(require 'thingatpt)
+(require 'view)
(defvar font-lock-keyword-face)
(defvar font-lock-set-defaults)
@@ -246,7 +247,7 @@
:group 'languages
:group 'processes)
-;; These four variables will be used as defaults, if set.
+;; These five variables will be used as defaults, if set.
(defcustom sql-user ""
"Default username."
@@ -437,7 +438,7 @@ file. Since that is a plaintext file, this could be dangerous."
:completion-object sql-oracle-completion-object
:prompt-regexp "^SQL> "
:prompt-length 5
- :prompt-cont-regexp "^\\s-*[[:digit:]]+ "
+ :prompt-cont-regexp "^\\(?:[ ][ ][1-9]\\|[ ][1-9][0-9]\\|[1-9][0-9]\\{2\\}\\)[ ]\\{2\\}"
:statement sql-oracle-statement-starters
:syntax-alist ((?$ . "_") (?# . "_"))
:terminator ("\\(^/\\|;\\)$" . "/")
@@ -3276,6 +3277,17 @@ Allows the suppression of continuation prompts.")
(defvar sql-preoutput-hold nil)
+(defun sql-starts-with-prompt-re ()
+ "Anchor the prompt expression at the beginning of the output line.
+Remove the start of line regexp."
+ (replace-regexp-in-string "\\^" "\\\\`" comint-prompt-regexp))
+
+(defun sql-ends-with-prompt-re ()
+ "Anchor the prompt expression at the end of the output line.
+Remove the start of line regexp from the prompt expression since
+it may not follow newline characters in the output line."
+ (concat (replace-regexp-in-string "\\^" "" sql-prompt-regexp) "\\'"))
+
(defun sql-interactive-remove-continuation-prompt (oline)
"Strip out continuation prompts out of the OLINE.
@@ -3293,38 +3305,52 @@ to the next chunk to properly match the broken-up prompt.
If the filter gets confused, it should reset and stop filtering
to avoid deleting non-prompt output."
- (let (did-filter)
- (setq oline (concat (or sql-preoutput-hold "") oline)
- sql-preoutput-hold nil)
-
- (if (and comint-prompt-regexp
- (integerp sql-output-newline-count)
- (>= sql-output-newline-count 1))
- (progn
- (while (and (not (string= oline ""))
- (> sql-output-newline-count 0)
- (string-match comint-prompt-regexp oline)
- (= (match-beginning 0) 0))
+ (when comint-prompt-regexp
+ (save-match-data
+ (let (prompt-found last-nl)
- (setq oline (replace-match "" nil nil oline)
- sql-output-newline-count (1- sql-output-newline-count)
- did-filter t))
+ ;; Add this text to what's left from the last pass
+ (setq oline (concat sql-preoutput-hold oline)
+ sql-preoutput-hold "")
+ ;; If we are looking for multiple prompts
+ (when (and (integerp sql-output-newline-count)
+ (>= sql-output-newline-count 1))
+ ;; Loop thru each starting prompt and remove it
+ (let ((start-re (sql-starts-with-prompt-re)))
+ (while (and (not (string= oline ""))
+ (> sql-output-newline-count 0)
+ (string-match start-re oline))
+ (setq oline (replace-match "" nil nil oline)
+ sql-output-newline-count (1- sql-output-newline-count)
+ prompt-found t)))
+
+ ;; If we've found all the expected prompts, stop looking
(if (= sql-output-newline-count 0)
(setq sql-output-newline-count nil
oline (concat "\n" oline))
+ ;; Still more possible prompts, leave them for the next pass
(setq sql-preoutput-hold oline
- oline ""))
-
- (unless did-filter
- (setq oline (or sql-preoutput-hold "")
- sql-preoutput-hold nil
- sql-output-newline-count nil)))
-
- (setq sql-output-newline-count nil))
-
- oline))
+ oline "")))
+
+ ;; If no prompts were found, stop looking
+ (unless prompt-found
+ (setq sql-output-newline-count nil
+ oline (concat oline sql-preoutput-hold)
+ sql-preoutput-hold ""))
+
+ ;; Break up output by physical lines if we haven't hit the final prompt
+ (unless (and (not (string= oline ""))
+ (string-match (sql-ends-with-prompt-re) oline)
+ (>= (match-end 0) (length oline)))
+ (setq last-nl 0)
+ (while (string-match "\n" oline last-nl)
+ (setq last-nl (match-end 0)))
+ (setq sql-preoutput-hold (concat (substring oline last-nl)
+ sql-preoutput-hold)
+ oline (substring oline 0 last-nl))))))
+ oline)
;;; Sending the region to the SQLi buffer.
@@ -3462,7 +3488,8 @@ list of SQLi command strings."
:prompt-regexp))
(start nil))
(with-current-buffer buf
- (setq view-read-only nil)
+ (setq-local view-no-disable-on-exit t)
+ (read-only-mode -1)
(unless save-prior
(erase-buffer))
(goto-char (point-max))
@@ -3571,8 +3598,8 @@ buffer is popped into a view window."
(get-lru-window))))
(with-current-buffer outbuf
(set-buffer-modified-p nil)
- (setq view-read-only t))
- (view-buffer-other-window outbuf)
+ (read-only-mode +1))
+ (pop-to-buffer outbuf)
(when one-win
(shrink-window-if-larger-than-buffer)))))
@@ -3747,7 +3774,9 @@ must tell Emacs. Here's how to do that in your init file:
(setq-local abbrev-all-caps 1)
;; Contains the name of database objects
(set (make-local-variable 'sql-contains-names) t)
+ ;; Set syntax and font-face highlighting
;; Catch changes to sql-product and highlight accordingly
+ (sql-set-product (or sql-product 'ansi)) ; Fixes bug#13591
(add-hook 'hack-local-variables-hook 'sql-highlight-product t t))
diff --git a/lisp/progmodes/subword.el b/lisp/progmodes/subword.el
index a75bdff27bd..8cf4feb62cb 100644
--- a/lisp/progmodes/subword.el
+++ b/lisp/progmodes/subword.el
@@ -93,11 +93,11 @@
(defvar subword-backward-function 'subword-backward-internal
"Function to call for backward subword movement.")
-(defvar subword-forward-regexp
- "\\W*\\(\\([[:upper:]]*\\W?\\)[[:lower:][:digit:]]*\\)"
+(defconst subword-forward-regexp
+ "\\W*\\(\\([[:upper:]]*\\(\\W\\)?\\)[[:lower:][:digit:]]*\\)"
"Regexp used by `subword-forward-internal'.")
-(defvar subword-backward-regexp
+(defconst subword-backward-regexp
"\\(\\(\\W\\|[[:lower:][:digit:]]\\)\\([[:upper:]]+\\W*\\)\\|\\W\\w+\\)"
"Regexp used by `subword-backward-internal'.")
@@ -319,7 +319,11 @@ edit them as words.
(> (match-end 0) (point)))
(goto-char
(cond
- ((< 1 (- (match-end 2) (match-beginning 2)))
+ ((and (< 1 (- (match-end 2) (match-beginning 2)))
+ ;; If we have an all-caps word with no following lower-case or
+ ;; non-word letter, don't leave the last char (bug#13758).
+ (not (and (null (match-beginning 3))
+ (eq (match-end 2) (match-end 1)))))
(1- (match-end 2)))
(t
(match-end 0))))
diff --git a/lisp/ps-mule.el b/lisp/ps-mule.el
index 059261ac0ac..7f30700bee8 100644
--- a/lisp/ps-mule.el
+++ b/lisp/ps-mule.el
@@ -1058,6 +1058,7 @@ It checks if all multi-byte characters in the region are printable or not."
(= (skip-chars-forward "\x00-\x7F" to) to)))
;; All characters can be printed by normal PostScript fonts.
(setq ps-basic-plot-string-function 'ps-basic-plot-string
+ ;; FIXME: Doesn't ps-encode-header-string-function take 2 args?
ps-encode-header-string-function 'identity)
(setq ps-basic-plot-string-function 'ps-mule-plot-string
ps-encode-header-string-function 'ps-mule-encode-header-string
diff --git a/lisp/ps-print.el b/lisp/ps-print.el
index b5961064cb4..8369afcbbc7 100644
--- a/lisp/ps-print.el
+++ b/lisp/ps-print.el
@@ -1472,12 +1472,6 @@ Please send all bug fixes and enhancements to
(error "`ps-print' only supports Emacs 23 and higher")))
-(defconst ps-windows-system
- (memq system-type '(ms-dos windows-nt)))
-(defconst ps-lp-system
- (memq system-type '(usg-unix-v hpux irix)))
-
-
;; Load XEmacs/Emacs definitions
(require 'ps-def)
@@ -1676,8 +1670,7 @@ For more information about PostScript document comments, see:
:version "20"
:group 'ps-print-miscellany)
-(defcustom ps-printer-name (and (boundp 'printer-name)
- (symbol-value 'printer-name))
+(defcustom ps-printer-name nil
"The name of a local printer for printing PostScript files.
On Unix-like systems, a string value should be a name understood by lpr's -P
@@ -1709,12 +1702,8 @@ See also `ps-printer-name-option' for documentation."
:group 'ps-print-printer)
(defcustom ps-printer-name-option
- (cond (ps-windows-system
- "/D:")
- (ps-lp-system
- "-d")
- (t
- "-P" ))
+ (cond (lpr-windows-system "/D:")
+ (t lpr-printer-switch))
"Option for `ps-printer-name' variable (see it).
On Unix-like systems, if `lpr' is in use, this should be the string
@@ -1729,8 +1718,6 @@ Set this to \"\" or nil, if the utility given by `ps-lpr-command'
needs an empty printer name option--that is, pass the printer name
with no special option preceding it.
-Any value that is not a string is treated as nil.
-
This variable is used only when `ps-printer-name' is a non-empty string."
:type '(choice :menu-tag "Printer Name Option"
:tag "Printer Name Option"
@@ -1782,11 +1769,14 @@ See `ps-lpr-command'."
:version "20"
:group 'ps-print-printer)
-(defcustom ps-print-region-function nil
+(defcustom ps-print-region-function
+ (if (memq system-type '(ms-dos windows-nt))
+ #'direct-ps-print-region-function
+ #'call-process-region)
"Specify a function to print the region on a PostScript printer.
See definition of `call-process-region' for calling conventions. The fourth
and the sixth arguments are both nil."
- :type '(choice (const nil) function)
+ :type 'function
:version "20"
:group 'ps-print-printer)
@@ -1798,7 +1788,7 @@ If it's nil, automatic feeding takes place."
:version "20"
:group 'ps-print-printer)
-(defcustom ps-end-with-control-d (and ps-windows-system t)
+(defcustom ps-end-with-control-d (and lpr-windows-system t)
"Non-nil means insert C-d at end of PostScript file generated."
:version "21.1"
:type 'boolean
@@ -2636,7 +2626,7 @@ NOTE: page numbers are displayed as part of headers,
:group 'ps-print-headers)
(defcustom ps-spool-config
- (if ps-windows-system
+ (if lpr-windows-system
nil
'lpr-switches)
"Specify who is responsible for setting duplex and page size.
@@ -3389,15 +3379,12 @@ It's like the very first character of buffer (or region) is ^L (\\014)."
:group 'ps-print-headers)
(defcustom ps-postscript-code-directory
- (or (if (featurep 'xemacs)
- (cond ((fboundp 'locate-data-directory) ; XEmacs
- (funcall 'locate-data-directory "ps-print"))
- ((boundp 'data-directory) ; XEmacs
- (symbol-value 'data-directory))
- (t ; don't know what to do
- nil))
- data-directory) ; Emacs
- (error "`ps-postscript-code-directory' isn't set properly"))
+ (cond ((fboundp 'locate-data-directory) ; XEmacs
+ (locate-data-directory "ps-print"))
+ ((boundp 'data-directory) ; XEmacs and Emacs.
+ data-directory)
+ (t ; don't know what to do
+ (error "`ps-postscript-code-directory' isn't set properly")))
"Directory where it's located the PostScript prologue file used by ps-print.
By default, this directory is the same as in the variable `data-directory'."
:type 'directory
@@ -3646,8 +3633,7 @@ The table depends on the current ps-print setup."
") ps-print version " ps-print-version "\n")
";; internal vars"
(ps-comment-string "emacs-version " emacs-version)
- (ps-comment-string "ps-windows-system " ps-windows-system)
- (ps-comment-string "ps-lp-system " ps-lp-system)
+ (ps-comment-string "lpr-windows-system" lpr-windows-system)
nil
'(25 . ps-print-color-p)
'(25 . ps-lpr-command)
@@ -5426,8 +5412,8 @@ XSTART YSTART are the relative position for the first page in a sheet.")
"%%Title: " (buffer-name) ; Take job name from name of
; first buffer printed
"\n%%Creator: ps-print v" ps-print-version
- "\n%%For: " (user-full-name)
- "\n%%CreationDate: " (format-time-string "%T %b %d %Y")
+ "\n%%For: " (user-full-name) ;FIXME: may need encoding!
+ "\n%%CreationDate: " (format-time-string "%T %b %d %Y") ;FIXME: encoding!
"\n%%Orientation: "
(if ps-landscape-mode "Landscape" "Portrait")
"\n%%DocumentNeededResources: font Times-Roman Times-Italic\n%%+ font "
@@ -6569,96 +6555,36 @@ If FACE is not a valid face name, use default face."
(write-region (point-min) (point-max) filename))
(and ps-razzle-dazzle (message "Wrote %s" filename)))
;; Else, spool to the printer
- (and ps-razzle-dazzle (message "Printing..."))
(with-current-buffer ps-spool-buffer
(let* ((coding-system-for-write 'raw-text-unix)
- (ps-printer-name (or ps-printer-name
- (and (boundp 'printer-name)
- (symbol-value 'printer-name))))
- (ps-lpr-switches
- (append ps-lpr-switches
- (and (stringp ps-printer-name)
- (string< "" ps-printer-name)
- (list (concat
- (and (stringp ps-printer-name-option)
- ps-printer-name-option)
- ps-printer-name))))))
- (or (stringp ps-printer-name)
- (setq ps-printer-name nil))
- (apply (or ps-print-region-function 'call-process-region)
- (point-min) (point-max) ps-lpr-command nil
- (and (fboundp 'start-process) 0)
- nil
- (ps-flatten-list ; dynamic evaluation
- (ps-string-list
- (mapcar 'ps-eval-switch ps-lpr-switches))))))
- (and ps-razzle-dazzle (message "Printing...done")))
+ (printer-name (or ps-printer-name printer-name))
+ (lpr-printer-switch ps-printer-name-option)
+ (print-region-function ps-print-region-function)
+ (lpr-command ps-lpr-command))
+ (lpr-print-region (point-min) (point-max) ps-lpr-switches nil))))
(kill-buffer ps-spool-buffer)))
-(defun ps-string-list (arg)
- (let (lstr)
- (dolist (elm arg)
- (cond ((stringp elm)
- (setq lstr (cons elm lstr)))
- ((listp elm)
- (let ((s (ps-string-list elm)))
- (when s
- (setq lstr (cons s lstr)))))
- (t ))) ; ignore any other value
- (nreverse lstr)))
-
-;; Dynamic evaluation
-(defun ps-eval-switch (arg)
- (cond ((stringp arg) arg)
- ((functionp arg) (apply arg nil))
- ((symbolp arg) (symbol-value arg))
- ((consp arg) (apply (car arg) (cdr arg)))
- (t nil)))
-
-;; `ps-flatten-list' is defined here (copied from "message.el" and
-;; enhanced to handle dotted pairs as well) until we can get some
-;; sensible autoloads, or `flatten-list' gets put somewhere decent.
-
-;; (ps-flatten-list '((a . b) c (d . e) (f g h) i . j))
-;; => (a b c d e f g h i j)
-
-(defun ps-flatten-list (&rest list)
- (ps-flatten-list-1 list))
-
-(defun ps-flatten-list-1 (list)
- (cond ((null list) nil)
- ((consp list) (append (ps-flatten-list-1 (car list))
- (ps-flatten-list-1 (cdr list))))
- (t (list list))))
-
(defun ps-kill-emacs-check ()
- (let (ps-buffer)
- (and (setq ps-buffer (get-buffer ps-spool-buffer-name))
- (buffer-name ps-buffer) ; check if it's not killed
+ (let ((ps-buffer (get-buffer ps-spool-buffer-name)))
+ (and (buffer-live-p ps-buffer)
(buffer-modified-p ps-buffer)
(y-or-n-p "Unprinted PostScript waiting; print now? ")
- (ps-despool))
- (and (setq ps-buffer (get-buffer ps-spool-buffer-name))
- (buffer-name ps-buffer) ; check if it's not killed
+ (ps-despool)))
+ (let ((ps-buffer (get-buffer ps-spool-buffer-name)))
+ (and (buffer-live-p ps-buffer)
(buffer-modified-p ps-buffer)
(not (yes-or-no-p "Unprinted PostScript waiting; exit anyway? "))
(error "Unprinted PostScript"))))
-(cond ((fboundp 'add-hook)
- (unless noninteractive
- (funcall 'add-hook 'kill-emacs-hook 'ps-kill-emacs-check)))
- (kill-emacs-hook
- (message "Won't override existing `kill-emacs-hook'"))
- (t
- (setq kill-emacs-hook 'ps-kill-emacs-check)))
+(unless noninteractive
+ (add-hook 'kill-emacs-hook #'ps-kill-emacs-check))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; To make this file smaller, some commands go in a separate file.
;; But autoload them here to make the separation invisible.
-;;;### (autoloads (ps-mule-end-job ps-mule-begin-job ps-mule-initialize
-;;;;;; ps-multibyte-buffer) "ps-mule" "ps-mule.el" "b39f881d3a029049994ef6aa3de93c89")
+;;;### (autoloads nil "ps-mule" "ps-mule.el" "a90e8414a27ac8fdf093251ac648d761")
;;; Generated autoloads from ps-mule.el
(defvar ps-multibyte-buffer nil "\
diff --git a/lisp/shell.el b/lisp/shell.el
index 51a0ffc4fe8..a78ab7f81ab 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -284,21 +284,9 @@ Value is a list of strings, which may be nil."
;; Note: There are no explicit references to the variable `explicit-bash-args'.
;; It is used implicitly by M-x shell when the interactive shell is `bash'.
(defcustom explicit-bash-args
- (let* ((prog (or (and (boundp 'explicit-shell-file-name) explicit-shell-file-name)
- (getenv "ESHELL") shell-file-name))
- (name (file-name-nondirectory prog)))
- ;; Tell bash not to use readline, except for bash 1.x which
- ;; doesn't grok --noediting. Bash 1.x has -nolineediting, but
- ;; process-send-eof cannot terminate bash if we use it.
- (if (and (not purify-flag)
- (equal name "bash")
- (file-executable-p prog)
- (string-match "bad option"
- (shell-command-to-string
- (concat (shell-quote-argument prog)
- " --noediting"))))
- '("-i")
- '("--noediting" "-i")))
+ ;; Tell bash not to use readline. It's safe to assume --noediting now,
+ ;; as it was introduced in 1996 in Bash version 2.
+ '("--noediting" "-i")
"Args passed to inferior shell by \\[shell], if the shell is bash.
Value is a list of strings, which may be nil."
:type '(repeat (string :tag "Argument"))
diff --git a/lisp/simple.el b/lisp/simple.el
index 9158452fd64..1fb2fa6014c 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -3141,14 +3141,17 @@ Also, delete any process that is exited or signaled."
(display-buffer (button-get button 'process-buffer)))
(defun list-processes (&optional query-only buffer)
- "Display a list of all processes.
+ "Display a list of all processes that are Emacs sub-processes.
If optional argument QUERY-ONLY is non-nil, only processes with
the query-on-exit flag set are listed.
Any process listed as exited or signaled is actually eliminated
after the listing is made.
Optional argument BUFFER specifies a buffer to use, instead of
\"*Process List*\".
-The return value is always nil."
+The return value is always nil.
+
+This function lists only processes that were launched by Emacs. To
+see other processes running on the system, use `list-system-processes'."
(interactive)
(or (fboundp 'process-list)
(error "Asynchronous subprocesses are not supported on this system"))
@@ -4739,10 +4742,15 @@ lines."
(defun default-font-height ()
"Return the height in pixels of the current buffer's default face font."
- (cond
- ((display-multi-font-p)
- (aref (font-info (face-font 'default)) 3))
- (t (frame-char-height))))
+ (let ((default-font (face-font 'default)))
+ (cond
+ ((and (display-multi-font-p)
+ ;; Avoid calling font-info if the frame's default font was
+ ;; not changed since the frame was created. That's because
+ ;; font-info is expensive for some fonts, see bug #14838.
+ (not (string= (frame-parameter nil 'font) default-font)))
+ (aref (font-info default-font) 3))
+ (t (frame-char-height)))))
(defun default-line-height ()
"Return the pixel height of current buffer's default-face text line.
@@ -4795,6 +4803,8 @@ The value is a floating-point number."
(this-ypos (nth 2 this-lh))
(dlh (default-line-height))
(wslines (window-screen-lines))
+ (edges (window-inside-pixel-edges))
+ (winh (- (nth 3 edges) (nth 1 edges) 1))
py vs last-line)
(if (> (mod wslines 1.0) 0.0)
(setq wslines (round (+ wslines 0.5))))
@@ -4843,7 +4853,7 @@ The value is a floating-point number."
nil)
;; If cursor is not in the bottom scroll margin, and the
;; current line is is not too tall, move forward.
- ((and (or (null this-height) (<= this-height dlh))
+ ((and (or (null this-height) (<= this-height winh))
vpos
(> vpos 0)
(< py last-line))
@@ -4860,7 +4870,7 @@ The value is a floating-point number."
(> vpos 0)
(= py last-line))
;; Don't vscroll if the partially-visible line at window
- ;; bottom has the default height (a.k.a. "just one more text
+ ;; bottom is not too tall (a.k.a. "just one more text
;; line"): in that case, we do want redisplay to behave
;; normally, i.e. recenter or whatever.
;;
@@ -4869,7 +4879,7 @@ The value is a floating-point number."
;; partially-visible glyph row at the end of the window. As
;; we are dealing with floats, we disregard sub-pixel
;; discrepancies between that and DLH.
- (if (and rowh rbot (>= (- (+ rowh rbot) dlh) 1))
+ (if (and rowh rbot (>= (- (+ rowh rbot) winh) 1))
(set-window-vscroll nil dlh t))
(line-move-1 arg noerror to-end)
t)
@@ -4913,10 +4923,13 @@ The value is a floating-point number."
;; If we moved into a tall line, set vscroll to make
;; scrolling through tall images more smooth.
(let ((lh (line-pixel-height))
- (dlh (default-line-height)))
+ (edges (window-inside-pixel-edges))
+ (dlh (default-line-height))
+ winh)
+ (setq winh (- (nth 3 edges) (nth 1 edges) 1))
(if (and (< arg 0)
(< (point) (window-start))
- (> lh dlh))
+ (> lh winh))
(set-window-vscroll
nil
(- lh dlh) t))))
@@ -5520,8 +5533,7 @@ Mode' for details."
(visual-line-mode 1))
(define-globalized-minor-mode global-visual-line-mode
- visual-line-mode turn-on-visual-line-mode
- :lighter " vl")
+ visual-line-mode turn-on-visual-line-mode)
(defun transpose-chars (arg)
@@ -7432,19 +7444,19 @@ warning using STRING as the message.")
;;; Generic dispatcher commands
-;; Macro `alternatives-define' is used to create generic commands.
+;; Macro `define-alternatives' is used to create generic commands.
;; Generic commands are these (like web, mail, news, encrypt, irc, etc.)
;; that can have different alternative implementations where choosing
;; among them is exclusively a matter of user preference.
-;; (alternatives-define COMMAND) creates a new interactive command
+;; (define-alternatives COMMAND) creates a new interactive command
;; M-x COMMAND and a customizable variable COMMAND-alternatives.
;; Typically, the user will not need to customize this variable; packages
;; wanting to add alternative implementations should use
;;
;; ;;;###autoload (push '("My impl name" . my-impl-symbol) COMMAND-alternatives
-(defmacro alternatives-define (command &rest customizations)
+(defmacro define-alternatives (command &rest customizations)
"Define new command `COMMAND'.
The variable `COMMAND-alternatives' will contain alternative
implementations of COMMAND, so that running `C-u M-x COMMAND'
diff --git a/lisp/subr.el b/lisp/subr.el
index a2afe0768c4..453ac7e049d 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1498,9 +1498,10 @@ other hooks, such as major mode hooks, can do the job."
;; FIXME: Something like this could be used for `set' as well.
(if (or (not (eq 'quote (car-safe list-var)))
(special-variable-p (cadr list-var))
- (and append compare-fn))
+ (not (macroexp-const-p append)))
exp
(let* ((sym (cadr list-var))
+ (append (eval append))
(msg (format "`add-to-list' can't use lexical var `%s'; use `push' or `cl-pushnew'"
sym))
;; Big ugly hack so we only output a warning during
@@ -1513,13 +1514,17 @@ other hooks, such as major mode hooks, can do the job."
(when (assq sym byte-compile--lexical-environment)
(byte-compile-log-warning msg t :error))))
(code
- (if append
- (macroexp-let2 macroexp-copyable-p x element
- `(unless (member ,x ,sym)
- (setq ,sym (append ,sym (list ,x)))))
- (require 'cl-lib)
- `(cl-pushnew ,element ,sym
- :test ,(or compare-fn '#'equal)))))
+ (macroexp-let2 macroexp-copyable-p x element
+ `(unless ,(if compare-fn
+ (progn
+ (require 'cl-lib)
+ `(cl-member ,x ,sym :test ,compare-fn))
+ ;; For bootstrapping reasons, don't rely on
+ ;; cl--compiler-macro-member for the base case.
+ `(member ,x ,sym))
+ ,(if append
+ `(setq ,sym (append ,sym (list ,x)))
+ `(push ,x ,sym))))))
(if (not (macroexp--compiling-p))
code
`(progn
@@ -3529,7 +3534,7 @@ likely to have undesired semantics.")
;; defaulted, OMIT-NULLS should be treated as t. Simplifying the logical
;; expression leads to the equivalent implementation that if SEPARATORS
;; is defaulted, OMIT-NULLS is treated as t.
-(defun split-string (string &optional separators omit-nulls)
+(defun split-string (string &optional separators omit-nulls trim)
"Split STRING into substrings bounded by matches for SEPARATORS.
The beginning and end of STRING, and each match for SEPARATORS, are
@@ -3547,17 +3552,50 @@ that for the default value of SEPARATORS leading and trailing whitespace
are effectively trimmed). If nil, all zero-length substrings are retained,
which correctly parses CSV format, for example.
+If TRIM is non-nil, it should be a regular expression to match
+text to trim from the beginning and end of each substring. If trimming
+makes the substring empty, it is treated as null.
+
+If you want to trim whitespace from the substrings, the reliably correct
+way is using TRIM. Making SEPARATORS match that whitespace gives incorrect
+results when there is whitespace at the start or end of STRING. If you
+see such calls to `split-string', please fix them.
+
Note that the effect of `(split-string STRING)' is the same as
`(split-string STRING split-string-default-separators t)'. In the rare
case that you wish to retain zero-length substrings when splitting on
whitespace, use `(split-string STRING split-string-default-separators)'.
Modifies the match data; use `save-match-data' if necessary."
- (let ((keep-nulls (not (if separators omit-nulls t)))
- (rexp (or separators split-string-default-separators))
- (start 0)
- notfirst
- (list nil))
+ (let* ((keep-nulls (not (if separators omit-nulls t)))
+ (rexp (or separators split-string-default-separators))
+ (start 0)
+ this-start this-end
+ notfirst
+ (list nil)
+ (push-one
+ ;; Push the substring in range THIS-START to THIS-END
+ ;; onto LIST, trimming it and perhaps discarding it.
+ (lambda ()
+ (when trim
+ ;; Discard the trim from start of this substring.
+ (let ((tem (string-match trim string this-start)))
+ (and (eq tem this-start)
+ (setq this-start (match-end 0)))))
+
+ (when (or keep-nulls (< this-start this-end))
+ (let ((this (substring string this-start this-end)))
+
+ ;; Discard the trim from end of this substring.
+ (when trim
+ (let ((tem (string-match (concat trim "\\'") this 0)))
+ (and tem (< tem (length this))
+ (setq this (substring this 0 tem)))))
+
+ ;; Trimming could make it empty; check again.
+ (when (or keep-nulls (> (length this) 0))
+ (push this list)))))))
+
(while (and (string-match rexp string
(if (and notfirst
(= start (match-beginning 0))
@@ -3565,15 +3603,15 @@ Modifies the match data; use `save-match-data' if necessary."
(1+ start) start))
(< start (length string)))
(setq notfirst t)
- (if (or keep-nulls (< start (match-beginning 0)))
- (setq list
- (cons (substring string start (match-beginning 0))
- list)))
- (setq start (match-end 0)))
- (if (or keep-nulls (< start (length string)))
- (setq list
- (cons (substring string start)
- list)))
+ (setq this-start start this-end (match-beginning 0)
+ start (match-end 0))
+
+ (funcall push-one))
+
+ ;; Handle the substring at the end of STRING.
+ (setq this-start start this-end (length string))
+ (funcall push-one)
+
(nreverse list)))
(defun combine-and-quote-strings (strings &optional separator)
@@ -4153,22 +4191,6 @@ I is the index of the frame after FRAME2. It should return nil
if those frames don't seem special and otherwise, it should return
the number of frames to skip (minus 1).")
-(defmacro internal--called-interactively-p--get-frame (n)
- ;; `sym' will hold a global variable, which will be used kind of like C's
- ;; "static" variables.
- (let ((sym (make-symbol "base-index")))
- `(progn
- (defvar ,sym)
- (unless (boundp ',sym)
- (let ((i 1))
- (while (not (eq (indirect-function (nth 1 (backtrace-frame i)) t)
- (indirect-function 'called-interactively-p)))
- (setq i (1+ i)))
- (setq ,sym i)))
- ;; (unless (eq (nth 1 (backtrace-frame ,sym)) 'called-interactively-p)
- ;; (error "called-interactively-p: %s is out-of-sync!" ,sym))
- (backtrace-frame (+ ,sym ,n)))))
-
(defun called-interactively-p (&optional kind)
"Return t if the containing function was called by `call-interactively'.
If KIND is `interactive', then only return t if the call was made
@@ -4203,7 +4225,7 @@ command is called from a keyboard macro?"
(get-next-frame
(lambda ()
(setq frame nextframe)
- (setq nextframe (internal--called-interactively-p--get-frame i))
+ (setq nextframe (backtrace-frame i 'called-interactively-p))
;; (message "Frame %d = %S" i nextframe)
(setq i (1+ i)))))
(funcall get-next-frame) ;; Get the first frame.
diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog
index 43a14985ae2..254ea5db4e4 100644
--- a/lisp/url/ChangeLog
+++ b/lisp/url/ChangeLog
@@ -1,3 +1,15 @@
+2013-07-22 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * url-http.el (status): Remove, unused.
+ (success): Remove var.
+ (url-http-handle-authentication): Return the value that `success'
+ should take instead of setting `success' directly. Don't set `status'
+ since it's not used.
+ (url-http-parse-headers): Avoid unneeded setq.
+ Move the `setq success'.
+ (url-http): Use pcase.
+ (url-http-file-exists-p): Simplify.
+
2013-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
* url-cookie.el: Implement a command and mode for displaying and
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 33fc5722759..7f21a38c535 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -375,9 +375,6 @@ Return the number of characters removed."
(replace-match ""))
(- end url-http-end-of-headers)))
-(defvar status)
-(defvar success)
-
(defun url-http-handle-authentication (proxy)
(url-http-debug "Handling %s authentication" (if proxy "proxy" "normal"))
(let ((auths (or (nreverse
@@ -404,9 +401,9 @@ Return the number of characters removed."
(url-strip-leading-spaces
this-auth)))
(let* ((this-type
- (if (string-match "[ \t]" this-auth)
- (downcase (substring this-auth 0 (match-beginning 0)))
- (downcase this-auth)))
+ (downcase (if (string-match "[ \t]" this-auth)
+ (substring this-auth 0 (match-beginning 0))
+ this-auth)))
(registered (url-auth-registered this-type))
(this-strength (cddr registered)))
(when (and registered (> this-strength strength))
@@ -421,20 +418,26 @@ Return the number of characters removed."
(insert "<hr>Sorry, but I do not know how to handle " type
" authentication. If you'd like to write it,"
" send it to " url-bug-address ".<hr>")
- (setq status t))
+ ;; We used to set a `status' var (declared "special") but I can't
+ ;; find the corresponding let-binding, so it's probably an error.
+ ;; FIXME: Maybe it was supposed to set `success', i.e. to return t?
+ ;; (setq status t)
+ nil) ;; Not success yet.
+
(let* ((args (url-parse-args (subst-char-in-string ?, ?\; auth)))
(auth (url-get-authentication auth-url
(cdr-safe (assoc "realm" args))
type t args)))
(if (not auth)
- (setq success t)
+ t ;Success.
(push (cons (if proxy "Proxy-Authorization" "Authorization") auth)
url-http-extra-headers)
(let ((url-request-method url-http-method)
(url-request-data url-http-data)
(url-request-extra-headers url-http-extra-headers))
(url-retrieve-internal url url-callback-function
- url-callback-arguments)))))))
+ url-callback-arguments))
+ nil))))) ;; Not success yet.
(defun url-http-parse-response ()
"Parse just the response code."
@@ -498,12 +501,11 @@ should be shown to the user."
(when (and connection
(string= (downcase connection) "close"))
(delete-process url-http-process)))))
- (let ((buffer (current-buffer))
- (class nil)
- (success nil)
- ;; other status symbols: jewelry and luxury cars
- (status-symbol (cadr (assq url-http-response-status url-http-codes))))
- (setq class (/ url-http-response-status 100))
+ (let* ((buffer (current-buffer))
+ (class (/ url-http-response-status 100))
+ (success nil)
+ ;; other status symbols: jewelry and luxury cars
+ (status-symbol (cadr (assq url-http-response-status url-http-codes))))
(url-http-debug "Parsed HTTP headers: class=%d status=%d"
class url-http-response-status)
(when (url-use-cookies url-http-target-url)
@@ -536,15 +538,14 @@ should be shown to the user."
(pcase status-symbol
((or `no-content `reset-content)
;; No new data, just stay at the same document
- (url-mark-buffer-as-dead buffer)
- (setq success t))
+ (url-mark-buffer-as-dead buffer))
(_
;; Generic success for all others. Store in the cache, and
;; mark it as successful.
(widen)
(if (and url-automatic-caching (equal url-http-method "GET"))
- (url-store-in-cache buffer))
- (setq success t))))
+ (url-store-in-cache buffer))))
+ (setq success t))
(3 ; Redirection
;; 300 Multiple choices
;; 301 Moved permanently
@@ -684,106 +685,107 @@ should be shown to the user."
;; 422 Unprocessable Entity (Added by DAV)
;; 423 Locked
;; 424 Failed Dependency
- (pcase status-symbol
- (`unauthorized ; 401
- ;; The request requires user authentication. The response
- ;; MUST include a WWW-Authenticate header field containing a
- ;; challenge applicable to the requested resource. The
- ;; client MAY repeat the request with a suitable
- ;; Authorization header field.
- (url-http-handle-authentication nil))
- (`payment-required ; 402
- ;; This code is reserved for future use
- (url-mark-buffer-as-dead buffer)
- (error "Somebody wants you to give them money"))
- (`forbidden ; 403
- ;; The server understood the request, but is refusing to
- ;; fulfill it. Authorization will not help and the request
- ;; SHOULD NOT be repeated.
- (setq success t))
- (`not-found ; 404
- ;; Not found
- (setq success t))
- (`method-not-allowed ; 405
- ;; The method specified in the Request-Line is not allowed
- ;; for the resource identified by the Request-URI. The
- ;; response MUST include an Allow header containing a list of
- ;; valid methods for the requested resource.
- (setq success t))
- (`not-acceptable ; 406
- ;; The resource identified by the request is only capable of
- ;; generating response entities which have content
- ;; characteristics not acceptable according to the accept
- ;; headers sent in the request.
- (setq success t))
- (`proxy-authentication-required ; 407
- ;; This code is similar to 401 (Unauthorized), but indicates
- ;; that the client must first authenticate itself with the
- ;; proxy. The proxy MUST return a Proxy-Authenticate header
- ;; field containing a challenge applicable to the proxy for
- ;; the requested resource.
- (url-http-handle-authentication t))
- (`request-timeout ; 408
- ;; The client did not produce a request within the time that
- ;; the server was prepared to wait. The client MAY repeat
- ;; the request without modifications at any later time.
- (setq success t))
- (`conflict ; 409
- ;; The request could not be completed due to a conflict with
- ;; the current state of the resource. This code is only
- ;; allowed in situations where it is expected that the user
- ;; might be able to resolve the conflict and resubmit the
- ;; request. The response body SHOULD include enough
- ;; information for the user to recognize the source of the
- ;; conflict.
- (setq success t))
- (`gone ; 410
- ;; The requested resource is no longer available at the
- ;; server and no forwarding address is known.
- (setq success t))
- (`length-required ; 411
- ;; The server refuses to accept the request without a defined
- ;; Content-Length. The client MAY repeat the request if it
- ;; adds a valid Content-Length header field containing the
- ;; length of the message-body in the request message.
- ;;
- ;; NOTE - this will never happen because
- ;; `url-http-create-request' automatically calculates the
- ;; content-length.
- (setq success t))
- (`precondition-failed ; 412
- ;; The precondition given in one or more of the
- ;; request-header fields evaluated to false when it was
- ;; tested on the server.
- (setq success t))
- ((or `request-entity-too-large `request-uri-too-large) ; 413 414
- ;; The server is refusing to process a request because the
- ;; request entity|URI is larger than the server is willing or
- ;; able to process.
- (setq success t))
- (`unsupported-media-type ; 415
- ;; The server is refusing to service the request because the
- ;; entity of the request is in a format not supported by the
- ;; requested resource for the requested method.
- (setq success t))
- (`requested-range-not-satisfiable ; 416
- ;; A server SHOULD return a response with this status code if
- ;; a request included a Range request-header field, and none
- ;; of the range-specifier values in this field overlap the
- ;; current extent of the selected resource, and the request
- ;; did not include an If-Range request-header field.
- (setq success t))
- (`expectation-failed ; 417
- ;; The expectation given in an Expect request-header field
- ;; could not be met by this server, or, if the server is a
- ;; proxy, the server has unambiguous evidence that the
- ;; request could not be met by the next-hop server.
- (setq success t))
- (_
- ;; The request could not be understood by the server due to
- ;; malformed syntax. The client SHOULD NOT repeat the
- ;; request without modifications.
- (setq success t)))
+ (setq success
+ (pcase status-symbol
+ (`unauthorized ; 401
+ ;; The request requires user authentication. The response
+ ;; MUST include a WWW-Authenticate header field containing a
+ ;; challenge applicable to the requested resource. The
+ ;; client MAY repeat the request with a suitable
+ ;; Authorization header field.
+ (url-http-handle-authentication nil))
+ (`payment-required ; 402
+ ;; This code is reserved for future use
+ (url-mark-buffer-as-dead buffer)
+ (error "Somebody wants you to give them money"))
+ (`forbidden ; 403
+ ;; The server understood the request, but is refusing to
+ ;; fulfill it. Authorization will not help and the request
+ ;; SHOULD NOT be repeated.
+ t)
+ (`not-found ; 404
+ ;; Not found
+ t)
+ (`method-not-allowed ; 405
+ ;; The method specified in the Request-Line is not allowed
+ ;; for the resource identified by the Request-URI. The
+ ;; response MUST include an Allow header containing a list of
+ ;; valid methods for the requested resource.
+ t)
+ (`not-acceptable ; 406
+ ;; The resource identified by the request is only capable of
+ ;; generating response entities which have content
+ ;; characteristics not acceptable according to the accept
+ ;; headers sent in the request.
+ t)
+ (`proxy-authentication-required ; 407
+ ;; This code is similar to 401 (Unauthorized), but indicates
+ ;; that the client must first authenticate itself with the
+ ;; proxy. The proxy MUST return a Proxy-Authenticate header
+ ;; field containing a challenge applicable to the proxy for
+ ;; the requested resource.
+ (url-http-handle-authentication t))
+ (`request-timeout ; 408
+ ;; The client did not produce a request within the time that
+ ;; the server was prepared to wait. The client MAY repeat
+ ;; the request without modifications at any later time.
+ t)
+ (`conflict ; 409
+ ;; The request could not be completed due to a conflict with
+ ;; the current state of the resource. This code is only
+ ;; allowed in situations where it is expected that the user
+ ;; might be able to resolve the conflict and resubmit the
+ ;; request. The response body SHOULD include enough
+ ;; information for the user to recognize the source of the
+ ;; conflict.
+ t)
+ (`gone ; 410
+ ;; The requested resource is no longer available at the
+ ;; server and no forwarding address is known.
+ t)
+ (`length-required ; 411
+ ;; The server refuses to accept the request without a defined
+ ;; Content-Length. The client MAY repeat the request if it
+ ;; adds a valid Content-Length header field containing the
+ ;; length of the message-body in the request message.
+ ;;
+ ;; NOTE - this will never happen because
+ ;; `url-http-create-request' automatically calculates the
+ ;; content-length.
+ t)
+ (`precondition-failed ; 412
+ ;; The precondition given in one or more of the
+ ;; request-header fields evaluated to false when it was
+ ;; tested on the server.
+ t)
+ ((or `request-entity-too-large `request-uri-too-large) ; 413 414
+ ;; The server is refusing to process a request because the
+ ;; request entity|URI is larger than the server is willing or
+ ;; able to process.
+ t)
+ (`unsupported-media-type ; 415
+ ;; The server is refusing to service the request because the
+ ;; entity of the request is in a format not supported by the
+ ;; requested resource for the requested method.
+ t)
+ (`requested-range-not-satisfiable ; 416
+ ;; A server SHOULD return a response with this status code if
+ ;; a request included a Range request-header field, and none
+ ;; of the range-specifier values in this field overlap the
+ ;; current extent of the selected resource, and the request
+ ;; did not include an If-Range request-header field.
+ t)
+ (`expectation-failed ; 417
+ ;; The expectation given in an Expect request-header field
+ ;; could not be met by this server, or, if the server is a
+ ;; proxy, the server has unambiguous evidence that the
+ ;; request could not be met by the next-hop server.
+ t)
+ (_
+ ;; The request could not be understood by the server due to
+ ;; malformed syntax. The client SHOULD NOT repeat the
+ ;; request without modifications.
+ t)))
;; Tell the callback that an error occurred, and what the
;; status code was.
(when success
@@ -1222,18 +1224,17 @@ previous `url-http' call, which is being re-attempted."
(set-process-buffer connection buffer)
(set-process-filter connection 'url-http-generic-filter)
- (let ((status (process-status connection)))
- (cond
- ((eq status 'connect)
- ;; Asynchronous connection
- (set-process-sentinel connection 'url-http-async-sentinel))
- ((eq status 'failed)
- ;; Asynchronous connection failed
- (error "Could not create connection to %s:%d" host port))
- (t
- (set-process-sentinel connection
- 'url-http-end-of-document-sentinel)
- (process-send-string connection (url-http-create-request)))))))
+ (pcase (process-status connection)
+ (`connect
+ ;; Asynchronous connection
+ (set-process-sentinel connection 'url-http-async-sentinel))
+ (`failed
+ ;; Asynchronous connection failed
+ (error "Could not create connection to %s:%d" host port))
+ (_
+ (set-process-sentinel connection
+ 'url-http-end-of-document-sentinel)
+ (process-send-string connection (url-http-create-request))))))
buffer))
(defun url-http-async-sentinel (proc why)
@@ -1302,17 +1303,14 @@ previous `url-http' call, which is being re-attempted."
(url-retrieve-synchronously url)))
(defun url-http-file-exists-p (url)
- (let ((status nil)
- (exists nil)
- (buffer (url-http-head url)))
- (if (not buffer)
- (setq exists nil)
- (setq status (url-http-symbol-value-in-buffer 'url-http-response-status
- buffer 500)
- exists (and (integerp status)
- (>= status 200) (< status 300)))
- (kill-buffer buffer))
- exists))
+ (let ((buffer (url-http-head url)))
+ (when buffer
+ (let ((status (url-http-symbol-value-in-buffer 'url-http-response-status
+ buffer 500)))
+ (prog1
+ (and (integerp status)
+ (>= status 200) (< status 300))
+ (kill-buffer buffer))))))
(defalias 'url-http-file-readable-p 'url-http-file-exists-p)
diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el
index 80f78496a43..325e66ea530 100644
--- a/lisp/vc/vc-dir.el
+++ b/lisp/vc/vc-dir.el
@@ -240,6 +240,7 @@ See `run-hooks'."
(define-key map "i" 'vc-register) ;; C-x v i
(define-key map "+" 'vc-update) ;; C-x v +
(define-key map "l" 'vc-print-log) ;; C-x v l
+ (define-key map "L" 'vc-print-root-log) ;; C-x v L
;; More confusing than helpful, probably
;;(define-key map "R" 'vc-revert) ;; u is taken by vc-dir-unmark.
;;(define-key map "A" 'vc-annotate) ;; g is taken by revert-buffer
diff --git a/lisp/window.el b/lisp/window.el
index a2acd2a81b0..86d93c0a9f6 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -5470,6 +5470,9 @@ argument, ACTION is t."
(let ((buffer (if (bufferp buffer-or-name)
buffer-or-name
(get-buffer buffer-or-name)))
+ ;; Make sure that when we split windows the old window keeps
+ ;; point, bug#14829.
+ (split-window-keep-point t)
;; Handle the old form of the first argument.
(inhibit-same-window (and action (not (listp action)))))
(unless (listp action) (setq action nil))
diff --git a/lisp/winner.el b/lisp/winner.el
index f521ba0521b..e7e7d0614b4 100644
--- a/lisp/winner.el
+++ b/lisp/winner.el
@@ -342,31 +342,18 @@ You may want to include buffer names such as *Help*, *Apropos*,
map)
"Keymap for Winner mode.")
-;; Check if `window-configuration-change-hook' is working.
-(defun winner-hook-installed-p ()
- (save-window-excursion
- (let ((winner-var nil)
- (window-configuration-change-hook
- '((lambda () (setq winner-var t)))))
- (split-window)
- winner-var)))
-
;;;###autoload
(define-minor-mode winner-mode nil :global t ; let d-m-m make the doc
(if winner-mode
(progn
- (if (winner-hook-installed-p)
- (progn
- (add-hook 'window-configuration-change-hook 'winner-change-fun)
- (add-hook 'post-command-hook 'winner-save-old-configurations))
- (add-hook 'post-command-hook 'winner-save-conditionally))
+ (add-hook 'window-configuration-change-hook 'winner-change-fun)
+ (add-hook 'post-command-hook 'winner-save-old-configurations)
(add-hook 'minibuffer-setup-hook 'winner-save-unconditionally)
(setq winner-modified-list (frame-list))
(winner-save-old-configurations))
(remove-hook 'window-configuration-change-hook 'winner-change-fun)
(remove-hook 'post-command-hook 'winner-save-old-configurations)
- (remove-hook 'post-command-hook 'winner-save-conditionally)
(remove-hook 'minibuffer-setup-hook 'winner-save-unconditionally)))
;; Inspired by undo (simple.el)