diff --git a/admin/ChangeLog b/admin/ChangeLog index 7af23b779ef..87da4f7e26b 100644 --- a/admin/ChangeLog +++ b/admin/ChangeLog @@ -1,3 +1,11 @@ +2014-05-12 Glenn Morris + + * find-gc.el: Move here from ../lisp/emacs-lisp. + + * admin.el (set-version-in-file): Don't set identical version. + (set-version): Provide default version number. + (set-version, set-copyright): Give start/end messages. + 2014-04-18 Paul Eggert * notes/bzr: Update instructions for merging from gnulib. diff --git a/admin/admin.el b/admin/admin.el index 007cb06e592..7af9ffa4177 100644 --- a/admin/admin.el +++ b/admin/admin.el @@ -65,17 +65,25 @@ Optional argument DATE is the release date, default today." "Subroutine of `set-version' and `set-copyright'." (find-file (expand-file-name file root)) (goto-char (point-min)) + (setq version (format "%s" version)) (unless (re-search-forward rx nil :noerror) (user-error "Version not found in %s" file)) - (replace-match (format "%s" version) nil nil nil 1)) + (if (not (equal version (match-string 1))) + (replace-match version nil nil nil 1) + (kill-buffer) + (message "No need to update `%s'" file))) -;; TODO report the progress (defun set-version (root version) "Set Emacs version to VERSION in relevant files under ROOT. Root must be the root of an Emacs source tree." - (interactive "DEmacs root directory: \nsVersion number: ") + (interactive (list + (read-directory-name "Emacs root directory: " source-directory) + (read-string "Version number: " + (replace-regexp-in-string "\\.[0-9]+\\'" "" + emacs-version)))) (unless (file-exists-p (expand-file-name "src/emacs.c" root)) (user-error "%s doesn't seem to be the root of an Emacs source tree" root)) + (message "Setting version numbers...") ;; There's also a "version 3" (standing for GPLv3) at the end of ;; `README', but since `set-version-in-file' only replaces the first ;; occurrence, it won't be replaced. @@ -158,11 +166,10 @@ Root must be the root of an Emacs source tree." {\\([0-9]\\{2,\\}\\)}.+%.+version of Emacs") (set-version-in-file root "etc/refcards/emacsver.tex" version "\\\\def\\\\versionemacs\ -{\\([0-9]\\{2,\\}\\)}.+%.+version of Emacs")))) - +{\\([0-9]\\{2,\\}\\)}.+%.+version of Emacs"))) + (message "Setting version numbers...done")) ;; Note this makes some assumptions about form of short copyright. -;; TODO report the progress (defun set-copyright (root copyright) "Set Emacs short copyright to COPYRIGHT in relevant files under ROOT. Root must be the root of an Emacs source tree." @@ -174,6 +181,7 @@ Root must be the root of an Emacs source tree." (format-time-string "%Y"))))) (unless (file-exists-p (expand-file-name "src/emacs.c" root)) (user-error "%s doesn't seem to be the root of an Emacs source tree" root)) + (message "Setting copyrights...") (set-version-in-file root "configure.ac" copyright (rx (and bol "copyright" (0+ (not (in ?\"))) ?\" (submatch (1+ (not (in ?\")))) ?\"))) @@ -195,7 +203,8 @@ Root must be the root of an Emacs source tree." {\\([0-9]\\{4\\}\\)}.+%.+copyright year") (set-version-in-file root "etc/refcards/emacsver.tex" copyright "\\\\def\\\\year\ -{\\([0-9]\\{4\\}\\)}.+%.+copyright year"))) +{\\([0-9]\\{4\\}\\)}.+%.+copyright year")) + (message "Setting copyrights...done")) ;;; Various bits of magic for generating the web manuals diff --git a/lisp/emacs-lisp/find-gc.el b/admin/find-gc.el similarity index 100% rename from lisp/emacs-lisp/find-gc.el rename to admin/find-gc.el diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index 778d0d700ee..52994a55854 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -1240,7 +1240,8 @@ buffer: if @var{place} is just a symbol, then @var{function} is added to the global value of @var{place}. Whereas if @var{place} is of the form @code{(local @var{symbol})}, where @var{symbol} is an expression which returns the variable name, then @var{function} will only be added in the -current buffer. +current buffer. Finally, if you want to modify a lexical variable, you will +have to use @code{(var @var{VARIABLE})}. Every function added with @code{add-function} can be accompanied by an association list of properties @var{props}. Currently only two of those diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 52c1f0c164a..0de3533c6c4 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,54 @@ +2014-05-12 Stefan Monnier + + * emacs-lisp/nadvice.el (advice--interactive-form): Don't get fooled + into autoloading just because of a silly indirection. + +2014-05-12 Santiago Payà i Miralta (tiny change) + + * vc/vc-hg.el (vc-hg-unregister): New function. (Bug#17454) + +2014-05-12 Glenn Morris + + * emacs-lisp/find-gc.el: Move to ../admin. + + * printing.el (pr-version): + * ps-print.el (ps-print-version): Also mention bug-gnu-emacs. + + * net/browse-url.el (browse-url-mosaic): + Create /tmp/Mosaic.PID as a private file. + +2014-05-12 Stefan Monnier + + * emacs-lisp/nadvice.el: Support adding a given function multiple times. + (advice--member-p): If name is given, only compare the name. + (advice--remove-function): Don't stop at the first match. + (advice--normalize-place): New function. + (add-function, remove-function): Use it. + (advice--add-function): Pass the name, if any, to + advice--remove-function. + +2014-05-12 Philipp Rumpf (tiny change) + + * electric.el (electric-indent-post-self-insert-function): Don't use + `pos' after modifying the buffer (bug#17449). + +2014-05-12 Stephen Berman + + * calendar/todo-mode.el (todo-insert-item-from-calendar): + Correct argument list to conform to todo-insert-item--basic. + +2014-05-12 Glenn Morris + + * files.el (cd-absolute): Test if directory is accessible + rather than executable. (Bug#17330) + + * progmodes/compile.el (recompile): + Handle C-u M-x recompile from a non-compilation buffer. (Bug#17444) + + * net/browse-url.el (browse-url-mosaic): + Be careful when writing /tmp/Mosaic.PID. (Bug#17428) + This is CVE-2014-3423. + 2014-05-11 Stefan Monnier * mouse.el: Use the normal toplevel loop while dragging. @@ -89,6 +140,7 @@ (tramp-remote-coding-commands): Enhance docstring. (tramp-find-inline-encoding): Replace "%t" by a temporary file name. (Bug#17415) + This is CVE-2014-3424. 2014-05-08 Glenn Morris @@ -96,6 +148,7 @@ (find-gc-source-files): Update some names. (trace-call-tree): Simplify and update. Avoid predictable temp-file names. (http://bugs.debian.org/747100) + This is CVE-2014-3422. 2014-05-08 Stefan Monnier diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index 4f4aefa6317..f7f2b1d1539 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -1984,7 +1984,7 @@ prompt for a todo file and then for a category in it." (setq todo-date-from-calendar (calendar-date-string (calendar-cursor-to-date t) t t)) (calendar-exit) - (todo-insert-item--basic arg nil nil todo-date-from-calendar)) + (todo-insert-item--basic arg nil todo-date-from-calendar)) (define-key calendar-mode-map "it" 'todo-insert-item-from-calendar) diff --git a/lisp/electric.el b/lisp/electric.el index e8ceaa6406c..bf73dbb256f 100644 --- a/lisp/electric.el +++ b/lisp/electric.el @@ -259,29 +259,30 @@ or comment." (unless (eq act 'do-indent) (nth 8 (syntax-ppss)))))))) ;; For newline, we want to reindent both lines and basically behave like ;; reindent-then-newline-and-indent (whose code we hence copied). - (when (<= pos (line-beginning-position)) - (let ((before (copy-marker (1- pos) t))) - (save-excursion - (unless (or (memq indent-line-function - electric-indent-functions-without-reindent) - electric-indent-inhibit) - ;; Don't reindent the previous line if the indentation function - ;; is not a real one. + (let ((at-newline (<= pos (line-beginning-position)))) + (when at-newline + (let ((before (copy-marker (1- pos) t))) + (save-excursion + (unless (or (memq indent-line-function + electric-indent-functions-without-reindent) + electric-indent-inhibit) + ;; Don't reindent the previous line if the indentation function + ;; is not a real one. + (goto-char before) + (indent-according-to-mode)) + ;; We are at EOL before the call to indent-according-to-mode, and + ;; after it we usually are as well, but not always. We tried to + ;; address it with `save-excursion' but that uses a normal marker + ;; whereas we need `move after insertion', so we do the + ;; save/restore by hand. (goto-char before) - (indent-according-to-mode)) - ;; We are at EOL before the call to indent-according-to-mode, and - ;; after it we usually are as well, but not always. We tried to - ;; address it with `save-excursion' but that uses a normal marker - ;; whereas we need `move after insertion', so we do the - ;; save/restore by hand. - (goto-char before) - (when (eolp) - ;; Remove the trailing whitespace after indentation because - ;; indentation may (re)introduce the whitespace. - (delete-horizontal-space t))))) - (unless (and electric-indent-inhibit - (> pos (line-beginning-position))) - (indent-according-to-mode))))) + (when (eolp) + ;; Remove the trailing whitespace after indentation because + ;; indentation may (re)introduce the whitespace. + (delete-horizontal-space t))))) + (unless (and electric-indent-inhibit + (not at-newline)) + (indent-according-to-mode)))))) (put 'electric-indent-post-self-insert-function 'priority 60) diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index 0e2536f8179..01027c43148 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -134,7 +134,7 @@ Each element has the form (WHERE BYTECODE STACK) where: (defun advice--interactive-form (function) ;; Like `interactive-form' but tries to avoid autoloading functions. (when (commandp function) - (if (not (and (symbolp function) (autoloadp (symbol-function function)))) + (if (not (and (symbolp function) (autoloadp (indirect-function function)))) (interactive-form function) `(interactive (advice-eval-interactive-spec (cadr (interactive-form ',function))))))) @@ -183,9 +183,9 @@ WHERE is a symbol to select an entry in `advice--where-alist'." (defun advice--member-p (function name definition) (let ((found nil)) (while (and (not found) (advice--p definition)) - (if (or (equal function (advice--car definition)) - (when name - (equal name (cdr (assq 'name (advice--props definition)))))) + (if (if name + (equal name (cdr (assq 'name (advice--props definition)))) + (equal function (advice--car definition))) (setq found definition) (setq definition (advice--cdr definition)))) found)) @@ -209,8 +209,8 @@ WHERE is a symbol to select an entry in `advice--where-alist'." (lambda (first rest props) (cond ((not first) rest) ((or (equal function first) - (equal function (cdr (assq 'name props)))) - (list rest)))))) + (equal function (cdr (assq 'name props)))) + (list (advice--remove-function rest function))))))) (defvar advice--buffer-local-function-sample nil "keeps an example of the special \"run the default value\" functions. @@ -232,6 +232,12 @@ different, but `function-equal' will hopefully ignore those differences.") ;; This function acts like the t special value in buffer-local hooks. (lambda (&rest args) (apply (default-value var) args))))) +(defun advice--normalize-place (place) + (cond ((eq 'local (car-safe place)) `(advice--buffer-local ,@(cdr place))) + ((eq 'var (car-safe place)) (nth 1 place)) + ((symbolp place) `(default-value ',place)) + (t place))) + ;;;###autoload (defmacro add-function (where place function &optional props) ;; TODO: @@ -267,8 +273,9 @@ a special meaning: the advice should be innermost (i.e. at the end of the list), whereas a depth of -100 means that the advice should be outermost. -If PLACE is a simple variable, only its global value will be affected. -Use (local 'VAR) if you want to apply FUNCTION to VAR buffer-locally. +If PLACE is a symbol, its `default-value' will be affected. +Use (local 'SYMBOL) if you want to apply FUNCTION to SYMBOL buffer-locally. +Use (var VAR) if you want to apply FUNCTION to the (lexical) VAR. If one of FUNCTION or OLDFUN is interactive, then the resulting function is also interactive. There are 3 cases: @@ -278,20 +285,18 @@ is also interactive. There are 3 cases: `advice-eval-interactive-spec') and return the list of arguments to use. - Else, use the interactive spec of FUNCTION and ignore the one of OLDFUN." (declare (debug t)) ;;(indent 2) - (cond ((eq 'local (car-safe place)) - (setq place `(advice--buffer-local ,@(cdr place)))) - ((symbolp place) - (setq place `(default-value ',place)))) - `(advice--add-function ,where (gv-ref ,place) ,function ,props)) + `(advice--add-function ,where (gv-ref ,(advice--normalize-place place)) + ,function ,props)) ;;;###autoload (defun advice--add-function (where ref function props) - (let ((a (advice--member-p function (cdr (assq 'name props)) - (gv-deref ref)))) + (let* ((name (cdr (assq 'name props))) + (a (advice--member-p function name (gv-deref ref)))) (when a ;; The advice is already present. Remove the old one, first. (setf (gv-deref ref) - (advice--remove-function (gv-deref ref) (advice--car a)))) + (advice--remove-function (gv-deref ref) + (or name (advice--car a))))) (setf (gv-deref ref) (advice--make where function (gv-deref ref) props)))) @@ -302,11 +307,7 @@ If FUNCTION was not added to PLACE, do nothing. Instead of FUNCTION being the actual function, it can also be the `name' of the piece of advice." (declare (debug t)) - (cond ((eq 'local (car-safe place)) - (setq place `(advice--buffer-local ,@(cdr place)))) - ((symbolp place) - (setq place `(default-value ',place)))) - (gv-letplace (getter setter) place + (gv-letplace (getter setter) (advice--normalize-place place) (macroexp-let2 nil new `(advice--remove-function ,getter ,function) `(unless (eq ,new ,getter) ,(funcall setter new))))) diff --git a/lisp/files.el b/lisp/files.el index 5487e27198a..cd2feb69610 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -685,7 +685,7 @@ nil (meaning `default-directory') as the associated list element." (if (file-exists-p dir) (error "%s is not a directory" dir) (error "%s: no such directory" dir)) - (unless (file-executable-p dir) + (unless (file-accessible-directory-p dir) (error "Cannot cd to %s: Permission denied" dir)) (setq default-directory dir) (setq list-buffers-directory dir))) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index c97ad7fc0a2..dad0444fcb2 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -15,6 +15,7 @@ * gnus-fun.el (gnus-grab-cam-face): Do not use predictable temp-file name. (http://bugs.debian.org/747100) + This is CVE-2014-3421. 2014-05-04 Glenn Morris diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 4364490f431..33f4eda9604 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -1333,31 +1333,32 @@ used instead of `browse-url-new-window-flag'." (let ((pidfile (expand-file-name browse-url-mosaic-pidfile)) pid) (if (file-readable-p pidfile) - (save-excursion - (find-file pidfile) - (goto-char (point-min)) - (setq pid (read (current-buffer))) - (kill-buffer nil))) - (if (and pid (zerop (signal-process pid 0))) ; Mosaic running - (save-excursion - ;; This is a predictable temp-file name, which is bad, - ;; but it is what Mosaic uses/used. - ;; So it's not Emacs's problem. http://bugs.debian.org/747100 - (find-file (format "/tmp/Mosaic.%d" pid)) - (erase-buffer) - (insert (if (browse-url-maybe-new-window new-window) - "newwin\n" - "goto\n") - url "\n") - (save-buffer) - (kill-buffer nil) + (with-temp-buffer + (insert-file-contents pidfile) + (setq pid (read (current-buffer))))) + (if (and (integerp pid) (zerop (signal-process pid 0))) ; Mosaic running + (progn + (with-temp-buffer + (insert (if (browse-url-maybe-new-window new-window) + "newwin\n" + "goto\n") + url "\n") + (let ((umask (default-file-modes))) + (unwind-protect + (progn + (set-default-file-modes ?\700) + (if (file-exists-p + (setq pidfile (format "/tmp/Mosaic.%d" pid))) + (delete-file pidfile)) + ;; http://debbugs.gnu.org/17428. Use O_EXCL. + (write-region nil nil pidfile nil 'silent nil 'excl)) + (set-default-file-modes umask)))) ;; Send signal SIGUSR to Mosaic (message "Signaling Mosaic...") (signal-process pid 'SIGUSR1) ;; Or you could try: ;; (call-process "kill" nil 0 nil "-USR1" (int-to-string pid)) - (message "Signaling Mosaic...done") - ) + (message "Signaling Mosaic...done")) ;; Mosaic not running - start it (message "Starting %s..." browse-url-mosaic-program) (apply 'start-process "xmosaic" nil browse-url-mosaic-program diff --git a/lisp/org/ChangeLog b/lisp/org/ChangeLog index c1e3c9998d0..a74388b7d71 100644 --- a/lisp/org/ChangeLog +++ b/lisp/org/ChangeLog @@ -1,3 +1,9 @@ +2014-05-12 Eric Schulte + + * ob-screen.el (org-babel-screen-session-write-temp-file) + (org-babel-screen-test): + Use unpredictable names for temporary files. (Bug#17416) + 2014-04-22 Aaron Ecay * org-src.el (org-edit-src-exit): Place an undo boundary before @@ -286,7 +292,7 @@ 2014-04-22 Justin Gordon - * ox-md (org-md-separate-elements): Fix blank line insertion + * ox-md.el (org-md-separate-elements): Fix blank line insertion between elements. * ox-md.el (org-md-inner-template): New function. diff --git a/lisp/org/ob-screen.el b/lisp/org/ob-screen.el index 2acbbeb7182..1d4ccdddf85 100644 --- a/lisp/org/ob-screen.el +++ b/lisp/org/ob-screen.el @@ -106,7 +106,7 @@ In case you want to use a different screen than one selected by your $PATH") (defun org-babel-screen-session-write-temp-file (session body) "Save BODY in a temp file that is named after SESSION." - (let ((tmpfile (concat "/tmp/screen.org-babel-session-" session))) + (let ((tmpfile (org-babel-temp-file "screen-"))) (with-temp-file tmpfile (insert body) @@ -121,7 +121,7 @@ The terminal should shortly flicker." (interactive) (let* ((session "org-babel-testing") (random-string (format "%s" (random 99999))) - (tmpfile "/tmp/org-babel-screen.test") + (tmpfile (org-babel-temp-file "ob-screen-test-")) (body (concat "echo '" random-string "' > " tmpfile "\nexit\n")) process tmp-string) (org-babel-execute:screen body org-babel-default-header-args:screen) diff --git a/lisp/printing.el b/lisp/printing.el index f24c0ab4297..0393746f8a5 100644 --- a/lisp/printing.el +++ b/lisp/printing.el @@ -12,7 +12,7 @@ "printing.el, v 6.9.3 <2007/12/09 vinicius> Please send all bug fixes and enhancements to - Vinicius Jose Latorre + bug-gnu-emacs@gnu.org and Vinicius Jose Latorre ") ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 146b9f8cb71..dd1fb78c1a2 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -1460,7 +1460,7 @@ If optional second arg COMINT is t the buffer will be in Comint mode with `compilation-shell-minor-mode'. Interactively, prompts for the command if the variable -`compilation-read-command' is non-nil; otherwise uses`compile-command'. +`compilation-read-command' is non-nil; otherwise uses `compile-command'. With prefix arg, always prompts. Additionally, with universal prefix arg, compilation buffer will be in comint mode, i.e. interactive. @@ -1499,12 +1499,13 @@ If the optional argument `edit-command' is non-nil, the command can be edited." (interactive "P") (save-some-buffers (not compilation-ask-about-save) compilation-save-buffers-predicate) - (let ((default-directory (or compilation-directory default-directory))) + (let ((default-directory (or compilation-directory default-directory)) + (command (eval compile-command))) (when edit-command - (setcar compilation-arguments - (compilation-read-command (car compilation-arguments)))) - (apply 'compilation-start (or compilation-arguments - `(,(eval compile-command)))))) + (setq command (compilation-read-command (or (car compilation-arguments) + command))) + (if compilation-arguments (setcar compilation-arguments command))) + (apply 'compilation-start (or compilation-arguments (list command))))) (defcustom compilation-scroll-output nil "Non-nil to scroll the *compilation* buffer window as output appears. diff --git a/lisp/ps-print.el b/lisp/ps-print.el index 004bdce1f6a..83f2cde4010 100644 --- a/lisp/ps-print.el +++ b/lisp/ps-print.el @@ -20,7 +20,7 @@ Emacs without changes to the version number. When reporting bugs, please also report the version of Emacs, if any, that ps-print was distributed with. Please send all bug fixes and enhancements to - Vinicius Jose Latorre .") + bug-gnu-emacs@gnu.org and Vinicius Jose Latorre .") ;; This file is part of GNU Emacs. diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index f3426656038..aba4a2c53e8 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog @@ -1,3 +1,8 @@ +2014-05-12 Michael Albinus + + * url-handlers.el (url-file-handler-load-in-progress): New defvar. + (url-file-handler): Use it, in order to avoid recursive load. + 2014-05-04 Glenn Morris * url-parse.el (url-generic-parse-url): Doc fix (replace `iff'). diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el index 9a05746ebff..c86acb680d0 100644 --- a/lisp/url/url-handlers.el +++ b/lisp/url/url-handlers.el @@ -138,34 +138,41 @@ like URLs \(Gnus is particularly bad at this\)." (inhibit-file-name-operation operation)) (apply operation args))) +(defvar url-file-handler-load-in-progress nil + "Check for recursive load.") + ;;;###autoload (defun url-file-handler (operation &rest args) "Function called from the `file-name-handler-alist' routines. OPERATION is what needs to be done (`file-exists-p', etc). ARGS are the arguments that would have been passed to OPERATION." - ;; Check, whether there are arguments we want pass to Tramp. - (if (catch :do - (dolist (url (cons default-directory args)) - (and (member - (url-type (url-generic-parse-url (and (stringp url) url))) - url-tramp-protocols) - (throw :do t)))) - (apply 'url-tramp-file-handler operation args) - ;; Otherwise, let's do the job. - (let ((fn (get operation 'url-file-handlers)) - (val nil) - (hooked nil)) - (if (and (not fn) (intern-soft (format "url-%s" operation)) - (fboundp (intern-soft (format "url-%s" operation)))) - (error "Missing URL handler mapping for %s" operation)) - (if fn - (setq hooked t - val (save-match-data (apply fn args))) - (setq hooked nil - val (url-run-real-handler operation args))) - (url-debug 'handlers "%s %S%S => %S" (if hooked "Hooked" "Real") - operation args val) - val))) + ;; Avoid recursive load. + (if (and load-in-progress url-file-handler-load-in-progress) + (url-run-real-handler operation args) + (let ((url-file-handler-load-in-progress load-in-progress)) + ;; Check, whether there are arguments we want pass to Tramp. + (if (catch :do + (dolist (url (cons default-directory args)) + (and (member + (url-type (url-generic-parse-url (and (stringp url) url))) + url-tramp-protocols) + (throw :do t)))) + (apply 'url-tramp-file-handler operation args) + ;; Otherwise, let's do the job. + (let ((fn (get operation 'url-file-handlers)) + (val nil) + (hooked nil)) + (if (and (not fn) (intern-soft (format "url-%s" operation)) + (fboundp (intern-soft (format "url-%s" operation)))) + (error "Missing URL handler mapping for %s" operation)) + (if fn + (setq hooked t + val (save-match-data (apply fn args))) + (setq hooked nil + val (url-run-real-handler operation args))) + (url-debug 'handlers "%s %S%S => %S" (if hooked "Hooked" "Real") + operation args val) + val))))) (defun url-file-handler-identity (&rest args) ;; Identity function diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index a53ed8758c4..05b53a3eeb6 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -60,7 +60,7 @@ ;; - responsible-p (file) OK ;; - could-register (file) OK ;; - receive-file (file rev) ?? PROBABLY NOT NEEDED -;; - unregister (file) COMMENTED OUT, MAY BE INCORRECT +;; - unregister (file) OK ;; * checkin (files rev comment) OK ;; * find-revision (file rev buffer) OK ;; * checkout (file &optional editable rev) OK @@ -436,10 +436,9 @@ COMMENT is ignored." ;; registered. (error)))) -;; FIXME: This would remove the file. Is that correct? -;; (defun vc-hg-unregister (file) -;; "Unregister FILE from hg." -;; (vc-hg-command nil nil file "remove")) +(defun vc-hg-unregister (file) + "Unregister FILE from hg." + (vc-hg-command nil 0 file "forget")) (declare-function log-edit-extract-headers "log-edit" (headers string)) diff --git a/src/ChangeLog b/src/ChangeLog index 72e78724bab..5d06882cee7 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,12 @@ +2014-05-12 Glenn Morris + + * fileio.c (Ffile_executable_p): Doc tweak. + +2014-05-12 Jan Djärv + + * xsettings.c (init_gsettings): Use g_settings_schema_source_lookup + instead of deprecated g_settings_list_schemas if possible (Bug#17434). + 2014-05-08 Paul Eggert * minibuf.c (read_minibuf): Avoid C99ism in previous patch (Bug#17430). diff --git a/src/fileio.c b/src/fileio.c index 5659b6555d8..dcee70aa8b4 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -2546,7 +2546,9 @@ Use `file-symlink-p' to test for such links. */) DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0, doc: /* Return t if FILENAME can be executed by you. -For a directory, this means you can access files in that directory. */) +For a directory, this means you can access files in that directory. +\(It is generally better to use `file-accessible-directory-p' for that +purpose, though.) */) (Lisp_Object filename) { Lisp_Object absname; diff --git a/src/xsettings.c b/src/xsettings.c index 844da19f638..5f4275df545 100644 --- a/src/xsettings.c +++ b/src/xsettings.c @@ -795,17 +795,29 @@ init_gsettings (void) { #ifdef HAVE_GSETTINGS GVariant *val; - const gchar *const *schemas; int schema_found = 0; #if ! GLIB_CHECK_VERSION (2, 36, 0) g_type_init (); #endif - schemas = g_settings_list_schemas (); - if (schemas == NULL) return; - while (! schema_found && *schemas != NULL) - schema_found = strcmp (*schemas++, GSETTINGS_SCHEMA) == 0; +#if GLIB_CHECK_VERSION (2, 32, 0) + { + GSettingsSchema *sc = g_settings_schema_source_lookup + (g_settings_schema_source_get_default (), + GSETTINGS_SCHEMA, + TRUE); + schema_found = sc != NULL; + if (sc) g_settings_schema_unref (sc); + } +#else + { + const gchar *const *schemas = g_settings_list_schemas (); + if (schemas == NULL) return; + while (! schema_found && *schemas != NULL) + schema_found = strcmp (*schemas++, GSETTINGS_SCHEMA) == 0; + } +#endif if (!schema_found) return; gsettings_client = g_settings_new (GSETTINGS_SCHEMA); diff --git a/test/automated/advice-tests.el b/test/automated/advice-tests.el index f755e8defef..e0c3b40487e 100644 --- a/test/automated/advice-tests.el +++ b/test/automated/advice-tests.el @@ -179,6 +179,29 @@ function being an around advice." (interactive "P") nil) (should (equal (interactive-form 'sm-test9) '(interactive "P")))) +(ert-deftest advice-test-multiples () + (let ((sm-test10 (lambda (a) (+ a 10))) + (sm-advice (lambda (x) (if (consp x) (list (* 5 (car x))) (* 4 x))))) + (should (equal (funcall sm-test10 5) 15)) + (add-function :filter-args (var sm-test10) sm-advice) + (should (equal (funcall sm-test10 5) 35)) + (add-function :filter-return (var sm-test10) sm-advice) + (should (equal (funcall sm-test10 5) 60)) + ;; Make sure we can add multiple times the same function, under the + ;; condition that they have different `name' properties. + (add-function :filter-args (var sm-test10) sm-advice '((name . "args"))) + (should (equal (funcall sm-test10 5) 140)) + (remove-function (var sm-test10) "args") + (should (equal (funcall sm-test10 5) 60)) + (add-function :filter-args (var sm-test10) sm-advice '((name . "args"))) + (add-function :filter-return (var sm-test10) sm-advice '((name . "ret"))) + (should (equal (funcall sm-test10 5) 560)) + ;; Make sure that if we specify to remove a function that was added + ;; multiple times, they are all removed, rather than removing only some + ;; arbitrary subset of them. + (remove-function (var sm-test10) sm-advice) + (should (equal (funcall sm-test10 5) 15)))) + ;; Local Variables: ;; no-byte-compile: t ;; End: diff --git a/test/automated/vc-bzr.el b/test/automated/vc-bzr.el index 07e821064ca..4c16465d54b 100644 --- a/test/automated/vc-bzr.el +++ b/test/automated/vc-bzr.el @@ -33,17 +33,18 @@ (skip-unless (executable-find vc-bzr-program)) ;; Bzr wants to access HOME, e.g. to write ~/.bzr.log. ;; This is a problem on hydra, where HOME is non-existent. - ;; You can disable logging with BZR_LOG=/dev/null, but then - ;; some commands (eg `bzr status') want to access ~/.bazaar, - ;; and will abort if they cannot. I could not figure out how to - ;; stop bzr doing that, so just set HOME to a tempir for the duration. + ;; You can disable logging with BZR_LOG=/dev/null, but then some + ;; commands (eg `bzr status') want to access ~/.bazaar, and will + ;; abort if they cannot. I could not figure out how to stop bzr + ;; doing that, so just give it a temporary homedir for the duration. + ;; http://bugs.launchpad.net/bzr/+bug/137407 ? (let* ((homedir (make-temp-file "vc-bzr-test" t)) (bzrdir (expand-file-name "bzr" homedir)) (ignored-dir (progn (make-directory bzrdir) (expand-file-name "ignored-dir" bzrdir))) (default-directory (file-name-as-directory bzrdir)) - (process-environment (cons (format "HOME=%s" homedir) + (process-environment (cons (format "BZR_HOME=%s" homedir) process-environment))) (unwind-protect (progn @@ -79,7 +80,7 @@ (expand-file-name "subdir" bzrdir))) (file (expand-file-name "file" bzrdir)) (default-directory (file-name-as-directory bzrdir)) - (process-environment (cons (format "HOME=%s" homedir) + (process-environment (cons (format "BZR_HOME=%s" homedir) process-environment))) (unwind-protect (progn @@ -120,7 +121,7 @@ (expand-file-name "foo.el" bzrdir))) (default-directory (file-name-as-directory bzrdir)) (generated-autoload-file (expand-file-name "loaddefs.el" bzrdir)) - (process-environment (cons (format "HOME=%s" homedir) + (process-environment (cons (format "BZR_HOME=%s" homedir) process-environment))) (unwind-protect (progn diff --git a/test/indent/perl.perl b/test/indent/perl.perl index 0bfcc98356b..34cd4af1125 100755 --- a/test/indent/perl.perl +++ b/test/indent/perl.perl @@ -1,6 +1,17 @@ #!/usr/bin/perl # -*- eval: (bug-reference-mode 1) -*- +use v5.14; + +my $str= <