summaryrefslogtreecommitdiff
path: root/lisp
diff options
context:
space:
mode:
authorPaul Eggert <eggert@cs.ucla.edu>2011-08-24 14:20:36 -0700
committerPaul Eggert <eggert@cs.ucla.edu>2011-08-24 14:20:36 -0700
commit011ba6eaacfa50cc9871d0cfea34e8f0a7a5bc43 (patch)
treeced7a98ff1eb289559da6ebfda46a8e436640da6 /lisp
parentfe4496a6e27ac892283b8568adbd12831868cc54 (diff)
parentf22f4808a08e8f985d5e6175bbd13d5260e1ab1a (diff)
downloademacs-011ba6eaacfa50cc9871d0cfea34e8f0a7a5bc43.tar.gz
Merge from trunk.
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog219
-rw-r--r--lisp/battery.el2
-rw-r--r--lisp/bindings.el1
-rw-r--r--lisp/cus-start.el7
-rw-r--r--lisp/emacs-lisp/debug.el34
-rw-r--r--lisp/emacs-lisp/edebug.el2
-rw-r--r--lisp/emacs-lisp/eieio.el116
-rw-r--r--lisp/emacs-lisp/find-func.el8
-rw-r--r--lisp/faces.el2
-rw-r--r--lisp/files.el9
-rw-r--r--lisp/font-lock.el12
-rw-r--r--lisp/gnus/ChangeLog59
-rw-r--r--lisp/gnus/gnus-agent.el2
-rw-r--r--lisp/gnus/gnus-art.el2
-rw-r--r--lisp/gnus/gnus-group.el15
-rw-r--r--lisp/gnus/gnus-html.el15
-rw-r--r--lisp/gnus/gnus-sum.el58
-rw-r--r--lisp/gnus/gnus-util.el66
-rw-r--r--lisp/gnus/message.el8
-rw-r--r--lisp/gnus/nnimap.el3
-rw-r--r--lisp/gnus/nnmail.el33
-rw-r--r--lisp/gnus/nntp.el5
-rw-r--r--lisp/gnus/pop3.el2
-rw-r--r--lisp/gnus/starttls.el4
-rw-r--r--lisp/help.el2
-rw-r--r--lisp/ibuffer.el4
-rw-r--r--lisp/international/charprop.el26
-rw-r--r--lisp/international/ucs-normalize.el10
-rw-r--r--lisp/international/uni-bidi.elbin8719 -> 7950 bytes
-rw-r--r--lisp/international/uni-category.elbin11396 -> 12759 bytes
-rw-r--r--lisp/international/uni-combining.elbin8369 -> 6251 bytes
-rw-r--r--lisp/international/uni-comment.elbin2386 -> 2407 bytes
-rw-r--r--lisp/international/uni-decimal.elbin1869 -> 2710 bytes
-rw-r--r--lisp/international/uni-decomposition.elbin28459 -> 28497 bytes
-rw-r--r--lisp/international/uni-digit.elbin2187 -> 3028 bytes
-rw-r--r--lisp/international/uni-lowercase.elbin5347 -> 6421 bytes
-rw-r--r--lisp/international/uni-mirrored.elbin10452 -> 9342 bytes
-rw-r--r--lisp/international/uni-name.elbin158765 -> 158786 bytes
-rw-r--r--lisp/international/uni-numeric.elbin3688 -> 4522 bytes
-rw-r--r--lisp/international/uni-old-name.elbin19692 -> 19713 bytes
-rw-r--r--lisp/international/uni-titlecase.elbin5434 -> 6462 bytes
-rw-r--r--lisp/international/uni-uppercase.elbin5430 -> 6458 bytes
-rw-r--r--lisp/isearch.el30
-rw-r--r--lisp/mail/smtpmail.el49
-rw-r--r--lisp/minibuffer.el22
-rw-r--r--lisp/mpc.el39
-rw-r--r--lisp/net/browse-url.el34
-rw-r--r--lisp/pcomplete.el18
-rw-r--r--lisp/proced.el2
-rw-r--r--lisp/progmodes/cc-engine.el4
-rw-r--r--lisp/progmodes/cc-fonts.el214
-rw-r--r--lisp/progmodes/cc-langs.el17
-rw-r--r--lisp/progmodes/compile.el17
-rw-r--r--lisp/progmodes/grep.el7
-rw-r--r--lisp/progmodes/scheme.el28
-rw-r--r--lisp/progmodes/sh-script.el2
-rw-r--r--lisp/shell.el20
-rw-r--r--lisp/startup.el2
-rw-r--r--lisp/term.el21
-rw-r--r--lisp/tutorial.el11
-rw-r--r--lisp/view.el4
-rw-r--r--lisp/window.el125
62 files changed, 944 insertions, 448 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 38c536af62c..762779cc01e 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,218 @@
+2011-08-24 Juri Linkov <juri@jurta.org>
+
+ * proced.el (proced-marked): Inherit from `error' instead of
+ `font-lock-warning-face'.
+
+ * ibuffer.el (ibuffer-marked-face): Change default face from
+ `font-lock-warning-face' to `warning'.
+ (ibuffer-deletion-face): Change default face from
+ `font-lock-type-face' to `error'.
+
+ * battery.el (battery-update): Use the face `error' instead of
+ `font-lock-warning-face' (bug#6117).
+
+2011-08-24 Juri Linkov <juri@jurta.org>
+
+ * faces.el (success): Change face color from "Green3" to
+ "ForestGreen" on light background (bug#9353).
+
+2011-08-24 Chong Yidong <cyd@stupidchicken.com>
+
+ * window.el (quit-window): Renamed from quit-restore-window. Use
+ same arglist as old quit-window.
+ (frame-auto-delete): Doc fix.
+
+ * view.el (view-mode-exit): Use quit-window.
+
+2011-08-24 Juri Linkov <juri@jurta.org>
+
+ * isearch.el (isearch-ring-adjust1): Start visiting previous
+ search strings from the index 0 (-1 + 1) instead of 1 (0 + 1).
+ (isearch-repeat, isearch-edit-string): Call `isearch-ring-adjust1'
+ for empty search string (when the last search string is reused
+ automatically) to adjust the isearch ring to the last element and
+ prepare the correct index for further M-p commands (bug#9185).
+
+2011-08-24 Kenichi Handa <handa@m17n.org>
+
+ * international/ucs-normalize.el: If decomposition property of
+ CHAR is the default one (i.e. a list of CHAR itself), treat it as
+ nil.
+ (nfd, nfkd): Likewise.
+
+2011-08-24 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * mpc.el (mpc--proc-filter): Don't signal mpc-proc-error since signals
+ from process filters aren't reliably transmitted to the surrounding
+ accept-process-output.
+ (mpc-proc-check): New function.
+ (mpc-proc-sync): Use it (bug#8293)
+
+2011-08-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/eieio.el (eieio-defmethod, eieio-defgeneric):
+ Add compatibility functions (bug#9313).
+
+2011-08-23 Eli Zaretskii <eliz@gnu.org>
+
+ * cus-start.el (all): Add entry for bidi-paragraph-direction.
+
+ * international/uni-bidi.el: Regenerated.
+
+2011-08-23 Kenichi Handa <handa@m17n.org>
+
+ * international/charprop.el:
+ * international/uni-bidi.el:
+ * international/uni-category.el:
+ * international/uni-combining.el:
+ * international/uni-comment.el:
+ * international/uni-decimal.el:
+ * international/uni-decomposition.el:
+ * international/uni-digit.el:
+ * international/uni-lowercase.el:
+ * international/uni-mirrored.el:
+ * international/uni-name.el:
+ * international/uni-numeric.el:
+ * international/uni-old-name.el:
+ * international/uni-titlecase.el:
+ * international/uni-uppercase.el: Regenerate.
+
+2011-08-23 Martin Rudalics <rudalics@gmx.at>
+
+ * help.el (help-window-setup): Fix message displayed when other
+ window is reused. (Bug#9341)
+
+2011-08-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * shell.el (shell-completion-vars): Set pcomplete-arg-quote-list.
+ * pcomplete.el (pcomplete-quote-argument): Fix thinko (bug#9161).
+
+ * pcomplete.el (pcomplete-parse-comint-arguments): Fix inf-loop.
+ Mark obsolete.
+ * shell.el (shell-parse-pcomplete-arguments): New function.
+ (shell-completion-vars): Use it instead (bug#9160).
+
+2011-08-22 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/sh-script.el (sh-maybe-here-document): Disable magic in
+ strings and comments (bug#9333).
+
+ * emacs-lisp/debug.el (debug-arglist): New function.
+ (debug-convert-byte-code): Use it. Handle lexical byte-codes.
+ (debug-on-entry-1): Handle interpreted closures (bug#9120).
+
+2011-08-22 Juri Linkov <juri@jurta.org>
+
+ * progmodes/compile.el (compilation-mode-font-lock-keywords):
+ Revert regexp that highlights output switches to its old
+ pre-2010-10-28 value and remove one `?' from it (bug#9319).
+
+ * progmodes/grep.el (grep-process-setup): Use `buffer-modified-p'
+ to check for empty output (bug#9226).
+
+2011-08-22 Chong Yidong <cyd@stupidchicken.com>
+
+ * progmodes/scheme.el (scheme-mode-syntax-table): Don't use
+ symbol-constituent as the default, as that stops font-lock from
+ working properly (Bug#8843).
+
+2011-08-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mail/smtpmail.el (smtpmail-via-smtp): Only bind
+ `coding-system-for-*' around the process open call to avoid
+ auth-source side effects.
+ (smtpmail-try-auth-methods): Expand the secret password.
+ (smtpmail-query-smtp-server): Allow `quit'-ing out in case the
+ probe hangs.
+
+2011-08-21 Chong Yidong <cyd@stupidchicken.com>
+
+ * term.el (term-mouse-paste): Yank primary selection (Bug#6845).
+
+ * emacs-lisp/find-func.el (find-function-noselect): New arg
+ lisp-only.
+
+ * emacs-lisp/edebug.el (edebug-instrument-function): Use it to
+ signal an error for built-in functions (Bug#6664).
+
+2011-08-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mail/smtpmail.el (smtpmail-smtp-user): New variable.
+ (smtpmail-try-auth-methods): Use it.
+
+2011-08-21 Chong Yidong <cyd@stupidchicken.com>
+
+ * font-lock.el (font-lock-fontify-region)
+ (font-lock-unfontify-region, font-lock-default-fontify-buffer)
+ (font-lock-default-unfontify-buffer)
+ (font-lock-default-fontify-region)
+ (font-lock-default-unfontify-region): Add docstrings (Bug#8624).
+
+ * progmodes/compile.el (compilation-error-properties):
+ Fix confusion between file struct and message struct (Bug#9319).
+ (compilation-error-regexp-alist-alist): Fix 2011-05-09 change to
+ `ant' regexp.
+
+ * net/browse-url.el (browse-url-firefox): Don't call
+ browse-url-firefox-sentinel unless using -remote (Bug#9328).
+
+2011-08-20 Glenn Morris <rgm@gnu.org>
+
+ * tutorial.el (help-with-tutorial): Avoid an error on short screens.
+
+ * tutorial.el (tutorial--default-keys): Update some default bindings.
+
+ * files.el (hack-local-variables): Fully ignore case for "mode:".
+
+2011-08-20 Alan Mackenzie <acm@muc.de>
+
+ Resolve invalid use of a regexp in regexp-opt.
+
+ * cc-fonts.el (c-complex-decl-matchers): Add in special detection
+ for a java annotation.
+
+ * cc-engine.el (c-forward-decl-or-cast-1): Add in special
+ detection for a java annotation.
+
+ * cc-langs.el (c-prefix-spec-kwds-re): Remove the special handling
+ for java.
+ (c-modifier-kwds): Remove the regexp "@[A-za-z0-9]+".
+
+2011-08-20 Chong Yidong <cyd@stupidchicken.com>
+
+ * startup.el (normal-top-level-add-subdirs-to-load-path): Doc fix
+ (Bug#9274).
+
+2011-08-20 Alan Mackenzie <acm@muc.de>
+
+ * Fontify CPP expressions correctly when starting in the middle of
+ such a construct. Mainly for when jit-lock etc. starts a chunk
+ here.
+
+ * progmodes/cc-fonts.el (c-font-lock-context): new buffer local
+ variable.
+ (c-make-font-lock-search-form): new function, extracted from
+ c-make-font-lock-search-function.
+ (c-make-font-lock-search-function): Use the above function.
+ (c-make-font-lock-context-search-function): New function.
+ (c-cpp-matchers): Enhance the preprocessor expression case with
+ the above function
+ (c-font-lock-complex-decl-prepare): Test for being in a CPP form
+ which takes an expression.
+
+ * progmodes/cc-langs.el (c-cpp-expr-intro-re): New lang-variable.
+
+2011-08-20 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (display-buffer-reuse-window)
+ (display-buffer-pop-up-window): Don't reuse or split a side
+ window.
+
+2011-08-19 Glenn Morris <rgm@gnu.org>
+
+ * files.el (hack-local-variables-prop-line, hack-local-variables):
+ Downcase "Mode:". (Bug#9331)
+
2011-08-18 Chong Yidong <cyd@stupidchicken.com>
* international/characters.el: Add L and R categories.
@@ -28,8 +243,8 @@
binding variables (bug#9298). Also clean up some unused
autoloads.
- * net/network-stream.el (network-stream-open-starttls): Support
- using starttls.el without using gnutls-cli.
+ * net/network-stream.el (network-stream-open-starttls):
+ Support using starttls.el without using gnutls-cli.
2011-08-17 Juri Linkov <juri@jurta.org>
diff --git a/lisp/battery.el b/lisp/battery.el
index d7d3045fa58..e0bba96b655 100644
--- a/lisp/battery.el
+++ b/lisp/battery.el
@@ -199,7 +199,7 @@ seconds."
'face
(and (<= (car (read-from-string (cdr (assq ?p data))))
battery-load-critical)
- 'font-lock-warning-face)
+ 'error)
'help-echo "Battery status information")))
(force-mode-line-update))
diff --git a/lisp/bindings.el b/lisp/bindings.el
index c4f9369219a..57bfeb60f82 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -834,6 +834,7 @@ if `inhibit-field-text-motion' is non-nil."
(setq i (1+ i))))
(define-key global-map [?\C-\M--] 'negative-argument)
+;; Update tutorial--default-keys if you change these.
(define-key global-map "\177" 'delete-backward-char)
(define-key global-map "\C-d" 'delete-char)
diff --git a/lisp/cus-start.el b/lisp/cus-start.el
index 389716b35b9..232c6c3808e 100644
--- a/lisp/cus-start.el
+++ b/lisp/cus-start.el
@@ -118,6 +118,13 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
:standard (not noninteractive)
:initialize custom-initialize-delay
:set custom-set-minor-mode)
+ (bidi-paragraph-direction
+ paragraphs
+ (choice
+ (const :tag "Left to Right" left-to-right)
+ (const :tag "Right to Left" right-to-left)
+ (const :tag "Dynamic, according to paragraph text" nil))
+ "24.1")
;; callint.c
(mark-even-if-inactive editing-basics boolean)
;; callproc.c
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 157749500e7..8276030ccf8 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -778,6 +778,7 @@ Redefining FUNCTION also cancels it."
(not (debugger-special-form-p symbol))))
t nil nil (symbol-name fn)))
(list (if (equal val "") fn (intern val)))))
+ ;; FIXME: Use advice.el.
(when (debugger-special-form-p function)
(error "Function %s is a special form" function))
(if (or (symbolp (symbol-function function))
@@ -835,24 +836,30 @@ To specify a nil argument interactively, exit with an empty minibuffer."
(message "Cancelling debug-on-entry for all functions")
(mapcar 'cancel-debug-on-entry debug-function-list)))
+(defun debug-arglist (definition)
+ ;; FIXME: copied from ad-arglist.
+ "Return the argument list of DEFINITION."
+ (require 'help-fns)
+ (help-function-arglist definition 'preserve-names))
+
(defun debug-convert-byte-code (function)
(let* ((defn (symbol-function function))
(macro (eq (car-safe defn) 'macro)))
(when macro (setq defn (cdr defn)))
- (unless (consp defn)
- ;; Assume a compiled code object.
- (let* ((contents (append defn nil))
+ (when (byte-code-function-p defn)
+ (let* ((args (debug-arglist defn))
(body
- (list (list 'byte-code (nth 1 contents)
- (nth 2 contents) (nth 3 contents)))))
- (if (nthcdr 5 contents)
- (setq body (cons (list 'interactive (nth 5 contents)) body)))
- (if (nth 4 contents)
+ `((,(if (memq '&rest args) #'apply #'funcall)
+ ,defn
+ ,@(remq '&rest (remq '&optional args))))))
+ (if (> (length defn) 5)
+ (push `(interactive ,(aref defn 5)) body))
+ (if (aref defn 4)
;; Use `documentation' here, to get the actual string,
;; in case the compiled function has a reference
;; to the .elc file.
(setq body (cons (documentation function) body)))
- (setq defn (cons 'lambda (cons (car contents) body))))
+ (setq defn `(closure (t) ,args ,@body)))
(when macro (setq defn (cons 'macro defn)))
(fset function defn))))
@@ -861,11 +868,12 @@ To specify a nil argument interactively, exit with an empty minibuffer."
(tail defn))
(when (eq (car-safe tail) 'macro)
(setq tail (cdr tail)))
- (if (not (eq (car-safe tail) 'lambda))
+ (if (not (memq (car-safe tail) '(closure lambda)))
;; Only signal an error when we try to set debug-on-entry.
;; When we try to clear debug-on-entry, we are now done.
(when flag
(error "%s is not a user-defined Lisp function" function))
+ (if (eq (car tail) 'closure) (setq tail (cdr tail)))
(setq tail (cdr tail))
;; Skip the docstring.
(when (and (stringp (cadr tail)) (cddr tail))
@@ -875,9 +883,9 @@ To specify a nil argument interactively, exit with an empty minibuffer."
(setq tail (cdr tail)))
(unless (eq flag (equal (cadr tail) '(implement-debug-on-entry)))
;; Add/remove debug statement as needed.
- (if flag
- (setcdr tail (cons '(implement-debug-on-entry) (cdr tail)))
- (setcdr tail (cddr tail)))))
+ (setcdr tail (if flag
+ (cons '(implement-debug-on-entry) (cdr tail))
+ (cddr tail)))))
defn))
(defun debugger-list-functions ()
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index f84de0308bf..57d25c9e169 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -3408,7 +3408,7 @@ go to the end of the last sexp, or if that is the same point, then step."
(message "%s is already instrumented." func)
func)
(t
- (let ((loc (find-function-noselect func)))
+ (let ((loc (find-function-noselect func t)))
(unless (cdr loc)
(error "Could not find the definition in its file"))
(with-current-buffer (car loc)
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 83c09b6fe0f..f1fe9594fc0 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -1312,20 +1312,20 @@ Summary:
(defun eieio--defmethod (method kind argclass code)
"Work part of the `defmethod' macro defining METHOD with ARGS."
(let ((key
- ;; find optional keys
+ ;; find optional keys
(cond ((or (eq ':BEFORE kind)
(eq ':before kind))
- method-before)
+ method-before)
((or (eq ':AFTER kind)
(eq ':after kind))
- method-after)
+ method-after)
((or (eq ':PRIMARY kind)
(eq ':primary kind))
- method-primary)
+ method-primary)
((or (eq ':STATIC kind)
(eq ':static kind))
- method-static)
- ;; Primary key
+ method-static)
+ ;; Primary key
(t method-primary))))
;; Make sure there is a generic (when called from defclass).
(eieio--defalias
@@ -1338,8 +1338,8 @@ Summary:
;; under the type `primary' which is a non-specific calling of the
;; function.
(if argclass
- (if (not (class-p argclass))
- (error "Unknown class type %s in method parameters"
+ (if (not (class-p argclass))
+ (error "Unknown class type %s in method parameters"
argclass))
(if (= key -1)
(signal 'wrong-type-argument (list :static 'non-class-arg)))
@@ -2864,6 +2864,106 @@ of `eq'."
)
+;;; Obsolete backward compatibility functions.
+;; Needed to run byte-code compiled with the EIEIO of Emacs-23.
+
+(defun eieio-defmethod (method args)
+ "Obsolete work part of an old version of the `defmethod' macro."
+ (let ((key nil) (body nil) (firstarg nil) (argfix nil) (argclass nil) loopa)
+ ;; find optional keys
+ (setq key
+ (cond ((or (eq ':BEFORE (car args))
+ (eq ':before (car args)))
+ (setq args (cdr args))
+ method-before)
+ ((or (eq ':AFTER (car args))
+ (eq ':after (car args)))
+ (setq args (cdr args))
+ method-after)
+ ((or (eq ':PRIMARY (car args))
+ (eq ':primary (car args)))
+ (setq args (cdr args))
+ method-primary)
+ ((or (eq ':STATIC (car args))
+ (eq ':static (car args)))
+ (setq args (cdr args))
+ method-static)
+ ;; Primary key
+ (t method-primary)))
+ ;; get body, and fix contents of args to be the arguments of the fn.
+ (setq body (cdr args)
+ args (car args))
+ (setq loopa args)
+ ;; Create a fixed version of the arguments
+ (while loopa
+ (setq argfix (cons (if (listp (car loopa)) (car (car loopa)) (car loopa))
+ argfix))
+ (setq loopa (cdr loopa)))
+ ;; make sure there is a generic
+ (eieio-defgeneric
+ method
+ (if (stringp (car body))
+ (car body) (format "Generically created method `%s'." method)))
+ ;; create symbol for property to bind to. If the first arg is of
+ ;; the form (varname vartype) and `vartype' is a class, then
+ ;; that class will be the type symbol. If not, then it will fall
+ ;; under the type `primary' which is a non-specific calling of the
+ ;; function.
+ (setq firstarg (car args))
+ (if (listp firstarg)
+ (progn
+ (setq argclass (nth 1 firstarg))
+ (if (not (class-p argclass))
+ (error "Unknown class type %s in method parameters"
+ (nth 1 firstarg))))
+ (if (= key -1)
+ (signal 'wrong-type-argument (list :static 'non-class-arg)))
+ ;; generics are higher
+ (setq key (eieio-specialized-key-to-generic-key key)))
+ ;; Put this lambda into the symbol so we can find it
+ (if (byte-code-function-p (car-safe body))
+ (eieiomt-add method (car-safe body) key argclass)
+ (eieiomt-add method (append (list 'lambda (reverse argfix)) body)
+ key argclass))
+ )
+
+ (when eieio-optimize-primary-methods-flag
+ ;; Optimizing step:
+ ;;
+ ;; If this method, after this setup, only has primary methods, then
+ ;; we can setup the generic that way.
+ (if (generic-primary-only-p method)
+ ;; If there is only one primary method, then we can go one more
+ ;; optimization step.
+ (if (generic-primary-only-one-p method)
+ (eieio-defgeneric-reset-generic-form-primary-only-one method)
+ (eieio-defgeneric-reset-generic-form-primary-only method))
+ (eieio-defgeneric-reset-generic-form method)))
+
+ method)
+(make-obsolete 'eieio-defmethod 'eieio--defmethod "24.1")
+
+(defun eieio-defgeneric (method doc-string)
+ "Obsolete work part of an old version of the `defgeneric' macro."
+ (if (and (fboundp method) (not (generic-p method))
+ (or (byte-code-function-p (symbol-function method))
+ (not (eq 'autoload (car (symbol-function method)))))
+ )
+ (error "You cannot create a generic/method over an existing symbol: %s"
+ method))
+ ;; Don't do this over and over.
+ (unless (fboundp 'method)
+ ;; This defun tells emacs where the first definition of this
+ ;; method is defined.
+ `(defun ,method nil)
+ ;; Make sure the method tables are installed.
+ (eieiomt-install method)
+ ;; Apply the actual body of this function.
+ (fset method (eieio-defgeneric-form method doc-string))
+ ;; Return the method
+ 'method))
+(make-obsolete 'eieio-defgeneric nil "24.1")
+
;;; Interfacing with edebug
;;
(defun eieio-edebug-prin1-to-string (object &optional noescape)
diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el
index 0194af2e3a8..2c7208db8a3 100644
--- a/lisp/emacs-lisp/find-func.el
+++ b/lisp/emacs-lisp/find-func.el
@@ -312,7 +312,7 @@ The search is done in the source for library LIBRARY."
(cons (current-buffer) nil))))))))
;;;###autoload
-(defun find-function-noselect (function)
+(defun find-function-noselect (function &optional lisp-only)
"Return a pair (BUFFER . POINT) pointing to the definition of FUNCTION.
Finds the source file containing the definition of FUNCTION
@@ -320,6 +320,10 @@ in a buffer and the point of the definition. The buffer is
not selected. If the function definition can't be found in
the buffer, returns (BUFFER).
+If FUNCTION is a built-in function, this function normally
+attempts to find it in the Emacs C sources; however, if LISP-ONLY
+is non-nil, signal an error instead.
+
If the file where FUNCTION is defined is not known, then it is
searched for in `find-function-source-path' if non-nil, otherwise
in `load-path'."
@@ -345,6 +349,8 @@ in `load-path'."
(cond ((eq (car-safe def) 'autoload)
(nth 1 def))
((subrp def)
+ (if lisp-only
+ (error "%s is a built-in function" function))
(help-C-file-name def 'subr))
((symbol-file function 'defun)))))
(find-function-search-for-symbol function nil library))))
diff --git a/lisp/faces.el b/lisp/faces.el
index 404bd7b6609..3c4a3330c81 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -2435,7 +2435,7 @@ It is used for characters of no fonts too."
(defface success
'((((class color) (min-colors 16) (background light))
- (:foreground "Green3" :weight bold))
+ (:foreground "ForestGreen" :weight bold))
(((class color) (min-colors 88) (background dark))
(:foreground "Green1" :weight bold))
(((class color) (min-colors 16) (background dark))
diff --git a/lisp/files.el b/lisp/files.el
index 6b8a352f20c..07188e152b3 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -3003,9 +3003,10 @@ mode, if there is one, otherwise nil."
"-mode"))))
(or (equal keyname "coding")
(condition-case nil
- (push (cons (if (eq key 'eval)
- 'eval
- (indirect-variable key))
+ (push (cons (cond ((eq key 'eval) 'eval)
+ ;; Downcase "Mode:".
+ ((equal keyname "mode") 'mode)
+ (t (indirect-variable key)))
val) result)
(error nil))))
(skip-chars-forward " \t;")))
@@ -3153,6 +3154,8 @@ major-mode."
(var (let ((read-circle nil))
(read str)))
val val2)
+ (and (equal (downcase (symbol-name var)) "mode")
+ (setq var 'mode))
;; Read the variable value.
(skip-chars-forward "^:")
(forward-char 1)
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index 9cf889e1aec..c37a9ae916e 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -1018,14 +1018,20 @@ The region it returns may start or end in the middle of a line.")
(funcall font-lock-unfontify-buffer-function))
(defun font-lock-fontify-region (beg end &optional loudly)
+ "Fontify the text between BEG and END.
+If LOUDLY is non-nil, print status messages while fontifying.
+This works by calling `font-lock-fontify-region-function'."
(font-lock-set-defaults)
(funcall font-lock-fontify-region-function beg end loudly))
(defun font-lock-unfontify-region (beg end)
+ "Unfontify the text between BEG and END.
+This works by calling `font-lock-unfontify-region-function'."
(save-buffer-state
(funcall font-lock-unfontify-region-function beg end)))
(defun font-lock-default-fontify-buffer ()
+ "Fontify the whole buffer using `font-lock-fontify-region-function'."
(let ((verbose (if (numberp font-lock-verbose)
(> (buffer-size) font-lock-verbose)
font-lock-verbose)))
@@ -1045,6 +1051,7 @@ The region it returns may start or end in the middle of a line.")
(quit (font-lock-unfontify-buffer)))))))
(defun font-lock-default-unfontify-buffer ()
+ "Unfontify the whole buffer using `font-lock-unfontify-region-function'."
;; Make sure we unfontify etc. in the whole buffer.
(save-restriction
(widen)
@@ -1114,6 +1121,9 @@ Put first the functions more likely to cause a change and cheaper to compute.")
changed))
(defun font-lock-default-fontify-region (beg end loudly)
+ "Fontify the text between BEG and END.
+If LOUDLY is non-nil, print status messages while fontifying.
+This function is the default `font-lock-fontify-region-function'."
(save-buffer-state
;; Use the fontification syntax table, if any.
(with-syntax-table (or font-lock-syntax-table (syntax-table))
@@ -1162,6 +1172,8 @@ This is used by `font-lock-default-unfontify-region' to decide
what properties to clear before refontifying a region.")
(defun font-lock-default-unfontify-region (beg end)
+ "Unfontify the text between BEG and END.
+This function is the default `font-lock-unfontify-region-function'."
(remove-list-of-text-properties
beg end (append
font-lock-extra-managed-props
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 64ac50fe8f0..ad3e26f0f51 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,41 @@
+2011-08-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnmail.el (nnmail-get-new-mail-1): If one mail source bugs out,
+ continue on and do the clean-up phase (bug#9188).
+
+ * gnus-sum.el (gnus-summary-expire-articles): When expiring articles,
+ just ignore groups that can't be opened instead of erroring out
+ (bug#9225).
+
+ * gnus-art.el (gnus-article-update-date-headers): Flip the default to
+ nil since some many people are fuddy-duddies.
+
+ * gnus-html.el (gnus-html-image-fetched): Don't cache zero-length
+ images.
+
+ * nntp.el (nntp-authinfo-file): Mark as obsolete -- use auth-source
+ instead.
+
+ * pop3.el (pop3-wait-for-messages): Don't use Gnus functions here.
+
+ * gnus-util.el (gnus-process-live-p): Copy over compat function.
+
+ * pop3.el (pop3-wait-for-messages): If the pop3 process dies, stop
+ processing.
+
+ * nntp.el (nntp-kill-buffer): Kill the process before killing the
+ buffer to avoid warnings.
+
+2011-08-20 Simon Josefsson <simon@josefsson.org>
+
+ * gnus-agent.el (gnus-agent-expire-done-message): Use %.f as format
+ specified to reduce precision.
+
+2011-08-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnimap.el (nnimap-transform-headers): Protect against (NIL ...)
+ bodystructures (bug#9314).
+
2011-08-19 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-art.el (gnus-insert-mime-button, gnus-mime-display-alternative):
@@ -12,8 +50,29 @@
`gnus-registry-get-id-key' since `gnus-registry-fetch-groups' isn't
available anymore.
+2011-08-12 Simon Josefsson <simon@josefsson.org>
+
+ * starttls.el (starttls-any-program-available): Define as obsolete
+ function.
+
+2011-08-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-util.el (gnus-y-or-n-p): Reinstate the message-clearing y-or-n-p
+ versions which Gnus use when appropriate.
+
+ * gnus-group.el (gnus-group-clear-data): Add a y-or-n query, since it's
+ a pretty destructive command.
+
+ * nnmail.el (nnmail-extra-headers): Clarify slightly (bug#9302).
+
2011-08-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
+ * message.el (message-fix-before-sending): Make a different warning
+ about NUL characters (bug#9270).
+
+ * gnus-sum.el (gnus-auto-select-subject): Allow specifying a function
+ from custom (bug#9260).
+
* gnus-spec.el (gnus-lrm-string): Use 8206 instead of ?\x200e to make
things work in Emacs 22 and XEmacs, too.
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index 424c55c40f5..26222119b98 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -3560,7 +3560,7 @@ articles in every agentized group? "))
units (cdr units)))
(format "Expiry recovered %d NOV entries, deleted %d files,\
- and freed %f %s."
+ and freed %.f %s."
(nth 0 stats)
(nth 1 stats)
size (car units)))
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index c6e0180dadc..eaf0ed52f51 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -1039,7 +1039,7 @@ Some of these headers are updated automatically. See
(item :tag "ISO8601 format" :value 'iso8601)
(item :tag "User-defined" :value 'user-defined)))
-(defcustom gnus-article-update-date-headers 1
+(defcustom gnus-article-update-date-headers nil
"A number that says how often to update the date header (in seconds).
If nil, don't update it at all."
:version "24.1"
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index 2a31ccd34f0..5ae29053b6f 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -3471,13 +3471,14 @@ sort in reverse order."
"Clear all marks and read ranges from the current group.
Obeys the process/prefix convention."
(interactive "P")
- (gnus-group-iterate arg
- (lambda (group)
- (let (info)
- (gnus-info-clear-data (setq info (gnus-get-info group)))
- (gnus-get-unread-articles-in-group info (gnus-active group) t)
- (when (gnus-group-goto-group group)
- (gnus-group-update-group-line))))))
+ (when (gnus-y-or-n-p "Really clear data? ")
+ (gnus-group-iterate arg
+ (lambda (group)
+ (let (info)
+ (gnus-info-clear-data (setq info (gnus-get-info group)))
+ (gnus-get-unread-articles-in-group info (gnus-active group) t)
+ (when (gnus-group-goto-group group)
+ (gnus-group-update-group-line)))))))
(defun gnus-group-clear-data-on-native-groups ()
"Clear all marks and read ranges from all native groups."
diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el
index d3da6aab1b7..f443c4021e2 100644
--- a/lisp/gnus/gnus-html.el
+++ b/lisp/gnus/gnus-html.el
@@ -399,15 +399,16 @@ Use ALT-TEXT for the image string."
(defun gnus-html-image-fetched (status buffer image)
"Callback function called when image has been fetched."
(unless (plist-get status :error)
- (when gnus-html-image-automatic-caching
- (url-store-in-cache (current-buffer)))
(when (and (or (search-forward "\n\n" nil t)
(search-forward "\r\n\r\n" nil t))
- (buffer-live-p buffer))
- (let ((data (buffer-substring (point) (point-max))))
- (with-current-buffer buffer
- (let ((inhibit-read-only t))
- (gnus-html-put-image data (car image) (cadr image)))))))
+ (not (eobp)))
+ (when gnus-html-image-automatic-caching
+ (url-store-in-cache (current-buffer)))
+ (when (buffer-live-p buffer)
+ (let ((data (buffer-substring (point) (point-max))))
+ (with-current-buffer buffer
+ (let ((inhibit-read-only t))
+ (gnus-html-put-image data (car image) (cadr image))))))))
(kill-buffer (current-buffer)))
(defun gnus-html-get-image-data (url)
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index cd4699e6107..c01f91973a0 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -375,7 +375,8 @@ place point on some subject line."
(const unread)
(const first)
(const unseen)
- (const unseen-or-unread)))
+ (const unseen-or-unread)
+ (function :tag "Function to call")))
(defcustom gnus-auto-select-next t
"*If non-nil, offer to go to the next group from the end of the previous.
@@ -10286,34 +10287,33 @@ This will be the case if the article has both been mailed and posted."
;; There are expirable articles in this group, so we run them
;; through the expiry process.
(gnus-message 6 "Expiring articles...")
- (unless (gnus-check-group gnus-newsgroup-name)
- (error "Can't open server for %s" gnus-newsgroup-name))
- ;; The list of articles that weren't expired is returned.
- (save-excursion
- (if expiry-wait
- (let ((nnmail-expiry-wait-function nil)
- (nnmail-expiry-wait expiry-wait))
- (setq es (gnus-request-expire-articles
- expirable gnus-newsgroup-name)))
- (setq es (gnus-request-expire-articles
- expirable gnus-newsgroup-name)))
- (unless total
- (setq gnus-newsgroup-expirable es))
- ;; We go through the old list of expirable, and mark all
- ;; really expired articles as nonexistent.
- (unless (eq es expirable) ;If nothing was expired, we don't mark.
- (let ((gnus-use-cache nil))
- (dolist (article expirable)
- (when (and (not (memq article es))
- (gnus-data-find article))
- (gnus-summary-mark-article article gnus-canceled-mark)
- (run-hook-with-args 'gnus-summary-article-expire-hook
- 'delete
- (gnus-data-header
- (assoc article (gnus-data-list nil)))
- gnus-newsgroup-name
- nil
- nil))))))
+ (when (gnus-check-group gnus-newsgroup-name)
+ ;; The list of articles that weren't expired is returned.
+ (save-excursion
+ (if expiry-wait
+ (let ((nnmail-expiry-wait-function nil)
+ (nnmail-expiry-wait expiry-wait))
+ (setq es (gnus-request-expire-articles
+ expirable gnus-newsgroup-name)))
+ (setq es (gnus-request-expire-articles
+ expirable gnus-newsgroup-name)))
+ (unless total
+ (setq gnus-newsgroup-expirable es))
+ ;; We go through the old list of expirable, and mark all
+ ;; really expired articles as nonexistent.
+ (unless (eq es expirable) ;If nothing was expired, we don't mark.
+ (let ((gnus-use-cache nil))
+ (dolist (article expirable)
+ (when (and (not (memq article es))
+ (gnus-data-find article))
+ (gnus-summary-mark-article article gnus-canceled-mark)
+ (run-hook-with-args 'gnus-summary-article-expire-hook
+ 'delete
+ (gnus-data-header
+ (assoc article (gnus-data-list nil)))
+ gnus-newsgroup-name
+ nil
+ nil)))))))
(gnus-message 6 "Expiring articles...done")))))
(defun gnus-summary-expire-articles-now ()
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index 7155c7f9607..34953611966 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -388,57 +388,14 @@ TIME defaults to the current time."
(define-key keymap key (pop plist))
(pop plist)))))
-;; Two silly functions to ensure that all `y-or-n-p' questions clear
-;; the echo area.
-;;
-;; Do we really need these functions? Workarounds for bugs in the corresponding
-;; Emacs functions? Maybe these bugs are no longer present in any supported
-;; (X)Emacs version? Alias them to the original functions and see if anyone
-;; reports a problem. If not, replace with original functions. --rsteib,
-;; 2007-12-14
-;;
-;; All supported Emacsen clear the echo area after `yes-or-no-p', so we can
-;; remove `yes-or-no-p'. RMS says that not clearing after `y-or-n-p' is
-;; intentional (see below), so we could remove `gnus-y-or-n-p' too.
-;; Objections? --rsteib, 2008-02-16
-;;
-;; ,----[ http://thread.gmane.org/gmane.emacs.gnus.general/65099/focus=66070 ]
-;; | From: Richard Stallman
-;; | Subject: Re: Do we need gnus-yes-or-no-p and gnus-y-or-n-p?
-;; | To: Katsumi Yamaoka [...]
-;; | Cc: emacs-devel@[...], xemacs-beta@[...], ding@[...]
-;; | Date: Mon, 07 Jan 2008 12:16:05 -0500
-;; | Message-ID: <E1JBva1-000528-VY@fencepost.gnu.org>
-;; |
-;; | The behavior of `y-or-n-p' that it doesn't clear the question
-;; | and the answer is not serious of course, but I feel it is not
-;; | cool.
-;; |
-;; | It is intentional.
-;; |
-;; | Currently, it is commented out in the trunk by Reiner Steib. He
-;; | also wrote the benefit of leaving the question and the answer in
-;; | the echo area as follows:
-;; |
-;; | (http://article.gmane.org/gmane.emacs.gnus.general/66061)
-;; | > In contrast to yes-or-no-p it is much easier to type y, n,
-;; | > SPC, DEL, etc accidentally, so it might be useful for the user
-;; | > to see what he has typed.
-;; |
-;; | Yes, that is the reason.
-;; `----
-
-;; (defun gnus-y-or-n-p (prompt)
-;; (prog1
-;; (y-or-n-p prompt)
-;; (message "")))
-;; (defun gnus-yes-or-no-p (prompt)
-;; (prog1
-;; (yes-or-no-p prompt)
-;; (message "")))
-
-(defalias 'gnus-y-or-n-p 'y-or-n-p)
-(defalias 'gnus-yes-or-no-p 'yes-or-no-p)
+(defun gnus-y-or-n-p (prompt)
+ (prog1
+ (y-or-n-p prompt)
+ (message "")))
+(defun gnus-yes-or-no-p (prompt)
+ (prog1
+ (yes-or-no-p prompt)
+ (message "")))
;; By Frank Schmitt <ich@Frank-Schmitt.net>. Allows to have
;; age-depending date representations. (e.g. just the time if it's
@@ -1292,6 +1249,13 @@ This function saves the current buffer."
(with-current-buffer gnus-group-buffer
(eq major-mode 'gnus-group-mode))))
+(defun gnus-process-live-p (process)
+ "Returns non-nil if PROCESS is alive.
+A process is considered alive if its status is `run', `open',
+`listen', `connect' or `stop'."
+ (memq (process-status process)
+ '(run open listen connect stop)))
+
(defun gnus-remove-if (predicate sequence &optional hash-table-p)
"Return a copy of SEQUENCE with all items satisfying PREDICATE removed.
SEQUENCE should be a list, a vector, or a string. Returns always a list.
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index a157afe2ce6..52cef1925a2 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -4254,8 +4254,10 @@ conformance."
"Invisible text found and made visible; continue sending? ")
(error "Invisible text found and made visible")))))
(message-check 'illegible-text
- (let (char found choice)
+ (let (char found choice nul-chars)
(message-goto-body)
+ (setq nul-chars (save-excursion
+ (search-forward "\000" nil t)))
(while (progn
(skip-chars-forward mm-7bit-chars)
(when (get-text-property (point) 'no-illegible-text)
@@ -4281,7 +4283,9 @@ conformance."
(when found
(setq choice
(gnus-multiple-choice
- "Non-printable characters found. Continue sending?"
+ (if nul-chars
+ "NUL characters found, which may cause problems. Continue sending?"
+ "Non-printable characters found. Continue sending?")
`((?d "Remove non-printable characters and send")
(?r ,(format
"Replace non-printable characters with \"%s\" and send"
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index c940e06fbb6..2dbc465f8c9 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -216,9 +216,10 @@ textual parts.")
(let ((structure (ignore-errors
(read (current-buffer)))))
(while (and (consp structure)
- (not (stringp (car structure))))
+ (not (atom (car structure))))
(setq structure (car structure)))
(setq lines (if (and
+ (stringp (car structure))
(equal (upcase (nth 0 structure)) "MESSAGE")
(equal (upcase (nth 1 structure)) "RFC822"))
(nth 9 structure)
diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el
index 8906a036779..d83467a1ed5 100644
--- a/lisp/gnus/nnmail.el
+++ b/lisp/gnus/nnmail.el
@@ -554,7 +554,9 @@ parameter. It should return nil, `warn' or `delete'."
(const delete)))
(defcustom nnmail-extra-headers '(To Newsgroups)
- "*Extra headers to parse."
+ "Extra headers to parse.
+In addition to the standard headers, these extra headers will be
+included in NOV headers (and the like) when backends parse headers."
:version "21.1"
:group 'nnmail
:type '(repeat symbol))
@@ -1840,18 +1842,23 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
;; and fetch the mail from each.
(while (setq source (pop fetching-sources))
(when (setq new
- (mail-source-fetch
- source
- (gnus-byte-compile
- `(lambda (file orig-file)
- (nnmail-split-incoming
- file ',(intern (format "%s-save-mail" method))
- ',spool-func
- (or in-group
- (if (equal file orig-file)
- nil
- (nnmail-get-split-group orig-file ',source)))
- ',(intern (format "%s-active-number" method)))))))
+ (condition-case cond
+ (mail-source-fetch
+ source
+ (gnus-byte-compile
+ `(lambda (file orig-file)
+ (nnmail-split-incoming
+ file ',(intern (format "%s-save-mail" method))
+ ',spool-func
+ (or in-group
+ (if (equal file orig-file)
+ nil
+ (nnmail-get-split-group orig-file
+ ',source)))
+ ',(intern (format "%s-active-number" method))))))
+ ((error quit)
+ (message "Mail source %s failed: %s" source cond)
+ 0)))
(incf total new)
(incf i)))
;; If we did indeed read any incoming spools, we save all info.
diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el
index 986fd51a613..325aa67f80d 100644
--- a/lisp/gnus/nntp.el
+++ b/lisp/gnus/nntp.el
@@ -261,6 +261,8 @@ See `nnml-marks-is-evil' for more information.")
(const :format "" "password")
(string :format "Password: %v")))))))
+(make-obsolete 'nntp-authinfo-file nil "Emacs 24.1")
+
(defvoo nntp-connection-timeout nil
@@ -430,6 +432,9 @@ be restored and the command retried."
(defun nntp-kill-buffer (buffer)
(when (buffer-name buffer)
+ (let ((process (get-buffer-process buffer)))
+ (when process
+ (delete-process process)))
(kill-buffer buffer)
(nnheader-init-server-buffer)))
diff --git a/lisp/gnus/pop3.el b/lisp/gnus/pop3.el
index e29ddb0d44e..54c21703836 100644
--- a/lisp/gnus/pop3.el
+++ b/lisp/gnus/pop3.el
@@ -178,6 +178,8 @@ Use streaming commands."
(defun pop3-wait-for-messages (process count total-size)
(while (< (pop3-number-of-responses total-size) count)
+ (unless (memq (process-status process) '(open run))
+ (error "pop3 process died"))
(when total-size
(message "pop3 retrieved %dKB (%d%%)"
(truncate (/ (buffer-size) 1000))
diff --git a/lisp/gnus/starttls.el b/lisp/gnus/starttls.el
index c1caca90cf0..b995f7478ce 100644
--- a/lisp/gnus/starttls.el
+++ b/lisp/gnus/starttls.el
@@ -301,6 +301,10 @@ GNUTLS requires a port number."
starttls-gnutls-program
starttls-program)))
+(defalias 'starttls-any-program-available 'starttls-available-p)
+(make-obsolete 'starttls-any-program-available 'starttls-available-p
+ "2011-08-02")
+
(provide 'starttls)
;;; starttls.el ends here
diff --git a/lisp/help.el b/lisp/help.el
index e6496f625d1..710dc34ea89 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -1104,7 +1104,7 @@ This relies on `display-buffer-window' being correctly set up by
((eq help-value 'new-window)
"Type \\[delete-other-windows] to delete the help window")
((eq help-value 'reuse-other-window)
- "Type \\[switch-to-prev-buffer] RET to restore previous buffer"))
+ "Type \"q\" in other window to quit"))
help-window 'other))
(t
;; Not much to say here.
diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el
index 725192399ff..5a86508e144 100644
--- a/lisp/ibuffer.el
+++ b/lisp/ibuffer.el
@@ -356,12 +356,12 @@ directory, like `default-directory'."
:type 'hook
:group 'ibuffer)
-(defcustom ibuffer-marked-face 'font-lock-warning-face
+(defcustom ibuffer-marked-face 'warning
"Face used for displaying marked buffers."
:type 'face
:group 'ibuffer)
-(defcustom ibuffer-deletion-face 'font-lock-type-face
+(defcustom ibuffer-deletion-face 'error
"Face used for displaying buffers marked for deletion."
:type 'face
:group 'ibuffer)
diff --git a/lisp/international/charprop.el b/lisp/international/charprop.el
index 919666010b1..2424e87ae44 100644
--- a/lisp/international/charprop.el
+++ b/lisp/international/charprop.el
@@ -29,15 +29,18 @@ one of these symbols representing compatibility formatting tag:
;; FILE: uni-decimal.el
(define-char-code-property 'decimal-digit-value "uni-decimal.el"
"Unicode numeric value (decimal digit).
-Property value is an integer.")
+Property value is an integer 0..9, or nil.
+The value nil stands for NaN \"Numeric_Value\".")
;; FILE: uni-digit.el
(define-char-code-property 'digit-value "uni-digit.el"
"Unicode numeric value (digit).
-Property value is an integer.")
+Property value is an integer 0..9, or nil.
+The value nil stands for NaN \"Numeric_Value\".")
;; FILE: uni-numeric.el
(define-char-code-property 'numeric-value "uni-numeric.el"
"Unicode numeric value (numeric).
-Property value is an integer or a floating point.")
+Property value is an integer, a floating point, or nil.
+The value nil stands for NaN \"Numeric_Value\".")
;; FILE: uni-mirrored.el
(define-char-code-property 'mirrored "uni-mirrored.el"
"Unicode bidi mirrored flag.
@@ -53,20 +56,27 @@ Property value is a string.")
;; FILE: uni-uppercase.el
(define-char-code-property 'uppercase "uni-uppercase.el"
"Unicode simple uppercase mapping.
-Property value is a character.")
+Property value is a character or nil.
+The value nil means that the actual property value of a character
+is the character itself.")
;; FILE: uni-lowercase.el
(define-char-code-property 'lowercase "uni-lowercase.el"
"Unicode simple lowercase mapping.
-Property value is a character.")
+Property value is a character or nil.
+The value nil means that the actual property value of a character
+is the character itself.")
;; FILE: uni-titlecase.el
(define-char-code-property 'titlecase "uni-titlecase.el"
"Unicode simple titlecase mapping.
-Property value is a character.")
+Property value is a character or nil.
+The value nil means that the actual property value of a character
+is the character itself.")
;; FILE: uni-mirrored.el
(define-char-code-property 'mirroring "uni-mirrored.el"
"Unicode bidi-mirroring characters.
-Property value is a character that has the corresponding mirroring image,
-or nil for non-mirrored character.")
+Property value is a character that has the corresponding mirroring image or nil.
+The value nil means that the actual property value of a character
+is the character itself.")
;; Local Variables:
;; coding: utf-8
;; no-byte-compile: t
diff --git a/lisp/international/ucs-normalize.el b/lisp/international/ucs-normalize.el
index f83e0f7588f..df05b355b46 100644
--- a/lisp/international/ucs-normalize.el
+++ b/lisp/international/ucs-normalize.el
@@ -139,14 +139,17 @@
(defun nfd (char)
(let ((decomposition
(get-char-code-property char 'decomposition)))
- (if (and decomposition (numberp (car decomposition)))
+ (if (and decomposition (numberp (car decomposition))
+ (or (> (length decomposition) 1)
+ (/= (car decomposition) char)))
decomposition)))
(defun nfkd (char)
(let ((decomposition
(get-char-code-property char 'decomposition)))
(if (symbolp (car decomposition)) (cdr decomposition)
- decomposition)))
+ (if (or (> (length decomposition) 1)
+ (/= (car decomposition) char)) decomposition))))
(defun hfs-nfd (char)
(when (or (and (>= char 0) (< char #x2000))
@@ -180,6 +183,9 @@
(setq ccc (ucs-normalize-ccc char))
(setq decomposition (get-char-code-property
char 'decomposition))
+ (if (and (= (length decomposition) 1)
+ (= (car decomposition) char))
+ (setq decomposition nil))
(if (and ccc (/= 0 ccc)) (add-to-list 'combining-chars char))
(if (and (numberp (car decomposition))
(/= (ucs-normalize-ccc (car decomposition))
diff --git a/lisp/international/uni-bidi.el b/lisp/international/uni-bidi.el
index e7682c6d8ff..4d86fc821fa 100644
--- a/lisp/international/uni-bidi.el
+++ b/lisp/international/uni-bidi.el
Binary files differ
diff --git a/lisp/international/uni-category.el b/lisp/international/uni-category.el
index a4455decc52..94b7c18b6e2 100644
--- a/lisp/international/uni-category.el
+++ b/lisp/international/uni-category.el
Binary files differ
diff --git a/lisp/international/uni-combining.el b/lisp/international/uni-combining.el
index 227b9d0af79..1437ff9acbd 100644
--- a/lisp/international/uni-combining.el
+++ b/lisp/international/uni-combining.el
Binary files differ
diff --git a/lisp/international/uni-comment.el b/lisp/international/uni-comment.el
index c9743064bd4..21ccfe3ffe7 100644
--- a/lisp/international/uni-comment.el
+++ b/lisp/international/uni-comment.el
Binary files differ
diff --git a/lisp/international/uni-decimal.el b/lisp/international/uni-decimal.el
index 2c424ffb5de..096257add20 100644
--- a/lisp/international/uni-decimal.el
+++ b/lisp/international/uni-decimal.el
Binary files differ
diff --git a/lisp/international/uni-decomposition.el b/lisp/international/uni-decomposition.el
index b0bf07bbe85..b9660cdab0a 100644
--- a/lisp/international/uni-decomposition.el
+++ b/lisp/international/uni-decomposition.el
Binary files differ
diff --git a/lisp/international/uni-digit.el b/lisp/international/uni-digit.el
index fc52fd8c28c..efb78b0e43d 100644
--- a/lisp/international/uni-digit.el
+++ b/lisp/international/uni-digit.el
Binary files differ
diff --git a/lisp/international/uni-lowercase.el b/lisp/international/uni-lowercase.el
index 41890018204..7afd9503cb3 100644
--- a/lisp/international/uni-lowercase.el
+++ b/lisp/international/uni-lowercase.el
Binary files differ
diff --git a/lisp/international/uni-mirrored.el b/lisp/international/uni-mirrored.el
index 006cf575591..e650166c24c 100644
--- a/lisp/international/uni-mirrored.el
+++ b/lisp/international/uni-mirrored.el
Binary files differ
diff --git a/lisp/international/uni-name.el b/lisp/international/uni-name.el
index 7fac18b278d..8b681631067 100644
--- a/lisp/international/uni-name.el
+++ b/lisp/international/uni-name.el
Binary files differ
diff --git a/lisp/international/uni-numeric.el b/lisp/international/uni-numeric.el
index d16e8c00870..a1865f1fb23 100644
--- a/lisp/international/uni-numeric.el
+++ b/lisp/international/uni-numeric.el
Binary files differ
diff --git a/lisp/international/uni-old-name.el b/lisp/international/uni-old-name.el
index 4e704e5cdd0..de2d67b9450 100644
--- a/lisp/international/uni-old-name.el
+++ b/lisp/international/uni-old-name.el
Binary files differ
diff --git a/lisp/international/uni-titlecase.el b/lisp/international/uni-titlecase.el
index b8098c81876..517edb20445 100644
--- a/lisp/international/uni-titlecase.el
+++ b/lisp/international/uni-titlecase.el
Binary files differ
diff --git a/lisp/international/uni-uppercase.el b/lisp/international/uni-uppercase.el
index 899276eb725..fcb22d72470 100644
--- a/lisp/international/uni-uppercase.el
+++ b/lisp/international/uni-uppercase.el
Binary files differ
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 1942641fae9..7fcc31f188f 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -1191,19 +1191,17 @@ If first char entered is \\[isearch-yank-word-or-char], then do word search inst
isearch-word isearch-new-word))
;; Empty isearch-string means use default.
- (if (= 0 (length isearch-string))
- (setq isearch-string (or (car (if isearch-regexp
- regexp-search-ring
- search-ring))
- "")
-
- isearch-message
- (mapconcat 'isearch-text-char-description
- isearch-string ""))
- ;; This used to set the last search string,
- ;; but I think it is not right to do that here.
- ;; Only the string actually used should be saved.
- ))
+ (when (= 0 (length isearch-string))
+ (setq isearch-string (or (car (if isearch-regexp
+ regexp-search-ring
+ search-ring))
+ "")
+
+ isearch-message
+ (mapconcat 'isearch-text-char-description
+ isearch-string ""))
+ ;; After taking the last element, adjust ring to previous one.
+ (isearch-ring-adjust1 nil)))
;; This used to push the state as of before this C-s, but it adds
;; an inconsistent state where part of variables are from the
@@ -1290,7 +1288,9 @@ Use `isearch-exit' to quit without signaling."
isearch-message
(mapconcat 'isearch-text-char-description
isearch-string "")
- isearch-case-fold-search isearch-last-case-fold-search))
+ isearch-case-fold-search isearch-last-case-fold-search)
+ ;; After taking the last element, adjust ring to previous one.
+ (isearch-ring-adjust1 nil))
;; If already have what to search for, repeat it.
(or isearch-success
(progn
@@ -2071,7 +2071,7 @@ Isearch mode."
()
(set yank-pointer-name
(setq yank-pointer
- (mod (+ (or yank-pointer 0)
+ (mod (+ (or yank-pointer (if advance 0 -1))
(if advance -1 1))
length)))
(setq isearch-string (nth yank-pointer ring)
diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el
index 637d10135fa..40fbb072594 100644
--- a/lisp/mail/smtpmail.el
+++ b/lisp/mail/smtpmail.el
@@ -86,6 +86,11 @@ The default value would be \"smtp\" or 25."
:type '(choice (integer :tag "Port") (string :tag "Service"))
:group 'smtpmail)
+(defcustom smtpmail-smtp-user nil
+ "User name to use when looking up credentials."
+ :type '(choice (const nil) string)
+ :group 'smtpmail)
+
(defcustom smtpmail-local-domain nil
"Local domain name without a host name.
If the function `system-name' returns the full internet address,
@@ -490,6 +495,7 @@ The list is in preference order.")
(auth-source-search
:host host
:port port
+ :user smtpmail-smtp-user
:max 1
:require (and ask-for-password
'(:user :secret))
@@ -499,6 +505,8 @@ The list is in preference order.")
(save-function (and ask-for-password
(plist-get auth-info :save-function)))
ret)
+ (when (functionp password)
+ (setq password (funcall password)))
(when (and user
(not password))
;; The user has stored the user name, but not the password, so
@@ -510,6 +518,7 @@ The list is in preference order.")
:max 1
:host host
:port port
+ :user smtpmail-smtp-user
:require '(:user :secret)
:create t))
password (plist-get auth-info :secret)))
@@ -593,8 +602,10 @@ The list is in preference order.")
(push smtpmail-smtp-server ports))
(while (and (not smtpmail-smtp-server)
(setq port (pop ports)))
- (when (setq stream (ignore-errors
- (open-network-stream "smtp" nil server port)))
+ (when (setq stream (condition-case ()
+ (open-network-stream "smtp" nil server port)
+ (quit nil)
+ (error nil)))
(customize-save-variable 'smtpmail-smtp-server server)
(customize-save-variable 'smtpmail-smtp-service port)
(delete-process stream)))
@@ -615,8 +626,6 @@ The list is in preference order.")
(and mail-specify-envelope-from
(mail-envelope-from))
user-mail-address))
- (coding-system-for-read 'binary)
- (coding-system-for-write 'binary)
response-code
process-buffer
result
@@ -635,21 +644,23 @@ The list is in preference order.")
(erase-buffer))
;; open the connection to the server
- (setq result
- (open-network-stream
- "smtpmail" process-buffer host port
- :type smtpmail-stream-type
- :return-list t
- :capability-command (format "EHLO %s\r\n" (smtpmail-fqdn))
- :end-of-command "^[0-9]+ .*\r\n"
- :success "^2.*\n"
- :always-query-capabilities t
- :starttls-function
- (lambda (capabilities)
- (and (string-match "-STARTTLS" capabilities)
- "STARTTLS\r\n"))
- :client-certificate t
- :use-starttls-if-possible t))
+ (let ((coding-system-for-read 'binary)
+ (coding-system-for-write 'binary))
+ (setq result
+ (open-network-stream
+ "smtpmail" process-buffer host port
+ :type smtpmail-stream-type
+ :return-list t
+ :capability-command (format "EHLO %s\r\n" (smtpmail-fqdn))
+ :end-of-command "^[0-9]+ .*\r\n"
+ :success "^2.*\n"
+ :always-query-capabilities t
+ :starttls-function
+ (lambda (capabilities)
+ (and (string-match "-STARTTLS" capabilities)
+ "STARTTLS\r\n"))
+ :client-certificate t
+ :use-starttls-if-possible t)))
;; If we couldn't access the server at all, we give up.
(unless (setq process (car result))
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index b82147b97f1..313298de97e 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1119,27 +1119,13 @@ It also eliminates runs of equal strings."
`(display (space :align-to ,column)))
nil))))
(if (not (consp str))
- (put-text-property (point)
- (progn
- (insert (bidi-string-mark-left-to-right
- str))
- (point))
+ (put-text-property (point) (progn (insert str) (point))
'mouse-face 'highlight)
- (put-text-property (point)
- (progn
- (insert
- (bidi-string-mark-left-to-right
- (car str)))
- (point))
+ (put-text-property (point) (progn (insert (car str)) (point))
'mouse-face 'highlight)
- (add-text-properties (point)
- (progn
- (insert
- (bidi-string-mark-left-to-right
- (cadr str)))
- (point))
+ (add-text-properties (point) (progn (insert (cadr str)) (point))
'(mouse-face nil
- face completions-annotations)))
+ face completions-annotations)))
(cond
((eq completions-format 'vertical)
;; Vertical format
diff --git a/lisp/mpc.el b/lisp/mpc.el
index 5319ea43898..932fb5926fd 100644
--- a/lisp/mpc.el
+++ b/lisp/mpc.el
@@ -246,11 +246,12 @@ and HOST defaults to localhost."
(process-put proc 'ready t)
(unless (eq (match-end 0) (point-max))
(error "Unexpected trailing text"))
- (let ((error (match-string 1)))
+ (let ((error-text (match-string 1)))
(delete-region (point) (point-max))
(let ((callback (process-get proc 'callback)))
(process-put proc 'callback nil)
- (if error (signal 'mpc-proc-error error))
+ (if error-text
+ (process-put proc 'mpc-proc-error error-text))
(funcall callback)))))))))
(defun mpc--proc-connect (host)
@@ -314,19 +315,23 @@ and HOST defaults to localhost."
mpc-proc)
(setq mpc-proc (mpc--proc-connect mpc-host))))
+(defun mpc-proc-check (proc)
+ (let ((error-text (process-get proc 'mpc-proc-error)))
+ (when error-text
+ (process-put proc 'mpc-proc-error nil)
+ (signal 'mpc-proc-error error-text))))
+
(defun mpc-proc-sync (&optional proc)
"Wait for MPC process until it is idle again.
Return the buffer in which the process is/was running."
(unless proc (setq proc (mpc-proc)))
(unwind-protect
- (condition-case err
- (progn
- (while (and (not (process-get proc 'ready))
- (accept-process-output proc)))
- (if (process-get proc 'ready) (process-buffer proc)
- ;; (delete-process proc)
- (error "No response from MPD")))
- (error (message "MPC: %s" err) (signal (car err) (cdr err))))
+ (progn
+ (while (and (not (process-get proc 'ready))
+ (accept-process-output proc)))
+ (mpc-proc-check proc)
+ (if (process-get proc 'ready) (process-buffer proc)
+ (error "No response from MPD")))
(unless (process-get proc 'ready)
;; (debug)
(message "Killing hung process")
@@ -358,13 +363,13 @@ which will be concatenated with proper quoting before passing them to MPD."
"\n")))
(if callback
;; (let ((buf (current-buffer)))
- (process-put proc 'callback
- callback
- ;; (lambda ()
- ;; (funcall callback
- ;; (prog1 (current-buffer)
- ;; (set-buffer buf)))))
- )
+ (process-put proc 'callback
+ callback
+ ;; (lambda ()
+ ;; (funcall callback
+ ;; (prog1 (current-buffer)
+ ;; (set-buffer buf)))))
+ )
;; If `callback' is nil, we're executing synchronously.
(process-put proc 'callback 'ignore)
;; This returns the process's buffer.
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index e18b42a275f..f9bc13e1e25 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -1103,26 +1103,32 @@ URL in a new window."
(interactive (browse-url-interactive-arg "URL: "))
(setq url (browse-url-encode-url url))
(let* ((process-environment (browse-url-process-environment))
+ (use-remote
+ (not (memq system-type '(windows-nt ms-dos))))
(process
(apply 'start-process
(concat "firefox " url) nil
browse-url-firefox-program
(append
browse-url-firefox-arguments
- (if (memq system-type '(windows-nt ms-dos))
- (list url)
- (list "-remote"
- (concat "openURL("
- url
- (if (browse-url-maybe-new-window
- new-window)
- (if browse-url-firefox-new-window-is-tab
- ",new-tab"
- ",new-window"))
- ")")))))))
- (set-process-sentinel process
- `(lambda (process change)
- (browse-url-firefox-sentinel process ,url)))))
+ (if use-remote
+ (list "-remote"
+ (concat
+ "openURL("
+ url
+ (if (browse-url-maybe-new-window new-window)
+ (if browse-url-firefox-new-window-is-tab
+ ",new-tab"
+ ",new-window"))
+ ")"))
+ (list url))))))
+ ;; If we use -remote, the process exits with status code 2 if
+ ;; Firefox is not already running. The sentinel runs firefox
+ ;; directly if that happens.
+ (when use-remote
+ (set-process-sentinel process
+ `(lambda (process change)
+ (browse-url-firefox-sentinel process ,url))))))
(defun browse-url-firefox-sentinel (process url)
"Handle a change to the process communicating with Firefox."
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
index 46a82e3720d..bdf2dadd16c 100644
--- a/lisp/pcomplete.el
+++ b/lisp/pcomplete.el
@@ -811,15 +811,19 @@ this is `comint-dynamic-complete-functions'."
(while (< (point) end)
(skip-chars-forward " \t\n")
(push (point) begins)
- (let ((skip t))
- (while skip
- (skip-chars-forward "^ \t\n")
- (if (eq (char-before) ?\\)
- (skip-chars-forward " \t\n")
- (setq skip nil))))
+ (while
+ (progn
+ (skip-chars-forward "^ \t\n\\")
+ (when (eq (char-after) ?\\)
+ (forward-char 1)
+ (unless (eolp)
+ (forward-char 1)
+ t))))
(push (buffer-substring-no-properties (car begins) (point))
args))
(cons (nreverse args) (nreverse begins)))))
+(make-obsolete 'pcomplete-parse-comint-arguments
+ 'comint-parse-pcomplete-arguments "24.1")
(defun pcomplete-parse-arguments (&optional expand-p)
"Parse the command line arguments. Most completions need this info."
@@ -879,7 +883,7 @@ Magic characters are those in `pcomplete-arg-quote-list'."
(or (run-hook-with-args-until-success
'pcomplete-quote-arg-hook filename index)
(when (memq c pcomplete-arg-quote-list)
- (string "\\" c))
+ (string ?\\ c))
(char-to-string c))
(setq index (1+ index))))
filename
diff --git a/lisp/proced.el b/lisp/proced.el
index 94ea579ebd8..e4987bd926c 100644
--- a/lisp/proced.el
+++ b/lisp/proced.el
@@ -395,7 +395,7 @@ It is a list of lists (KEY PREDICATE REVERSE).")
:group 'proced-faces)
(defface proced-marked
- '((t (:inherit font-lock-warning-face)))
+ '((t (:inherit error)))
"Face used for marked processes."
:group 'proced-faces)
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index 0d88f85d263..a1cbdc16560 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -6325,7 +6325,9 @@ comment at the start of cc-engine.el for more info."
(let* ((start (point)) kwd-sym kwd-clause-end found-type)
;; Look for a specifier keyword clause.
- (when (looking-at c-prefix-spec-kwds-re)
+ (when (or (looking-at c-prefix-spec-kwds-re)
+ (and (c-major-mode-is 'java-mode)
+ (looking-at "@[A-Za-z0-9]+")))
(if (looking-at c-typedef-key)
(setq at-typedef t))
(setq kwd-sym (c-keyword-sym (match-string 1)))
diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el
index 2277ba760ab..3d5dc30d823 100644
--- a/lisp/progmodes/cc-fonts.el
+++ b/lisp/progmodes/cc-fonts.el
@@ -199,10 +199,16 @@
(set-face-foreground 'c-annotation-face "blue")
(eval-and-compile
- ;; We need the following functions during compilation since they're
- ;; called when the `c-lang-defconst' initializers are evaluated.
- ;; Define them at runtime too for the sake of derived modes.
-
+ ;; We need the following definitions during compilation since they're
+ ;; used when the `c-lang-defconst' initializers are evaluated. Define
+ ;; them at runtime too for the sake of derived modes.
+
+ ;; This indicates the "font locking context", and is set just before
+ ;; fontification is done. If non-nil, it says, e.g., point starts
+ ;; from within a #if preprocessor construct.
+ (defvar c-font-lock-context nil)
+ (make-variable-buffer-local 'c-font-lock-context)
+
(defmacro c-put-font-lock-face (from to face)
;; Put a face on a region (overriding any existing face) in the way
;; font-lock would do it. In XEmacs that means putting an
@@ -283,6 +289,45 @@
nil)))))
res))))
+ (defun c-make-font-lock-search-form (regexp highlights)
+ ;; Return a lisp form which will fontify every occurence of REGEXP
+ ;; (a regular expression, NOT a function) between POINT and `limit'
+ ;; with HIGHLIGHTS, a list of highlighters as specified on page
+ ;; "Search-based Fontification" in the elisp manual.
+ `(while (re-search-forward ,regexp limit t)
+ (unless (progn
+ (goto-char (match-beginning 0))
+ (c-skip-comments-and-strings limit))
+ (goto-char (match-end 0))
+ ,@(mapcar
+ (lambda (highlight)
+ (if (integerp (car highlight))
+ ;; e.g. highlight is (1 font-lock-type-face t)
+ (progn
+ (unless (eq (nth 2 highlight) t)
+ (error
+ "The override flag must currently be t in %s"
+ highlight))
+ (when (nth 3 highlight)
+ (error
+ "The laxmatch flag may currently not be set in %s"
+ highlight))
+ `(save-match-data
+ (c-put-font-lock-face
+ (match-beginning ,(car highlight))
+ (match-end ,(car highlight))
+ ,(elt highlight 1))))
+ ;; highlight is an "ANCHORED HIGHLIGHER" of the form
+ ;; (ANCHORED-MATCHER PRE-FORM POST-FORM SUBEXP-HIGHLIGHTERS...)
+ (when (nth 3 highlight)
+ (error "Match highlights currently not supported in %s"
+ highlight))
+ `(progn
+ ,(nth 1 highlight)
+ (save-match-data ,(car highlight))
+ ,(nth 2 highlight))))
+ highlights))))
+
(defun c-make-font-lock-search-function (regexp &rest highlights)
;; This function makes a byte compiled function that works much like
;; a matcher element in `font-lock-keywords'. It cuts out a little
@@ -313,43 +358,101 @@
;; lambda more easily.
(byte-compile
`(lambda (limit)
- (let (;; The font-lock package in Emacs is known to clobber
+ (let ( ;; The font-lock package in Emacs is known to clobber
;; `parse-sexp-lookup-properties' (when it exists).
(parse-sexp-lookup-properties
(cc-eval-when-compile
(boundp 'parse-sexp-lookup-properties))))
- (while (re-search-forward ,regexp limit t)
- (unless (progn
- (goto-char (match-beginning 0))
- (c-skip-comments-and-strings limit))
- (goto-char (match-end 0))
- ,@(mapcar
- (lambda (highlight)
- (if (integerp (car highlight))
- (progn
- (unless (eq (nth 2 highlight) t)
- (error
- "The override flag must currently be t in %s"
- highlight))
- (when (nth 3 highlight)
- (error
- "The laxmatch flag may currently not be set in %s"
- highlight))
- `(save-match-data
- (c-put-font-lock-face
- (match-beginning ,(car highlight))
- (match-end ,(car highlight))
- ,(elt highlight 1))))
- (when (nth 3 highlight)
- (error "Match highlights currently not supported in %s"
- highlight))
- `(progn
- ,(nth 1 highlight)
- (save-match-data ,(car highlight))
- ,(nth 2 highlight))))
- highlights))))
+
+ ;; (while (re-search-forward ,regexp limit t)
+ ;; (unless (progn
+ ;; (goto-char (match-beginning 0))
+ ;; (c-skip-comments-and-strings limit))
+ ;; (goto-char (match-end 0))
+ ;; ,@(mapcar
+ ;; (lambda (highlight)
+ ;; (if (integerp (car highlight))
+ ;; (progn
+ ;; (unless (eq (nth 2 highlight) t)
+ ;; (error
+ ;; "The override flag must currently be t in %s"
+ ;; highlight))
+ ;; (when (nth 3 highlight)
+ ;; (error
+ ;; "The laxmatch flag may currently not be set in %s"
+ ;; highlight))
+ ;; `(save-match-data
+ ;; (c-put-font-lock-face
+ ;; (match-beginning ,(car highlight))
+ ;; (match-end ,(car highlight))
+ ;; ,(elt highlight 1))))
+ ;; (when (nth 3 highlight)
+ ;; (error "Match highlights currently not supported in %s"
+ ;; highlight))
+ ;; `(progn
+ ;; ,(nth 1 highlight)
+ ;; (save-match-data ,(car highlight))
+ ;; ,(nth 2 highlight))))
+ ;; highlights)))
+ ,(c-make-font-lock-search-form regexp highlights))
+
nil)))
+ (defun c-make-font-lock-context-search-function (normal &rest state-stanzas)
+ ;; This function makes a byte compiled function that works much like
+ ;; a matcher element in `font-lock-keywords', with the following
+ ;; enhancement: the generated function will test for particular "font
+ ;; lock contexts" at the start of the region, i.e. is this point in
+ ;; the middle of some particular construct? if so the generated
+ ;; function will first fontify the tail of the construct, before
+ ;; going into the main loop and fontify full constructs up to limit.
+ ;;
+ ;; The generated function takes one parameter called `limit', and
+ ;; will fontify the region between POINT and LIMIT.
+ ;;
+ ;; NORMAL is a list of the form (REGEXP HIGHLIGHTS .....), and is
+ ;; used to fontify the "regular" bit of the region.
+ ;; STATE-STANZAS is list of elements of the form (STATE LIM REGEXP
+ ;; HIGHLIGHTS), each element coding one possible font lock context.
+
+ ;; o - REGEXP is a font-lock regular expression (NOT a function),
+ ;; o - HIGHLIGHTS is a list of zero or more highlighters as defined
+ ;; on page "Search-based Fontification" in the elisp manual. As
+ ;; yet (2009-06), they must have OVERRIDE set, and may not have
+ ;; LAXMATCH set.
+ ;;
+ ;; o - STATE is the "font lock context" (e.g. in-cpp-expr) and is
+ ;; not quoted.
+ ;; o - LIM is a lisp form whose evaluation will yield the limit
+ ;; position in the buffer for fontification by this stanza.
+ ;;
+ ;; This function does not do any hidden buffer changes, but the
+ ;; generated functions will. (They are however used in places
+ ;; covered by the font-lock context.)
+ ;;
+ ;; Note: Replace `byte-compile' with `eval' to debug the generated
+ ;; lambda more easily.
+ (byte-compile
+ `(lambda (limit)
+ (let ( ;; The font-lock package in Emacs is known to clobber
+ ;; `parse-sexp-lookup-properties' (when it exists).
+ (parse-sexp-lookup-properties
+ (cc-eval-when-compile
+ (boundp 'parse-sexp-lookup-properties))))
+ ,@(mapcar
+ (lambda (stanza)
+ (let ((state (car stanza))
+ (lim (nth 1 stanza))
+ (regexp (nth 2 stanza))
+ (highlights (cdr (cddr stanza))))
+ `(if (eq c-font-lock-context ',state)
+ (let ((limit ,lim))
+ ,(c-make-font-lock-search-form
+ regexp highlights)))))
+ state-stanzas)
+ ,(c-make-font-lock-search-form (car normal) (cdr normal))
+ nil))))
+
; (eval-after-load "edebug" ; 2006-07-09: def-edebug-spec is now in subr.el.
; '(progn
(def-edebug-spec c-fontify-types-and-refs let*)
@@ -494,19 +597,24 @@ stuff. Used on level 1 and higher."
(c-lang-const c-cpp-expr-directives)))
(cef-re (c-make-keywords-re t
(c-lang-const c-cpp-expr-functions))))
- `((,(c-make-font-lock-search-function
- (concat noncontinued-line-end
- (c-lang-const c-opt-cpp-prefix)
- ced-re ; 1 + ncle-depth
- ;; Match the whole logical line to look
- ;; for the functions in.
- "\\(\\\\\\(.\\|[\n\r]\\)\\|[^\n\r]\\)*")
- `((let ((limit (match-end 0)))
- (while (re-search-forward ,cef-re limit 'move)
- (c-put-font-lock-face (match-beginning 1)
- (match-end 1)
- c-preprocessor-face-name)))
- (goto-char (match-end ,(1+ ncle-depth)))))))))
+
+ `((,(c-make-font-lock-context-search-function
+ `(,(concat noncontinued-line-end
+ (c-lang-const c-opt-cpp-prefix)
+ ced-re ; 1 + ncle-depth
+ ;; Match the whole logical line to look
+ ;; for the functions in.
+ "\\(\\\\\\(.\\|[\n\r]\\)\\|[^\n\r]\\)*")
+ ((let ((limit (match-end 0)))
+ (while (re-search-forward ,cef-re limit 'move)
+ (c-put-font-lock-face (match-beginning 1)
+ (match-end 1)
+ c-preprocessor-face-name)))
+ (goto-char (match-end ,(1+ ncle-depth)))))
+ `(in-cpp-expr
+ (save-excursion (c-end-of-macro) (point))
+ ,cef-re
+ (1 c-preprocessor-face-name t)))))))
;; Fontify the directive names.
(,(c-make-font-lock-search-function
@@ -759,6 +867,12 @@ casts and declarations are fontified. Used on level 2 and higher."
(c-forward-syntactic-ws limit)
(c-font-lock-declarators limit t (eq prop 'c-decl-type-start))))
+ (setq c-font-lock-context ;; (c-guess-font-lock-context)
+ (save-excursion
+ (if (and c-cpp-expr-intro-re
+ (c-beginning-of-macro)
+ (looking-at c-cpp-expr-intro-re))
+ 'in-cpp-expr)))
nil)
(defun c-font-lock-<>-arglists (limit)
@@ -1552,7 +1666,9 @@ on level 2 only and so aren't combined with `c-complex-decl-matchers'."
(unless (c-skip-comments-and-strings limit)
(c-forward-syntactic-ws)
;; Handle prefix declaration specifiers.
- (when (looking-at c-prefix-spec-kwds-re)
+ (when (or (looking-at c-prefix-spec-kwds-re)
+ (and (c-major-mode-is 'java-mode)
+ (looking-at "@[A-Za-z0-9]+")))
(c-forward-keyword-clause 1))
,(if (c-major-mode-is 'c++-mode)
`(when (and (c-forward-type)
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index 35097242cb7..279c5e46c46 100644
--- a/lisp/progmodes/cc-langs.el
+++ b/lisp/progmodes/cc-langs.el
@@ -815,6 +815,16 @@ expression."
t (if (c-lang-const c-opt-cpp-prefix)
'("if" "elif")))
+(c-lang-defconst c-cpp-expr-intro-re
+ "Regexp which matches the start of a CPP directive which contains an
+expression, or nil if there aren't any in the language."
+ t (if (c-lang-const c-cpp-expr-directives)
+ (concat
+ (c-lang-const c-opt-cpp-prefix)
+ (c-make-keywords-re t (c-lang-const c-cpp-expr-directives)))))
+(c-lang-defvar c-cpp-expr-intro-re
+ (c-lang-const c-cpp-expr-intro-re))
+
(c-lang-defconst c-cpp-expr-functions
"List of functions in cpp expressions."
t (if (c-lang-const c-opt-cpp-prefix)
@@ -1813,7 +1823,7 @@ will be handled."
"bindsTo" "delegatesTo" "implements" "proxy" "storedOn")
;; Note: "const" is not used in Java, but it's still a reserved keyword.
java '("abstract" "const" "final" "native" "private" "protected" "public"
- "static" "strictfp" "synchronized" "transient" "volatile" "@[A-Za-z0-9]+")
+ "static" "strictfp" "synchronized" "transient" "volatile")
pike '("final" "inline" "local" "nomask" "optional" "private" "protected"
"public" "static" "variant"))
@@ -1899,10 +1909,7 @@ one of `c-type-list-kwds', `c-ref-list-kwds',
(c-lang-defconst c-prefix-spec-kwds-re
;; Adorned regexp of `c-prefix-spec-kwds'.
- t (c-make-keywords-re t (c-lang-const c-prefix-spec-kwds))
- java (replace-regexp-in-string
- "\\\\\\[" "["
- (replace-regexp-in-string "\\\\\\+" "+" (c-make-keywords-re t (c-lang-const c-prefix-spec-kwds)))))
+ t (c-make-keywords-re t (c-lang-const c-prefix-spec-kwds)))
(c-lang-defvar c-prefix-spec-kwds-re (c-lang-const c-prefix-spec-kwds-re))
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index f3b873c8b1e..79fec080d57 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -145,7 +145,7 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
(ant
"^[ \t]*\\[[^] \n]+\\][ \t]*\\([^: \n]+\\):\\([0-9]+\\):\\(?:\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\):\\)?\
-\\( warning\\)?" 1 (2 . 4) (3 . 5) (4))
+\\( warning\\)?" 1 (2 . 4) (3 . 5) (6))
(bash
"^\\([^: \n\t]+\\): line \\([0-9]+\\):" 1 2)
@@ -523,7 +523,7 @@ you may also want to change `compilation-page-delimiter'.")
;; Command output lines. Recognize `make[n]:' lines too.
("^\\([[:alnum:]_/.+-]+\\)\\(\\[\\([0-9]+\\)\\]\\)?[ \t]*:"
(1 font-lock-function-name-face) (3 compilation-line-face nil t))
- (" -\\(?:o[= ]?\\|-\\(?:outfile\\|output\\)[= ]\\)\\(\\S +\\)" . 1)
+ (" --?o\\(?:utfile\\|utput\\)?[= ]\\(\\S +\\)" . 1)
("^Compilation \\(finished\\).*"
(0 '(face nil compilation-message nil help-echo nil mouse-face nil) t)
(1 compilation-info-face))
@@ -985,12 +985,15 @@ POS and RES.")
(let* ((prev
(or (get-text-property (1- prev-pos) 'compilation-message)
(get-text-property prev-pos 'compilation-message)))
- (prev-struct
- (car (nth 2 (car prev)))))
+ (prev-file-struct
+ (and prev
+ (compilation--loc->file-struct
+ (compilation--message->loc prev)))))
+
;; Construct FILE . DIR from that.
- (if prev-struct
- (setq file (cons (car prev-struct)
- (cadr prev-struct))))))
+ (if prev-file-struct
+ (setq file (cons (caar prev-file-struct)
+ (cadr (car prev-file-struct)))))))
(unless file
(setq file '("*unknown*")))))
;; All of these fields are optional, get them only if we have an index, and
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el
index 31100f3fac2..709f01444bf 100644
--- a/lisp/progmodes/grep.el
+++ b/lisp/progmodes/grep.el
@@ -463,9 +463,12 @@ Set up `compilation-exit-message-function' and run `grep-setup-hook'."
(set (make-local-variable 'compilation-exit-message-function)
(lambda (status code msg)
(if (eq status 'exit)
- (cond ((zerop code)
+ ;; This relies on the fact that `compilation-start'
+ ;; sets buffer-modified to nil before running the command,
+ ;; so the buffer is still unmodified if there is no output.
+ (cond ((and (zerop code) (buffer-modified-p))
'("finished (matches found)\n" . "matched"))
- ((= code 1)
+ ((or (= code 1) (not (buffer-modified-p)))
'("finished with no matches found\n" . "no match"))
(t
(cons msg code)))
diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el
index 4151e2bb79a..470b309434c 100644
--- a/lisp/progmodes/scheme.el
+++ b/lisp/progmodes/scheme.el
@@ -55,24 +55,24 @@
(defvar scheme-mode-syntax-table
(let ((st (make-syntax-table))
(i 0))
-
- ;; Default is atom-constituent.
- (while (< i 256)
+ ;; Symbol constituents
+ ;; We used to treat chars 128-256 as symbol-constituent, but they
+ ;; should be valid word constituents (Bug#8843). Note that valid
+ ;; identifier characters are Scheme-implementation dependent.
+ (while (< i ?0)
(modify-syntax-entry i "_ " st)
(setq i (1+ i)))
-
- ;; Word components.
- (setq i ?0)
- (while (<= i ?9)
- (modify-syntax-entry i "w " st)
+ (setq i (1+ ?9))
+ (while (< i ?A)
+ (modify-syntax-entry i "_ " st)
(setq i (1+ i)))
- (setq i ?A)
- (while (<= i ?Z)
- (modify-syntax-entry i "w " st)
+ (setq i (1+ ?Z))
+ (while (< i ?a)
+ (modify-syntax-entry i "_ " st)
(setq i (1+ i)))
- (setq i ?a)
- (while (<= i ?z)
- (modify-syntax-entry i "w " st)
+ (setq i (1+ ?z))
+ (while (< i 128)
+ (modify-syntax-entry i "_ " st)
(setq i (1+ i)))
;; Whitespace
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index 31a4fbaef4d..7b949134c6c 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -460,6 +460,7 @@ This is buffer-local in every such buffer.")
(define-key map "\C-c+" 'sh-add)
(define-key map "\C-\M-x" 'sh-execute-region)
(define-key map "\C-c\C-x" 'executable-interpret)
+ ;; FIXME: Use post-self-insert-hook.
(define-key map "<" 'sh-maybe-here-document)
(define-key map "(" 'skeleton-pair-insert-maybe)
(define-key map "{" 'skeleton-pair-insert-maybe)
@@ -3659,6 +3660,7 @@ The document is bounded by `sh-here-document-word'."
(save-excursion
(backward-char 2)
(sh-quoted-p))
+ (nth 8 (syntax-ppss))
(let ((tabs (if (string-match "\\`-" sh-here-document-word)
(make-string (/ (current-indentation) tab-width) ?\t)
""))
diff --git a/lisp/shell.el b/lisp/shell.el
index de811543ba0..01d1a688f0e 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -383,6 +383,21 @@ to `dirtrack-mode'."
:group 'shell
:type '(choice (const nil) regexp))
+(defun shell-parse-pcomplete-arguments ()
+ "Parse whitespace separated arguments in the current region."
+ (let ((begin (save-excursion (shell-backward-command 1) (point)))
+ (end (point))
+ begins args)
+ (save-excursion
+ (goto-char begin)
+ (while (< (point) end)
+ (skip-chars-forward " \t\n")
+ (push (point) begins)
+ (looking-at "\\(?:[^\s\t\n\\]\\|'[^']*'\\|\"\\(?:[^\"\\]\\|\\\\.\\)*\"\\|\\\\.\\)*\\(?:\\\\\\|'[^']*\\|\"\\(?:[^\"\\]\\|\\\\.\\)*\\)?")
+ (goto-char (match-end 0))
+ (push (buffer-substring-no-properties (car begins) (point))
+ args))
+ (cons (nreverse args) (nreverse begins)))))
(defun shell-completion-vars ()
"Setup completion vars for `shell-mode' and `read-shell-command'."
@@ -396,8 +411,9 @@ to `dirtrack-mode'."
(set (make-local-variable 'comint-dynamic-complete-functions)
shell-dynamic-complete-functions)
(set (make-local-variable 'pcomplete-parse-arguments-function)
- ;; FIXME: This function should be moved to shell.el.
- #'pcomplete-parse-comint-arguments)
+ #'shell-parse-pcomplete-arguments)
+ (set (make-local-variable 'pcomplete-arg-quote-list)
+ (append "\\ \t\n\r\"'`$|&;(){}[]<>#" nil))
(set (make-local-variable 'pcomplete-termination-string)
(cond ((not comint-completion-addsuffix) "")
((stringp comint-completion-addsuffix)
diff --git a/lisp/startup.el b/lisp/startup.el
index 0dee969fb5a..6c3bb397e9a 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -409,7 +409,7 @@ The regexp should not contain a starting \"\\`\" or a trailing
\"\\'\"; those are added automatically by callers.")
(defun normal-top-level-add-subdirs-to-load-path ()
- "Add all subdirectories of current directory to `load-path'.
+ "Add all subdirectories of `default-directory' to `load-path'.
More precisely, this uses only the subdirectories whose names
start with letters or digits; it excludes any subdirectory named `RCS'
or `CVS', and any subdirectory that contains a file named `.nosearch'."
diff --git a/lisp/term.el b/lisp/term.el
index 6d7f6f5c535..361ff685396 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -1227,9 +1227,9 @@ without any interpretation."
(make-string 1 char)
(format "\e%c" char)))))
-(defun term-mouse-paste (click arg)
- "Insert the last stretch of killed text at the position clicked on."
- (interactive "e\nP")
+(defun term-mouse-paste (click)
+ "Insert the primary selection at the position clicked on."
+ (interactive "e")
(if (featurep 'xemacs)
(term-send-raw-string
(or (condition-case () (x-get-selection) (error ()))
@@ -1238,10 +1238,17 @@ without any interpretation."
(run-hooks 'mouse-leave-buffer-hook)
(setq this-command 'yank)
(mouse-set-point click)
- (term-send-raw-string (current-kill (cond
- ((listp arg) 0)
- ((eq arg '-) -1)
- (t (1- arg)))))))
+ (term-send-raw-string
+ (or (cond ; From `mouse-yank-primary':
+ ((eq system-type 'windows-nt)
+ (or (x-get-selection 'PRIMARY)
+ (x-get-selection-value)))
+ ((fboundp 'x-get-selection-value)
+ (or (x-get-selection-value)
+ (x-get-selection 'PRIMARY)))
+ (t
+ (x-get-selection 'PRIMARY)))
+ (error "No selection is available")))))
(defun term-paste ()
"Insert the last stretch of killed text at point."
diff --git a/lisp/tutorial.el b/lisp/tutorial.el
index 77ef50843d3..c57ec33d2e2 100644
--- a/lisp/tutorial.el
+++ b/lisp/tutorial.el
@@ -253,7 +253,7 @@ LEFT and RIGHT are the elements to compare."
;; * INSERTING AND DELETING
;; C-u 8 * to insert ********.
(delete-backward-char "\d")
- (delete-forward-char [?\C-d])
+ (delete-char [?\C-d])
(backward-kill-word [?\M-\d])
(kill-word [?\M-d])
(kill-line [?\C-k])
@@ -298,7 +298,7 @@ LEFT and RIGHT are the elements to compare."
(isearch-backward [?\C-r])
;; * MULTIPLE WINDOWS
- (split-window-vertically [?\C-x ?2])
+ (split-window-above-each-other [?\C-x ?2])
(scroll-other-window [?\C-\M-v])
(other-window [?\C-x ?o])
(find-file-other-window [?\C-x ?4 ?\C-f])
@@ -889,6 +889,11 @@ Run the Viper tutorial? "))
(search-forward ">>")
(replace-match "]")))
(beginning-of-line)
+ ;; FIXME: if the window is not tall, and especially if the
+ ;; big red "NOTICE: The main purpose..." text has been
+ ;; inserted at the start of the buffer, the "type C-v to
+ ;; move to the next screen" might not be visible on the
+ ;; first screen (n < 0). How will the novice know what to do?
(let ((n (- (window-height (selected-window))
(count-lines (point-min) (point))
6)))
@@ -897,7 +902,7 @@ Run the Viper tutorial? "))
;; For a short gap, we don't need the [...] line,
;; so delete it.
(delete-region (point) (progn (end-of-line) (point)))
- (newline n))
+ (if (> n 0) (newline n)))
;; Some people get confused by the large gap.
(newline (/ n 2))
diff --git a/lisp/view.el b/lisp/view.el
index 21479a70a72..be011d217fc 100644
--- a/lisp/view.el
+++ b/lisp/view.el
@@ -576,9 +576,9 @@ current buffer. "
(cond
((or all-windows view-exits-all-viewing-windows)
(dolist (window (get-buffer-window-list))
- (quit-restore-window window)))
+ (quit-window nil window)))
((eq (window-buffer) (current-buffer))
- (quit-restore-window)))
+ (quit-window)))
(when exit-action
(funcall exit-action buffer))
diff --git a/lisp/window.el b/lisp/window.el
index eca3dcb435d..fb9d38c6503 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -2272,7 +2272,7 @@ another frame still exists.
Functions quitting a window and consequently affected by this
variable are `switch-to-prev-buffer', `delete-windows-on',
-`replace-buffer-in-windows' and `quit-restore-window'."
+`replace-buffer-in-windows' and `quit-window'."
:type '(choice
(const :tag "Never" nil)
(const :tag "Automatic" automatic)
@@ -2907,21 +2907,17 @@ all window-local buffer lists."
;; Unrecord BUFFER in WINDOW.
(unrecord-window-buffer window buffer)))))
-(defun quit-restore-window (&optional window kill)
- "Quit WINDOW in some way.
-WINDOW must be a live window and defaults to the selected window.
-Return nil.
+(defun quit-window (&optional kill window)
+ "Quit WINDOW and bury its buffer.
+WINDOW defaults to the selected window.
+With a prefix argument, kill the buffer instead.
According to information stored in WINDOW's `quit-restore' window
parameter either \(1) delete WINDOW and its frame, \(2) delete
WINDOW, \(3) restore the buffer previously displayed in WINDOW,
or \(4) make WINDOW display some other buffer than the present
-one. If non-nil, reset `quit-restore' parameter to nil.
-
-Optional argument KILL non-nil means in addition kill WINDOW's
-buffer. If KILL is nil, put WINDOW's buffer at the end of the
-buffer list. Interactively, KILL is the prefix argument."
- (interactive "i\nP")
+one. If non-nil, reset `quit-restore' parameter to nil."
+ (interactive "P")
(setq window (window-normalize-live-window window))
(let ((buffer (window-buffer window))
(quit-restore (window-parameter window 'quit-restore))
@@ -2971,8 +2967,7 @@ buffer list. Interactively, KILL is the prefix argument."
(switch-to-prev-buffer window 'bury-or-kill)))
;; Kill WINDOW's old-buffer if requested
- (when kill (kill-buffer buffer))
- nil))
+ (if kill (kill-buffer buffer))))
;;; Splitting windows.
(defsubst window-split-min-size (&optional horizontal)
@@ -4763,8 +4758,10 @@ BUFFER, nil if none was found."
(dolist (window (window-list-1 nil 'nomini method-frame))
(let ((window-buffer (window-buffer window)))
(when (and (not (window-minibuffer-p window))
- ;; Don't reuse a side window.
- (or (not (eq (window-parameter window 'window-side) 'side))
+ ;; Don't reuse a side window unless it shows the
+ ;; buffer already.
+ (or (memq (window-parameter window 'window-side)
+ '(nil none))
(eq window-buffer buffer))
(or (not method-window)
(and (eq method-window 'same)
@@ -5033,7 +5030,8 @@ description."
;; and must be neither a minibuffer window
(not (window-minibuffer-p window))
;; nor a side window.
- (not (eq (window-parameter window 'window-side) 'side)))
+ (memq (window-parameter window 'window-side)
+ '(nil none)))
(setq window
(cond
((memq side display-buffer-side-specifiers)
@@ -6079,9 +6077,6 @@ ignored.
See also `same-window-regexps'."
:type '(repeat (string :format "%v"))
:group 'windows)
-;; (make-obsolete-variable
- ;; 'same-window-buffer-names
- ;; "use 2nd arg of `display-buffer' instead." "24.1")
(defcustom same-window-regexps nil
"List of regexps saying which buffers should appear in the \"same\" window.
@@ -6097,9 +6092,6 @@ the buffer name. This is for compatibility with
See also `same-window-buffer-names'."
:type '(repeat (regexp :format "%v"))
:group 'windows)
-;; (make-obsolete-variable
- ;; 'same-window-regexps
- ;; "use 2nd arg of `display-buffer' instead." "24.1")
(defun same-window-p (buffer-name)
"Return non-nil if a buffer named BUFFER-NAME would be shown in the \"same\" window.
@@ -6124,8 +6116,6 @@ selected rather than \(as usual\) some other window. See
(and (consp regexp) (stringp (car regexp))
(string-match-p (car regexp) buffer-name)))
(throw 'found t))))))))
-;; (make-obsolete
- ;; 'same-window-p "pass argument to buffer display function instead." "24.1")
(defcustom special-display-frame-alist
'((height . 14) (width . 80) (unsplittable . t))
@@ -6143,9 +6133,6 @@ These supersede the values given in `default-frame-alist'."
(symbol :tag "Parameter")
(sexp :tag "Value")))
:group 'frames)
-;; (make-obsolete-variable
- ;; 'special-display-frame-alist
- ;; "use 2nd arg of `display-buffer' instead." "24.1")
(defun special-display-popup-frame (buffer &optional args)
"Display BUFFER in a special frame and return the window chosen.
@@ -6191,9 +6178,6 @@ and (cdr ARGS) as the rest of the arguments."
(set-window-buffer (frame-selected-window frame) buffer)
(set-window-dedicated-p (frame-selected-window frame) t)
(frame-selected-window frame))))))
-;; (make-obsolete
- ;; 'special-display-popup-frame
- ;; "use 2nd arg of `display-buffer' instead." "24.1")
(defcustom special-display-function 'special-display-popup-frame
"Function to call for displaying special buffers.
@@ -6210,9 +6194,6 @@ A buffer is special when its name is either listed in
:type 'function
:group 'windows
:group 'frames)
-;; (make-obsolete-variable
- ;; 'special-display-function
- ;; "use 2nd arg of `display-buffer' instead." "24.1")
(defcustom special-display-buffer-names nil
"List of names of buffers that should be displayed specially.
@@ -6277,9 +6258,6 @@ See also `special-display-regexps'."
(repeat :tag "Arguments" (sexp)))))
:group 'windows
:group 'frames)
-;; (make-obsolete-variable
- ;; 'special-display-buffer-names
- ;; "use 2nd arg of `display-buffer' instead." "24.1")
;;;###autoload
(put 'special-display-buffer-names 'risky-local-variable t)
@@ -6348,9 +6326,6 @@ See also `special-display-buffer-names'."
(repeat :tag "Arguments" (sexp)))))
:group 'windows
:group 'frames)
-;; (make-obsolete-variable
- ;; 'special-display-regexps
- ;; "use 2nd arg of `display-buffer' instead." "24.1")
(defun special-display-p (buffer-name)
"Return non-nil if a buffer named BUFFER-NAME gets a special frame.
@@ -6378,9 +6353,6 @@ entry."
((and (consp regexp) (stringp (car regexp))
(string-match-p (car regexp) buffer-name))
(throw 'found (cdr regexp))))))))))
-;; (make-obsolete
- ;; 'special-display-p
- ;; "pass argument to buffer display function instead." "24.1")
(defcustom pop-up-frame-alist nil
"Alist of parameters for automatically generated new frames.
@@ -6400,9 +6372,6 @@ affected by this variable."
(symbol :tag "Parameter")
(sexp :tag "Value")))
:group 'frames)
-;; (make-obsolete-variable
- ;; 'pop-up-frame-alist
- ;; "use 2nd arg of `display-buffer' instead." "24.1")
(defcustom pop-up-frame-function
(lambda () (make-frame pop-up-frame-alist))
@@ -6412,9 +6381,6 @@ frame. The default value calls `make-frame' with the argument
`pop-up-frame-alist'."
:type 'function
:group 'frames)
-;; (make-obsolete-variable
- ;; 'pop-up-frame-function
- ;; "use 2nd arg of `display-buffer' instead." "24.1")
(defcustom pop-up-frames nil
"Whether `display-buffer' should make a separate frame.
@@ -6428,9 +6394,6 @@ Any other non-nil value means always make a separate frame."
(const :tag "Always" t))
:group 'windows
:group 'frames)
-;; (make-obsolete-variable
- ;; 'pop-up-frames
- ;; "use 2nd arg of `display-buffer' instead." "24.1")
(defcustom display-buffer-reuse-frames nil
"Set and non-nil means `display-buffer' should reuse frames.
@@ -6440,17 +6403,11 @@ that frame."
:version "21.1"
:group 'windows
:group 'frames)
-;; (make-obsolete-variable
- ;; 'display-buffer-reuse-frames
- ;; "use 2nd arg of `display-buffer' instead." "24.1")
(defcustom pop-up-windows t
"Non-nil means `display-buffer' should make a new window."
:type 'boolean
:group 'windows)
-;; (make-obsolete-variable
- ;; 'pop-up-windows
- ;; "use 2nd arg of `display-buffer' instead." "24.1")
(defcustom split-window-preferred-function 'split-window-sensibly
"Function called by `display-buffer' to split a window.
@@ -6477,9 +6434,6 @@ not want to split the selected window."
:type 'function
:version "23.1"
:group 'windows)
-;; (make-obsolete-variable
- ;; 'split-window-preferred-function
- ;; "use 2nd arg of `display-buffer' instead." "24.1")
(defcustom split-height-threshold 80
"Minimum height for splitting a window to display a buffer.
@@ -6491,9 +6445,6 @@ split it vertically disregarding the value of this variable."
:type '(choice (const nil) (integer :tag "lines"))
:version "23.1"
:group 'windows)
-;; (make-obsolete-variable
- ;; 'split-height-threshold
- ;; "use 2nd arg of `display-buffer' instead." "24.1")
(defcustom split-width-threshold 160
"Minimum width for splitting a window to display a buffer.
@@ -6503,9 +6454,6 @@ is nil, `display-buffer' cannot split windows horizontally."
:type '(choice (const nil) (integer :tag "columns"))
:version "23.1"
:group 'windows)
-;; (make-obsolete-variable
- ;; 'split-width-threshold
- ;; "use 2nd arg of `display-buffer' instead." "24.1")
(defcustom even-window-heights t
"If non-nil `display-buffer' will try to even window heights.
@@ -6514,17 +6462,11 @@ alone. Heights are evened only when `display-buffer' chooses a
window that appears above or below the selected window."
:type 'boolean
:group 'windows)
-;; (make-obsolete-variable
- ;; 'even-window-heights
- ;; "use 2nd arg of `display-buffer' instead." "24.1")
(defvar display-buffer-mark-dedicated nil
"Non-nil means `display-buffer' marks the windows it creates as dedicated.
The actual non-nil value of this variable will be copied to the
`window-dedicated-p' flag.")
-;; (make-obsolete-variable
- ;; 'display-buffer-mark-dedicated
- ;; "use 2nd arg of `display-buffer' instead." "24.1")
(defun window-splittable-p (window &optional horizontal)
"Return non-nil if `split-window-sensibly' may split WINDOW.
@@ -6575,8 +6517,6 @@ hold:
(max split-height-threshold
(* 2 (max window-min-height
(if mode-line-format 2 1))))))))))
-;; (make-obsolete
- ;; 'window-splittable-p "use 2nd arg of `display-buffer' instead." "24.1")
(defun split-window-sensibly (window)
"Split WINDOW in a way suitable for `display-buffer'.
@@ -6626,8 +6566,6 @@ split."
(when (with-no-warnings (window-splittable-p window))
(with-selected-window window
(split-window-vertically)))))))
-;; (make-obsolete
- ;; 'split-window-sensibly "use 2nd arg of `display-buffer' instead." "24.1")
;; Functions for converting Emacs 23 buffer display options to buffer
;; display specifiers.
@@ -7102,39 +7040,6 @@ Return non-nil if the window was shrunk, nil otherwise."
(with-current-buffer buffer-to-kill
(remove-hook 'kill-buffer-hook delete-window-hook t))))))
-(defun quit-window (&optional kill window)
- "Quit WINDOW and bury its buffer.
-With a prefix argument, kill the buffer instead. WINDOW defaults
-to the selected window.
-
-If WINDOW is non-nil, dedicated, or a minibuffer window, delete
-it and, if it's alone on its frame, its frame too. Otherwise, or
-if deleting WINDOW fails in any of the preceding cases, display
-another buffer in WINDOW using `switch-to-buffer'.
-
-Optional argument KILL non-nil means kill WINDOW's buffer.
-Otherwise, bury WINDOW's buffer, see `bury-buffer'."
- (interactive "P")
- (let ((buffer (window-buffer window)))
- (if (or window
- (window-minibuffer-p window)
- (window-dedicated-p window))
- ;; WINDOW is either non-nil, a minibuffer window, or dedicated;
- ;; try to delete it.
- (let* ((window (or window (selected-window)))
- (frame (window-frame window)))
- (if (frame-root-window-p window)
- ;; WINDOW is alone on its frame.
- (delete-frame frame)
- ;; There are other windows on its frame, delete WINDOW.
- (delete-window window)))
- ;; Otherwise, switch to another buffer in the selected window.
- (switch-to-buffer nil))
-
- ;; Deal with the buffer.
- (if kill
- (kill-buffer buffer)
- (bury-buffer buffer))))
(defvar recenter-last-op nil
"Indicates the last recenter operation performed.
@@ -7531,6 +7436,8 @@ Otherwise, consult the value of `truncate-partial-width-windows'
(< (window-width window) t-p-w-w)
t-p-w-w))))
+;; Some of these are in tutorial--default-keys, so update that if you
+;; change these.
(define-key ctl-x-map "0" 'delete-window)
(define-key ctl-x-map "1" 'delete-other-windows)
(define-key ctl-x-map "2" 'split-window-above-each-other)