Commit bbbabffe authored by Glenn Morris's avatar Glenn Morris

Merge from emacs-24; up to 2014-05-12T06:15:47Z!rgm@gnu.org

parents ffd6d9c4 96b89471
2014-05-12 Glenn Morris <rgm@gnu.org>
* 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 <eggert@cs.ucla.edu>
* notes/bzr: Update instructions for merging from gnulib.
......
......@@ -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
......
......@@ -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
......
2014-05-12 Stefan Monnier <monnier@iro.umontreal.ca>
* 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 <santiagopim@gmail.com> (tiny change)
* vc/vc-hg.el (vc-hg-unregister): New function. (Bug#17454)
2014-05-12 Glenn Morris <rgm@gnu.org>
* 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 <monnier@iro.umontreal.ca>
* 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 <prumpf@gmail.com> (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 <stephen.berman@gmx.net>
* calendar/todo-mode.el (todo-insert-item-from-calendar):
Correct argument list to conform to todo-insert-item--basic.
2014-05-12 Glenn Morris <rgm@gnu.org>
* 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 <monnier@iro.umontreal.ca>
* 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 <rgm@gnu.org>
......@@ -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 <monnier@iro.umontreal.ca>
......
......@@ -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)
......
......@@ -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)
......
......@@ -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)))))
......
......@@ -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)))
......
......@@ -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 <rgm@gnu.org>
......
......@@ -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
......
2014-05-12 Eric Schulte <eric.schulte@gmx.com>
* 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 <aaronecay@gmail.com>
* org-src.el (org-edit-src-exit): Place an undo boundary before
......@@ -286,7 +292,7 @@
2014-04-22 Justin Gordon <justin.gordon@gmail.com>
* 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.
......@@ -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)
......
......@@ -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 <viniciusjl@ig.com.br>
bug-gnu-emacs@gnu.org and Vinicius Jose Latorre <viniciusjl@ig.com.br>
")
;; This file is part of GNU Emacs.
......
......@@ -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.
......
......@@ -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 <viniciusjl@ig.com.br>.")
bug-gnu-emacs@gnu.org and Vinicius Jose Latorre <viniciusjl@ig.com.br>.")
;; This file is part of GNU Emacs.
......
2014-05-12 Michael Albinus <michael.albinus@gmx.de>
* 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 <rgm@gnu.org>
* url-parse.el (url-generic-parse-url): Doc fix (replace `iff').
......
......@@ -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
......
......@@ -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))
......
2014-05-12 Glenn Morris <rgm@gnu.org>
* fileio.c (Ffile_executable_p): Doc tweak.
2014-05-12 Jan Djärv <jan.h.d@swipnet.se>
* 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 <eggert@cs.ucla.edu>
* minibuf.c (read_minibuf): Avoid C99ism in previous patch (Bug#17430).
......
......@@ -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;
......
......@@ -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);
......
......@@ -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")))