Now on revision 113501. ------------------------------------------------------------ revno: 113501 committer: Paul Eggert branch nick: trunk timestamp: Tue 2013-07-23 07:48:34 +0100 message: Tune UNEVALLED functions by using XCAR instead of Fcar, etc. * data.c (Fsetq_default): * eval.c (Fif, Fcond, Fprog1, Fsetq, Fquote, Ffunction, Fdefvar) (Fdefconst, FletX, Flet, Fwhile, Fcatch, Funwind_protect) (Fcondition_case): Tune by taking advantage of the fact that ARGS is always a list when a function is declared to have UNEVALLED args. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-07-23 06:38:51 +0000 +++ src/ChangeLog 2013-07-23 06:48:34 +0000 @@ -1,5 +1,13 @@ 2013-07-23 Paul Eggert + Tune UNEVALLED functions by using XCAR instead of Fcar, etc. + * data.c (Fsetq_default): + * eval.c (Fif, Fcond, Fprog1, Fsetq, Fquote, Ffunction, Fdefvar) + (Fdefconst, FletX, Flet, Fwhile, Fcatch, Funwind_protect) + (Fcondition_case): + Tune by taking advantage of the fact that ARGS is always a list + when a function is declared to have UNEVALLED args. + * emacsgtkfixed.c: Port to GCC 4.6. GCC 4.6 complains about -Wunused-local-typedefs, introduced in 4.7. === modified file 'src/data.c' --- src/data.c 2013-07-06 08:05:21 +0000 +++ src/data.c 2013-07-23 06:48:34 +0000 @@ -1478,24 +1478,19 @@ usage: (setq-default [VAR VALUE]...) */) (Lisp_Object args) { - register Lisp_Object args_left; - register Lisp_Object val, symbol; + Lisp_Object args_left, symbol, val; struct gcpro gcpro1; - if (NILP (args)) - return Qnil; - - args_left = args; + args_left = val = args; GCPRO1 (args); - do + while (CONSP (args_left)) { - val = eval_sub (Fcar (Fcdr (args_left))); + val = eval_sub (Fcar (XCDR (args_left))); symbol = XCAR (args_left); Fset_default (symbol, val); args_left = Fcdr (XCDR (args_left)); } - while (!NILP (args_left)); UNGCPRO; return val; === modified file 'src/eval.c' --- src/eval.c 2013-07-21 04:22:33 +0000 +++ src/eval.c 2013-07-23 06:48:34 +0000 @@ -393,16 +393,16 @@ usage: (if COND THEN ELSE...) */) (Lisp_Object args) { - register Lisp_Object cond; + Lisp_Object cond; struct gcpro gcpro1; GCPRO1 (args); - cond = eval_sub (Fcar (args)); + cond = eval_sub (XCAR (args)); UNGCPRO; if (!NILP (cond)) - return eval_sub (Fcar (Fcdr (args))); - return Fprogn (Fcdr (Fcdr (args))); + return eval_sub (Fcar (XCDR (args))); + return Fprogn (XCDR (XCDR (args))); } DEFUN ("cond", Fcond, Scond, 0, UNEVALLED, 0, @@ -417,18 +417,17 @@ usage: (cond CLAUSES...) */) (Lisp_Object args) { - register Lisp_Object clause, val; + Lisp_Object val = args; struct gcpro gcpro1; - val = Qnil; GCPRO1 (args); - while (!NILP (args)) + while (CONSP (args)) { - clause = Fcar (args); + Lisp_Object clause = XCAR (args); val = eval_sub (Fcar (clause)); if (!NILP (val)) { - if (!EQ (XCDR (clause), Qnil)) + if (!NILP (XCDR (clause))) val = Fprogn (XCDR (clause)); break; } @@ -476,11 +475,11 @@ (Lisp_Object args) { Lisp_Object val; - register Lisp_Object args_left; + Lisp_Object args_left; struct gcpro gcpro1, gcpro2; args_left = args; - val = Qnil; + val = args; GCPRO2 (args, val); val = eval_sub (XCAR (args_left)); @@ -517,36 +516,37 @@ usage: (setq [SYM VAL]...) */) (Lisp_Object args) { - register Lisp_Object args_left; - register Lisp_Object val, sym, lex_binding; - struct gcpro gcpro1; - - if (NILP (args)) - return Qnil; - - args_left = args; - GCPRO1 (args); - - do + Lisp_Object val, sym, lex_binding; + + val = args; + if (CONSP (args)) { - val = eval_sub (Fcar (Fcdr (args_left))); - sym = Fcar (args_left); - - /* Like for eval_sub, we do not check declared_special here since - it's been done when let-binding. */ - if (!NILP (Vinternal_interpreter_environment) /* Mere optimization! */ - && SYMBOLP (sym) - && !NILP (lex_binding - = Fassq (sym, Vinternal_interpreter_environment))) - XSETCDR (lex_binding, val); /* SYM is lexically bound. */ - else - Fset (sym, val); /* SYM is dynamically bound. */ - - args_left = Fcdr (Fcdr (args_left)); + Lisp_Object args_left = args; + struct gcpro gcpro1; + GCPRO1 (args); + + do + { + val = eval_sub (Fcar (XCDR (args_left))); + sym = XCAR (args_left); + + /* Like for eval_sub, we do not check declared_special here since + it's been done when let-binding. */ + if (!NILP (Vinternal_interpreter_environment) /* Mere optimization! */ + && SYMBOLP (sym) + && !NILP (lex_binding + = Fassq (sym, Vinternal_interpreter_environment))) + XSETCDR (lex_binding, val); /* SYM is lexically bound. */ + else + Fset (sym, val); /* SYM is dynamically bound. */ + + args_left = Fcdr (XCDR (args_left)); + } + while (CONSP (args_left)); + + UNGCPRO; } - while (!NILP (args_left)); - UNGCPRO; return val; } @@ -563,9 +563,9 @@ usage: (quote ARG) */) (Lisp_Object args) { - if (!NILP (Fcdr (args))) + if (CONSP (XCDR (args))) xsignal2 (Qwrong_number_of_arguments, Qquote, Flength (args)); - return Fcar (args); + return XCAR (args); } DEFUN ("function", Ffunction, Sfunction, 1, UNEVALLED, 0, @@ -577,7 +577,7 @@ { Lisp_Object quoted = XCAR (args); - if (!NILP (Fcdr (args))) + if (CONSP (XCDR (args))) xsignal2 (Qwrong_number_of_arguments, Qfunction, Flength (args)); if (!NILP (Vinternal_interpreter_environment) @@ -679,21 +679,23 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) (Lisp_Object args) { - register Lisp_Object sym, tem, tail; - - sym = Fcar (args); - tail = Fcdr (args); - if (!NILP (Fcdr (Fcdr (tail)))) - error ("Too many arguments"); - - tem = Fdefault_boundp (sym); - if (!NILP (tail)) + Lisp_Object sym, tem, tail; + + sym = XCAR (args); + tail = XCDR (args); + + if (CONSP (tail)) { + if (CONSP (XCDR (tail)) && CONSP (XCDR (XCDR (tail)))) + error ("Too many arguments"); + + tem = Fdefault_boundp (sym); + /* Do it before evaluating the initial value, for self-references. */ XSYMBOL (sym)->declared_special = 1; if (NILP (tem)) - Fset_default (sym, eval_sub (Fcar (tail))); + Fset_default (sym, eval_sub (XCAR (tail))); else { /* Check if there is really a global binding rather than just a let binding that shadows the global unboundness of the var. */ @@ -711,7 +713,7 @@ } } } - tail = Fcdr (tail); + tail = XCDR (tail); tem = Fcar (tail); if (!NILP (tem)) { @@ -756,18 +758,18 @@ usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */) (Lisp_Object args) { - register Lisp_Object sym, tem; + Lisp_Object sym, tem; - sym = Fcar (args); - if (!NILP (Fcdr (Fcdr (Fcdr (args))))) + sym = XCAR (args); + if (CONSP (Fcdr (XCDR (XCDR (args))))) error ("Too many arguments"); - tem = eval_sub (Fcar (Fcdr (args))); + tem = eval_sub (Fcar (XCDR (args))); if (!NILP (Vpurify_flag)) tem = Fpurecopy (tem); Fset_default (sym, tem); XSYMBOL (sym)->declared_special = 1; - tem = Fcar (Fcdr (Fcdr (args))); + tem = Fcar (XCDR (XCDR (args))); if (!NILP (tem)) { if (!NILP (Vpurify_flag)) @@ -808,7 +810,7 @@ lexenv = Vinternal_interpreter_environment; - varlist = Fcar (args); + varlist = XCAR (args); while (CONSP (varlist)) { QUIT; @@ -849,7 +851,7 @@ varlist = XCDR (varlist); } UNGCPRO; - val = Fprogn (Fcdr (args)); + val = Fprogn (XCDR (args)); return unbind_to (count, val); } @@ -869,7 +871,7 @@ struct gcpro gcpro1, gcpro2; USE_SAFE_ALLOCA; - varlist = Fcar (args); + varlist = XCAR (args); /* Make space to hold the values to give the bound variables. */ elt = Flength (varlist); @@ -896,7 +898,7 @@ lexenv = Vinternal_interpreter_environment; - varlist = Fcar (args); + varlist = XCAR (args); for (argnum = 0; CONSP (varlist); varlist = XCDR (varlist)) { Lisp_Object var; @@ -919,7 +921,7 @@ /* Instantiate a new lexical environment. */ specbind (Qinternal_interpreter_environment, lexenv); - elt = Fprogn (Fcdr (args)); + elt = Fprogn (XCDR (args)); SAFE_FREE (); return unbind_to (count, elt); } @@ -936,8 +938,8 @@ GCPRO2 (test, body); - test = Fcar (args); - body = Fcdr (args); + test = XCAR (args); + body = XCDR (args); while (!NILP (eval_sub (test))) { QUIT; @@ -1034,9 +1036,9 @@ struct gcpro gcpro1; GCPRO1 (args); - tag = eval_sub (Fcar (args)); + tag = eval_sub (XCAR (args)); UNGCPRO; - return internal_catch (tag, Fprogn, Fcdr (args)); + return internal_catch (tag, Fprogn, XCDR (args)); } /* Set up a catch, then call C function FUNC on argument ARG. @@ -1150,8 +1152,8 @@ Lisp_Object val; ptrdiff_t count = SPECPDL_INDEX (); - record_unwind_protect (unwind_body, Fcdr (args)); - val = eval_sub (Fcar (args)); + record_unwind_protect (unwind_body, XCDR (args)); + val = eval_sub (XCAR (args)); return unbind_to (count, val); } @@ -1183,9 +1185,9 @@ usage: (condition-case VAR BODYFORM &rest HANDLERS) */) (Lisp_Object args) { - Lisp_Object var = Fcar (args); - Lisp_Object bodyform = Fcar (Fcdr (args)); - Lisp_Object handlers = Fcdr (Fcdr (args)); + Lisp_Object var = XCAR (args); + Lisp_Object bodyform = XCAR (XCDR (args)); + Lisp_Object handlers = XCDR (XCDR (args)); return internal_lisp_condition_case (var, bodyform, handlers); } ------------------------------------------------------------ revno: 113500 committer: Paul Eggert branch nick: trunk timestamp: Tue 2013-07-23 07:38:51 +0100 message: * emacsgtkfixed.c: Port to GCC 4.6. GCC 4.6 complains about -Wunused-local-typedefs, introduced in 4.7. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-07-23 01:11:40 +0000 +++ src/ChangeLog 2013-07-23 06:38:51 +0000 @@ -1,3 +1,8 @@ +2013-07-23 Paul Eggert + + * emacsgtkfixed.c: Port to GCC 4.6. + GCC 4.6 complains about -Wunused-local-typedefs, introduced in 4.7. + 2013-07-23 Juanma Barranquero * callproc.c (child_setup)[!WINDOWSNT]: Move exec_errno and pid === modified file 'src/emacsgtkfixed.c' --- src/emacsgtkfixed.c 2013-03-24 12:59:45 +0000 +++ src/emacsgtkfixed.c 2013-07-23 06:38:51 +0000 @@ -28,7 +28,7 @@ #include "xterm.h" /* Silence a bogus diagnostic; see GNOME bug 683906. */ -#if __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 6) +#if 4 < __GNUC__ + (7 <= __GNUC_MINOR__) # pragma GCC diagnostic push # pragma GCC diagnostic ignored "-Wunused-local-typedefs" #endif ------------------------------------------------------------ revno: 113499 committer: Katsumi Yamaoka branch nick: trunk timestamp: Tue 2013-07-23 05:22:20 +0000 message: Calculate gnus-version correctly on Cygwin * gnus.el (gnus-continuum-version): Do main calculations in integers. (gnus-continuum-version-1): New function, return a string. * gnus-msg.el (gnus-extended-version, gnus-bug): Use gnus-continuum-version-1 instead of gnus-continuum-version. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2013-07-19 14:50:21 +0000 +++ lisp/gnus/ChangeLog 2013-07-23 05:22:20 +0000 @@ -1,3 +1,13 @@ +2013-07-23 Katsumi Yamaoka + + Calculate gnus-version correctly on Cygwin. + + * gnus.el (gnus-continuum-version): Do main calculations in integers. + (gnus-continuum-version-1): New function, return a string. + + * gnus-msg.el (gnus-extended-version, gnus-bug): + Use gnus-continuum-version-1 instead of gnus-continuum-version. + 2013-07-19 Geoff Kuenning (tiny change) * gnus-art.el (gnus-treat-predicate): Allow functions as predicates === modified file 'lisp/gnus/gnus-msg.el' --- lisp/gnus/gnus-msg.el 2013-07-06 23:40:56 +0000 +++ lisp/gnus/gnus-msg.el 2013-07-23 05:22:20 +0000 @@ -1132,7 +1132,7 @@ (gnus-v (when (memq 'gnus gnus-user-agent) (concat "Gnus/" - (prin1-to-string (gnus-continuum-version gnus-version) t) + (gnus-continuum-version-1 gnus-version) " (" gnus-version ")"))) (emacs-v (gnus-emacs-version))) (concat gnus-v (when (and gnus-v emacs-v) " ") @@ -1534,7 +1534,7 @@ (X-Debbugs-Package . ,(format "%s" gnus-bug-package)) (X-Debbugs-Version - . ,(format "%s" (gnus-continuum-version)))))) + . ,(gnus-continuum-version-1))))) (when gnus-bug-create-help-buffer (push `(gnus-bug-kill-buffer) message-send-actions)) (goto-char (point-min)) === modified file 'lisp/gnus/gnus.el' --- lisp/gnus/gnus.el 2013-07-10 22:16:03 +0000 +++ lisp/gnus/gnus.el 2013-07-23 05:22:20 +0000 @@ -3229,6 +3229,10 @@ (defun gnus-continuum-version (&optional version) "Return VERSION as a floating point number." + (string-to-number (gnus-continuum-version-1 (or version gnus-version)))) + +(defun gnus-continuum-version-1 (&optional version) + "Return VERSION as a string." (unless version (setq version gnus-version)) (when (or (string-match "^\\([^ ]+\\)? ?Gnus v?\\([0-9.]+\\)$" version) @@ -3244,18 +3248,21 @@ least (if (match-beginning 3) (string-to-number (match-string 3 number)) 0)) - (string-to-number + (gnus-replace-in-string (if (zerop major) - (format "%s00%02d%02d" - (if (member alpha '("(ding)" "d")) - "4.99" - (+ 5 (* 0.02 + (progn + (setq major + (if (member alpha '("(ding)" "d")) + 499 + (+ 500 (* 2 (abs (- (mm-char-int (aref (downcase alpha) 0)) (mm-char-int ?t)))) - -0.01)) - minor least) - (format "%d.%02d%02d" major minor least)))))) + -1))) + (format "%s.%s00%02d%02d" + (/ major 100) (% major 100) minor least)) + (format "%d.%02d%02d" major minor least)) + "0+\\'" "")))) (defun gnus-info-find-node (&optional nodename) "Find Info documentation of Gnus." ------------------------------------------------------------ revno: 113498 committer: Juanma Barranquero branch nick: trunk timestamp: Tue 2013-07-23 03:11:40 +0200 message: src/callproc.c (child_setup): Silence compiler warnings. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-07-22 15:30:54 +0000 +++ src/ChangeLog 2013-07-23 01:11:40 +0000 @@ -1,3 +1,8 @@ +2013-07-23 Juanma Barranquero + + * callproc.c (child_setup)[!WINDOWSNT]: Move exec_errno and pid + here to silence compiler warnings. + 2013-07-22 Paul Eggert * sysdep.c (frame) [__FreeBSD__]: #define to freebsd_frame === modified file 'src/callproc.c' --- src/callproc.c 2013-07-21 06:53:47 +0000 +++ src/callproc.c 2013-07-23 01:11:40 +0000 @@ -1193,14 +1193,15 @@ { char **env; char *pwd_var; - int exec_errno; #ifdef WINDOWSNT int cpid; HANDLE handles[3]; +#else + int exec_errno; + + pid_t pid = getpid (); #endif /* WINDOWSNT */ - pid_t pid = getpid (); - /* Note that use of alloca is always safe here. It's obvious for systems that do not have true vfork or that have true (stack) alloca. If using vfork and C_ALLOCA (when Emacs used to include ------------------------------------------------------------ revno: 113497 committer: Juanma Barranquero branch nick: trunk timestamp: Tue 2013-07-23 03:10:54 +0200 message: lisp/desktop.el: Simplify. (desktop-clear): Simplify; remove useless checks against invalid buffer names. (desktop-list*): Use cl-list*. (desktop-buffer-info, desktop-create-buffer): Simplify. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-07-23 00:58:28 +0000 +++ lisp/ChangeLog 2013-07-23 01:10:54 +0000 @@ -1,3 +1,10 @@ +2013-07-23 Juanma Barranquero + + * desktop.el (desktop-clear): Simplify; remove useless checks + against invalid buffer names. + (desktop-list*): Use cl-list*. + (desktop-buffer-info, desktop-create-buffer): Simplify. + 2013-07-23 Leo Liu * bookmark.el (bookmark-make-record): Restore NAME as a default === modified file 'lisp/desktop.el' --- lisp/desktop.el 2013-07-22 01:25:47 +0000 +++ lisp/desktop.el 2013-07-23 01:10:54 +0000 @@ -644,22 +644,17 @@ (if (symbolp var) (eval `(setq-default ,var nil)) (eval `(setq-default ,(car var) ,(cdr var))))) - (let ((buffers (buffer-list)) - (preserve-regexp (concat "^\\(" + (let ((preserve-regexp (concat "^\\(" (mapconcat (lambda (regexp) (concat "\\(" regexp "\\)")) desktop-clear-preserve-buffers "\\|") "\\)$"))) - (while buffers - (let ((bufname (buffer-name (car buffers)))) - (or - (null bufname) - (string-match-p preserve-regexp bufname) - ;; Don't kill buffers made for internal purposes. - (and (not (equal bufname "")) (eq (aref bufname 0) ?\s)) - (kill-buffer (car buffers)))) - (setq buffers (cdr buffers)))) + (dolist (buffer (buffer-list)) + (let ((bufname (buffer-name buffer))) + (unless (or (eq (aref bufname 0) ?s) ;; Don't kill internal buffers + (string-match-p preserve-regexp bufname)) + (kill-buffer buffer))))) (delete-other-windows)) ;; ---------------------------------------------------------------------------- @@ -696,15 +691,7 @@ ;; ---------------------------------------------------------------------------- (defun desktop-list* (&rest args) - (if (null (cdr args)) - (car args) - (setq args (nreverse args)) - (let ((value (cons (nth 1 args) (car args)))) - (setq args (cdr (cdr args))) - (while args - (setq value (cons (car args) value)) - (setq args (cdr args))) - value))) + (and args (cl-list* args))) ;; ---------------------------------------------------------------------------- (defun desktop-buffer-info (buffer) @@ -736,16 +723,14 @@ (when (functionp desktop-save-buffer) (funcall desktop-save-buffer desktop-dirname)) ;; local variables - (let ((locals desktop-locals-to-save) - (loclist (buffer-local-variables)) - (ll)) - (while locals - (let ((here (assq (car locals) loclist))) - (if here - (setq ll (cons here ll)) - (when (member (car locals) loclist) - (setq ll (cons (car locals) ll))))) - (setq locals (cdr locals))) + (let ((loclist (buffer-local-variables)) + (ll nil)) + (dolist (local desktop-locals-to-save) + (let ((here (assq local loclist))) + (cond (here + (push here ll)) + ((member local loclist) + (push local ll))))) ll))) ;; ---------------------------------------------------------------------------- @@ -1748,17 +1733,15 @@ (set-mark desktop-buffer-mark))) ;; Never override file system if the file really is read-only marked. (when desktop-buffer-read-only (setq buffer-read-only desktop-buffer-read-only)) - (while desktop-buffer-locals - (let ((this (car desktop-buffer-locals))) - (if (consp this) - ;; an entry of this form `(symbol . value)' - (progn - (make-local-variable (car this)) - (set (car this) (cdr this))) - ;; an entry of the form `symbol' - (make-local-variable this) - (makunbound this))) - (setq desktop-buffer-locals (cdr desktop-buffer-locals)))))))) + (dolist (this desktop-buffer-locals) + (if (consp this) + ;; an entry of this form `(symbol . value)' + (progn + (make-local-variable (car this)) + (set (car this) (cdr this))) + ;; an entry of the form `symbol' + (make-local-variable this) + (makunbound this)))))))) ;; ---------------------------------------------------------------------------- ;; Backward compatibility -- update parameters to 205 standards. ------------------------------------------------------------ revno: 113496 fixes bug: http://debbugs.gnu.org/14933 committer: Leo Liu branch nick: trunk timestamp: Tue 2013-07-23 08:58:28 +0800 message: * bookmark.el (bookmark-make-record): Restore NAME as a default value. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-07-22 23:21:14 +0000 +++ lisp/ChangeLog 2013-07-23 00:58:28 +0000 @@ -1,3 +1,8 @@ +2013-07-23 Leo Liu + + * bookmark.el (bookmark-make-record): Restore NAME as a default + value. (Bug#14933) + 2013-07-22 Stefan Monnier * emacs-lisp/autoload.el (autoload--setup-output): New function, === modified file 'lisp/bookmark.el' --- lisp/bookmark.el 2013-05-09 01:40:20 +0000 +++ lisp/bookmark.el 2013-07-23 00:58:28 +0000 @@ -481,19 +481,18 @@ (defun bookmark-make-record () "Return a new bookmark record (NAME . ALIST) for the current location." (let ((record (funcall bookmark-make-record-function))) + ;; Set up default name if the function does not provide one. + (unless (stringp (car record)) + (if (car record) (push nil record)) + (setcar record (or bookmark-current-bookmark (bookmark-buffer-name)))) ;; Set up defaults. (bookmark-prop-set record 'defaults (delq nil (delete-dups (append (bookmark-prop-get record 'defaults) (list bookmark-current-bookmark - (bookmark-buffer-name)))))) - ;; Set up default name. - (if (stringp (car record)) - ;; The function already provided a default name. - record - (if (car record) (push nil record)) - (setcar record (or bookmark-current-bookmark (bookmark-buffer-name))) - record))) + (car record) + (bookmark-buffer-name)))))) + record)) (defun bookmark-store (name alist no-overwrite) "Store the bookmark NAME with data ALIST. ------------------------------------------------------------ revno: 113495 committer: Stefan Monnier branch nick: trunk timestamp: Mon 2013-07-22 19:21:14 -0400 message: * lisp/emacs-lisp/autoload.el (autoload--setup-output): New function, extracted from autoload--insert-text. (autoload--insert-text): Remove. (autoload--print-cookie-text): New function, extracted from autoload--insert-cookie-text. (autoload--insert-cookie-text): Remove. (autoload-generate-file-autoloads): Adjust calls accordingly. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-07-22 22:51:29 +0000 +++ lisp/ChangeLog 2013-07-22 23:21:14 +0000 @@ -1,5 +1,13 @@ 2013-07-22 Stefan Monnier + * emacs-lisp/autoload.el (autoload--setup-output): New function, + extracted from autoload--insert-text. + (autoload--insert-text): Remove. + (autoload--print-cookie-text): New function, extracted from + autoload--insert-cookie-text. + (autoload--insert-cookie-text): Remove. + (autoload-generate-file-autoloads): Adjust calls accordingly. + * winner.el (winner-hook-installed-p): Remove. (winner-mode): Simplify accordingly. === modified file 'lisp/emacs-lisp/autoload.el' --- lisp/emacs-lisp/autoload.el 2013-06-15 15:36:11 +0000 +++ lisp/emacs-lisp/autoload.el 2013-07-22 23:21:14 +0000 @@ -436,33 +436,26 @@ (defvar print-readably) -(defun autoload--insert-text (output-start otherbuf outbuf absfile - load-name printfun) - ;; If not done yet, figure out where to insert this text. - (unless (marker-buffer output-start) - (let ((outbuf - (or (if otherbuf - ;; A file-local setting of - ;; autoload-generated-file says we - ;; should ignore OUTBUF. - nil - outbuf) - (autoload-find-destination absfile load-name) - ;; The file has autoload cookies, but they're - ;; already up-to-date. If OUTFILE is nil, the - ;; entries are in the expected OUTBUF, - ;; otherwise they're elsewhere. - (throw 'done otherbuf)))) - (with-current-buffer outbuf - (move-marker output-start (point) outbuf)))) + +(defun autoload--setup-output (otherbuf outbuf absfile load-name) + (let ((outbuf + (or (if otherbuf + ;; A file-local setting of + ;; autoload-generated-file says we + ;; should ignore OUTBUF. + nil + outbuf) + (autoload-find-destination absfile load-name) + ;; The file has autoload cookies, but they're + ;; already up-to-date. If OUTFILE is nil, the + ;; entries are in the expected OUTBUF, + ;; otherwise they're elsewhere. + (throw 'done otherbuf)))) + (with-current-buffer outbuf + (point-marker)))) + +(defun autoload--print-cookie-text (output-start load-name file) (let ((standard-output (marker-buffer output-start))) - (funcall printfun))) - -(defun autoload--insert-cookie-text (output-start otherbuf outbuf absfile - load-name file) - (autoload--insert-text - output-start otherbuf outbuf absfile load-name - (lambda () (search-forward generate-autoload-cookie) (skip-chars-forward " \t") (if (eolp) @@ -490,7 +483,7 @@ ;; Eat one space. (forward-char 1)) (point)) - (progn (forward-line 1) (point)))))))) + (progn (forward-line 1) (point))))))) (defvar autoload-builtin-package-versions nil) @@ -553,23 +546,25 @@ (setq package (or (lm-header "package") (file-name-sans-extension (file-name-nondirectory file)))) - (setq output-start (make-marker)) - (autoload--insert-text - output-start otherbuf outbuf absfile load-name - (lambda () + (setq output-start (autoload--setup-output + otherbuf outbuf absfile load-name)) + (let ((standard-output (marker-buffer output-start)) + (print-quoted t)) (princ `(push (purecopy ',(cons (intern package) version)) package--builtin-versions)) - (newline)))))) + (newline))))) (goto-char (point-min)) (while (not (eobp)) (skip-chars-forward " \t\n\f") (cond ((looking-at (regexp-quote generate-autoload-cookie)) - (unless output-start (setq output-start (make-marker))) - (autoload--insert-cookie-text - output-start otherbuf outbuf absfile load-name file)) + ;; If not done yet, figure out where to insert this text. + (unless output-start + (setq output-start (autoload--setup-output + otherbuf outbuf absfile load-name))) + (autoload--print-cookie-text output-start load-name file)) ((looking-at ";") ;; Don't read the comment. (forward-line 1)) ------------------------------------------------------------ revno: 113494 committer: Stefan Monnier branch nick: trunk timestamp: Mon 2013-07-22 18:51:29 -0400 message: * lisp/winner.el (winner-hook-installed-p): Remove. (winner-mode): Simplify accordingly. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-07-22 17:24:31 +0000 +++ lisp/ChangeLog 2013-07-22 22:51:29 +0000 @@ -1,5 +1,8 @@ 2013-07-22 Stefan Monnier + * winner.el (winner-hook-installed-p): Remove. + (winner-mode): Simplify accordingly. + * subr.el (add-to-list): Fix compiler-macro when `append' is not constant. Don't use `cl-member' for the base case. === modified file 'lisp/winner.el' --- lisp/winner.el 2013-04-18 13:15:08 +0000 +++ lisp/winner.el 2013-07-22 22:51:29 +0000 @@ -342,31 +342,18 @@ map) "Keymap for Winner mode.") -;; Check if `window-configuration-change-hook' is working. -(defun winner-hook-installed-p () - (save-window-excursion - (let ((winner-var nil) - (window-configuration-change-hook - '((lambda () (setq winner-var t))))) - (split-window) - winner-var))) - ;;;###autoload (define-minor-mode winner-mode nil :global t ; let d-m-m make the doc (if winner-mode (progn - (if (winner-hook-installed-p) - (progn - (add-hook 'window-configuration-change-hook 'winner-change-fun) - (add-hook 'post-command-hook 'winner-save-old-configurations)) - (add-hook 'post-command-hook 'winner-save-conditionally)) + (add-hook 'window-configuration-change-hook 'winner-change-fun) + (add-hook 'post-command-hook 'winner-save-old-configurations) (add-hook 'minibuffer-setup-hook 'winner-save-unconditionally) (setq winner-modified-list (frame-list)) (winner-save-old-configurations)) (remove-hook 'window-configuration-change-hook 'winner-change-fun) (remove-hook 'post-command-hook 'winner-save-old-configurations) - (remove-hook 'post-command-hook 'winner-save-conditionally) (remove-hook 'minibuffer-setup-hook 'winner-save-unconditionally))) ;; Inspired by undo (simple.el) ------------------------------------------------------------ revno: 113493 committer: Stefan Monnier branch nick: trunk timestamp: Mon 2013-07-22 13:24:31 -0400 message: * lisp/subr.el (add-to-list): Fix compiler-macro when `append' is not constant. Don't use `cl-member' for the base case. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-07-22 16:25:32 +0000 +++ lisp/ChangeLog 2013-07-22 17:24:31 +0000 @@ -1,5 +1,8 @@ 2013-07-22 Stefan Monnier + * subr.el (add-to-list): Fix compiler-macro when `append' is + not constant. Don't use `cl-member' for the base case. + * progmodes/subword.el: Fix boundary case (bug#13758). (subword-forward-regexp): Make it a constant. Wrap optional \\W in its own group. === modified file 'lisp/subr.el' --- lisp/subr.el 2013-07-19 12:18:16 +0000 +++ lisp/subr.el 2013-07-22 17:24:31 +0000 @@ -1498,9 +1498,10 @@ ;; FIXME: Something like this could be used for `set' as well. (if (or (not (eq 'quote (car-safe list-var))) (special-variable-p (cadr list-var)) - (and append compare-fn)) + (not (macroexp-const-p append))) exp (let* ((sym (cadr list-var)) + (append (eval append)) (msg (format "`add-to-list' can't use lexical var `%s'; use `push' or `cl-pushnew'" sym)) ;; Big ugly hack so we only output a warning during @@ -1513,13 +1514,17 @@ (when (assq sym byte-compile--lexical-environment) (byte-compile-log-warning msg t :error)))) (code - (if append - (macroexp-let2 macroexp-copyable-p x element - `(unless (member ,x ,sym) - (setq ,sym (append ,sym (list ,x))))) - (require 'cl-lib) - `(cl-pushnew ,element ,sym - :test ,(or compare-fn '#'equal))))) + (macroexp-let2 macroexp-copyable-p x element + `(unless ,(if compare-fn + (progn + (require 'cl-lib) + `(cl-member ,x ,sym :test ,compare-fn)) + ;; For bootstrapping reasons, don't rely on + ;; cl--compiler-macro-member for the base case. + `(member ,x ,sym)) + ,(if append + `(setq ,sym (append ,sym (list ,x))) + `(push ,x ,sym)))))) (if (not (macroexp--compiling-p)) code `(progn ------------------------------------------------------------ revno: 113492 fixes bug: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=13758 committer: Stefan Monnier branch nick: trunk timestamp: Mon 2013-07-22 12:25:32 -0400 message: * lisp/progmodes/subword.el: Fix boundary case. (subword-forward-regexp): Make it a constant. Wrap optional \\W in its own group. (subword-backward-regexp): Make it a constant. (subword-forward-internal): Don't treat a trailing capital as the beginning of a word. * test/automated/subword-tests.el: New file. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-07-22 11:39:32 +0000 +++ lisp/ChangeLog 2013-07-22 16:25:32 +0000 @@ -1,3 +1,12 @@ +2013-07-22 Stefan Monnier + + * progmodes/subword.el: Fix boundary case (bug#13758). + (subword-forward-regexp): Make it a constant. Wrap optional \\W in its + own group. + (subword-backward-regexp): Make it a constant. + (subword-forward-internal): Don't treat a trailing capital as the + beginning of a word. + 2013-07-22 Ari Roponen (tiny change) * emacs-lisp/package.el (package-menu-mode): Don't modify the @@ -10,8 +19,8 @@ (desktop--process-minibuffer-frames): Set desktop-mini parameter only for frames being saved. Rename from desktop--save-minibuffer-frames. (desktop-save-frames): Run hook desktop-before-saving-frames-functions. - Do not save frames with non-nil `desktop-dont-save' parameter. Filter - out deleted frames. + Do not save frames with non-nil `desktop-dont-save' parameter. + Filter out deleted frames. (desktop--find-frame): Use cl-find-if. (desktop--select-frame): Use cl-(first|second|third) to access values of desktop-mini. @@ -352,17 +361,17 @@ * net/tramp.el (tramp-current-connection): New defvar, moved from tramp-sh.el. - (tramp-message-show-progress-reporter-message): Removed, not + (tramp-message-show-progress-reporter-message): Remove, not needed anymore. - (tramp-error-with-buffer): Show message in minibuffer. Discard - input before waiting. Reset connection timestamp. + (tramp-error-with-buffer): Show message in minibuffer. + Discard input before waiting. Reset connection timestamp. (with-tramp-progress-reporter): Improve messages. (tramp-process-actions): Use progress reporter. Delete process in case of error. Improve messages. * net/tramp-sh.el (tramp-barf-if-no-shell-prompt): Use condition-case. Call `tramp-error-with-buffer' with vector and buffer. - (tramp-current-connection): Removed. + (tramp-current-connection): Remove. (tramp-maybe-open-connection): The car of `tramp-current-connection' are the first 3 slots of the vector. === modified file 'lisp/progmodes/subword.el' --- lisp/progmodes/subword.el 2013-05-17 23:18:15 +0000 +++ lisp/progmodes/subword.el 2013-07-22 16:25:32 +0000 @@ -93,11 +93,11 @@ (defvar subword-backward-function 'subword-backward-internal "Function to call for backward subword movement.") -(defvar subword-forward-regexp - "\\W*\\(\\([[:upper:]]*\\W?\\)[[:lower:][:digit:]]*\\)" +(defconst subword-forward-regexp + "\\W*\\(\\([[:upper:]]*\\(\\W\\)?\\)[[:lower:][:digit:]]*\\)" "Regexp used by `subword-forward-internal'.") -(defvar subword-backward-regexp +(defconst subword-backward-regexp "\\(\\(\\W\\|[[:lower:][:digit:]]\\)\\([[:upper:]]+\\W*\\)\\|\\W\\w+\\)" "Regexp used by `subword-backward-internal'.") @@ -319,7 +319,11 @@ (> (match-end 0) (point))) (goto-char (cond - ((< 1 (- (match-end 2) (match-beginning 2))) + ((and (< 1 (- (match-end 2) (match-beginning 2))) + ;; If we have an all-caps word with no following lower-case or + ;; non-word letter, don't leave the last char (bug#13758). + (not (and (null (match-beginning 3)) + (eq (match-end 2) (match-end 1))))) (1- (match-end 2))) (t (match-end 0)))) === modified file 'test/ChangeLog' --- test/ChangeLog 2013-07-13 01:55:58 +0000 +++ test/ChangeLog 2013-07-22 16:25:32 +0000 @@ -1,3 +1,7 @@ +2013-07-22 Stefan Monnier + + * automated/subword-tests.el: New file. + 2013-07-13 Fabián Ezequiel Gallina * automated/python-tests.el (python-imenu-create-index-2) === added file 'test/automated/subword-tests.el' --- test/automated/subword-tests.el 1970-01-01 00:00:00 +0000 +++ test/automated/subword-tests.el 2013-07-22 16:25:32 +0000 @@ -0,0 +1,49 @@ +;;; subword-tests.el --- Testing the subword rules + +;; Copyright (C) 2011-2013 Free Software Foundation, Inc. + +;; Author: Stefan Monnier +;; Keywords: + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; + +;;; Code: + +(require 'ert) + +(defconst subword-tests-strings + '("ABC^" ;;Bug#13758 + "ABC^ ABC^Foo^ ABC^-Foo^ toto^ ABC^")) + +(ert-deftest subword-tests () + "Test the `subword-mode' rules." + (with-temp-buffer + (dolist (str subword-tests-strings) + (erase-buffer) + (insert str) + (goto-char (point-min)) + (while (search-forward "^" nil t) + (replace-match "")) + (goto-char (point-min)) + (while (not (eobp)) + (subword-forward 1) + (insert "^")) + (should (equal (buffer-string) str))))) + +(provide 'subword-tests) +;;; subword-tests.el ends here ------------------------------------------------------------ revno: 113491 fixes bug: http://debbugs.gnu.org/14923 committer: Paul Eggert branch nick: trunk timestamp: Mon 2013-07-22 16:30:54 +0100 message: * sysdep.c (frame) [__FreeBSD__]: #define to freebsd_frame when including , to prevent Sparc/ARM machine/frame.h from messing up Emacs's 'struct frame'. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-07-21 15:56:55 +0000 +++ src/ChangeLog 2013-07-22 15:30:54 +0000 @@ -1,3 +1,9 @@ +2013-07-22 Paul Eggert + + * sysdep.c (frame) [__FreeBSD__]: #define to freebsd_frame + when including , to prevent Sparc/ARM machine/frame.h + from messing up Emacs's 'struct frame' (Bug#14923). + 2013-07-21 Paul Eggert * alloc.c (make_save_ptr_ptr): Define this function. === modified file 'src/sysdep.c' --- src/sysdep.c 2013-07-19 05:36:50 +0000 +++ src/sysdep.c 2013-07-22 15:30:54 +0000 @@ -42,9 +42,14 @@ #endif #ifdef __FreeBSD__ -#include -#include -#include +/* Sparc/ARM machine/frame.h has 'struct frame' which conflicts with Emacs's + 'struct frame', so rename it. */ +# define frame freebsd_frame +# include +# undef frame + +# include +# include #endif #ifdef WINDOWSNT ------------------------------------------------------------ revno: 113490 fixes bug: http://debbugs.gnu.org/14930 author: Ari Roponen committer: Juanma Barranquero branch nick: trunk timestamp: Mon 2013-07-22 13:39:32 +0200 message: lisp/emacs-lisp/package.el (package-menu-mode): Fix bug#14930. Don't modify the global value of tabulated-list-revert-hook. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-07-22 01:25:47 +0000 +++ lisp/ChangeLog 2013-07-22 11:39:32 +0000 @@ -1,3 +1,8 @@ +2013-07-22 Ari Roponen (tiny change) + + * emacs-lisp/package.el (package-menu-mode): Don't modify the + global value of tabulated-list-revert-hook (bug#14930). + 2013-07-22 Juanma Barranquero * desktop.el: Require 'cl-lib. === modified file 'lisp/emacs-lisp/package.el' --- lisp/emacs-lisp/package.el 2013-06-26 00:44:35 +0000 +++ lisp/emacs-lisp/package.el 2013-07-22 11:39:32 +0000 @@ -1393,7 +1393,7 @@ ("Description" 0 nil)]) (setq tabulated-list-padding 2) (setq tabulated-list-sort-key (cons "Status" nil)) - (add-hook 'tabulated-list-revert-hook 'package-menu--refresh) + (add-hook 'tabulated-list-revert-hook 'package-menu--refresh nil t) (tabulated-list-init-header)) (defmacro package--push (pkg-desc status listname) ------------------------------------------------------------ revno: 113489 committer: Glenn Morris branch nick: trunk timestamp: Mon 2013-07-22 06:21:02 -0400 message: Auto-commit of loaddefs files. diff: === modified file 'lisp/dired.el' --- lisp/dired.el 2013-06-21 12:24:37 +0000 +++ lisp/dired.el 2013-07-22 10:21:02 +0000 @@ -4367,7 +4367,7 @@ ;;;*** -;;;### (autoloads nil "dired-x" "dired-x.el" "4b863621846609105c0371f8ffb8c1cf") +;;;### (autoloads nil "dired-x" "dired-x.el" "9bfe6b761cb88b4d3ab78a7905979371") ;;; Generated autoloads from dired-x.el (autoload 'dired-jump "dired-x" "\ ------------------------------------------------------------ revno: 113488 committer: Michael Albinus branch nick: trunk timestamp: Mon 2013-07-22 11:19:00 +0200 message: * files.texi (Magic File Names): Add file-notify-add-watch, file-notify-rm-watch and file-notify-supported-p. Move file-remote-p down. * errors.texi (Standard Errors): Add file-notify-error. * os.texi (Desktop Notifications): Rename from Notifications. (File Notifications): New node. * elisp.texi (Top): Update menu for these changes. diff: === modified file 'doc/lispref/ChangeLog' --- doc/lispref/ChangeLog 2013-07-19 06:31:17 +0000 +++ doc/lispref/ChangeLog 2013-07-22 09:19:00 +0000 @@ -1,3 +1,16 @@ +2013-07-22 Michael Albinus + + * files.texi (Magic File Names): Add file-notify-add-watch, + file-notify-rm-watch and file-notify-supported-p. Move + file-remote-p down. + + * errors.texi (Standard Errors): Add file-notify-error. + + * os.texi (Desktop Notifications): Rename from Notifications. + (File Notifications): New node. + + * elisp.texi (Top): Update menu for these changes. + 2013-07-19 Xue Fuqiao * windows.texi (Display Action Functions): Mention next-window. === modified file 'doc/lispref/elisp.texi' --- doc/lispref/elisp.texi 2013-07-06 01:39:21 +0000 +++ doc/lispref/elisp.texi 2013-07-22 09:19:00 +0000 @@ -1482,7 +1482,8 @@ * Batch Mode:: Running Emacs without terminal interaction. * Session Management:: Saving and restoring state with X Session Management. -* Notifications:: Desktop notifications. +* Desktop Notifications:: Desktop notifications. +* File Notifications:: File notifications. * Dynamic Libraries:: On-demand loading of support libraries. Starting Up Emacs === modified file 'doc/lispref/errors.texi' --- doc/lispref/errors.texi 2013-01-01 09:11:05 +0000 +++ doc/lispref/errors.texi 2013-07-22 09:19:00 +0000 @@ -123,6 +123,11 @@ @item file-supersession This is a subcategory of @code{file-error}. @xref{Modification Time}. +@c filenotify.el +@item file-notify-error +This is a subcategory of @code{file-error}. It happens, when a file +could not be set to be watched for changes. @xref{File Notifications}. + @c net/ange-ftp.el @item ftp-error This is a subcategory of @code{file-error}, which results from === modified file 'doc/lispref/files.texi' --- doc/lispref/files.texi 2013-07-03 03:20:04 +0000 +++ doc/lispref/files.texi 2013-07-22 09:19:00 +0000 @@ -2772,16 +2772,18 @@ @code{file-equal-p}, @code{file-executable-p}, @code{file-exists-p}, @code{file-in-directory-p}, -@code{file-local-copy}, @code{file-remote-p}, +@code{file-local-copy}, @code{file-modes}, @code{file-name-all-completions}, @code{file-name-as-directory}, @code{file-name-completion}, @code{file-name-directory}, @code{file-name-nondirectory}, @code{file-name-sans-versions}, @code{file-newer-than-file-p}, +@code{file-notify-add-watch}, @code{file-notify-rm-watch}, +@code{file-notify-supported-p}, @code{file-ownership-preserved-p}, @code{file-readable-p}, @code{file-regular-p}, -@code{file-selinux-context}, +@code{file-remote-p}, @code{file-selinux-context}, @code{file-symlink-p}, @code{file-truename}, @code{file-writable-p}, @code{find-backup-file-name}, @c Not sure why it was here: @code{find-file-noselect},@* @@ -2820,20 +2822,22 @@ @code{file-accessible-direc@discretionary{}{}{}tory-p}, @code{file-acl}, @code{file-attributes}, -@code{file-direct@discretionary{}{}{}ory-p}, +@code{file-direc@discretionary{}{}{}tory-p}, @code{file-equal-p}, @code{file-executable-p}, @code{file-exists-p}, @code{file-in-directory-p}, -@code{file-local-copy}, @code{file-remote-p}, +@code{file-local-copy}, @code{file-modes}, @code{file-name-all-completions}, @code{file-name-as-directory}, @code{file-name-completion}, @code{file-name-directory}, @code{file-name-nondirec@discretionary{}{}{}tory}, @code{file-name-sans-versions}, @code{file-newer-than-file-p}, +@code{file-notify-add-watch}, @code{file-notify-rm-watch}, +@code{file-notify-supported-p}, @code{file-ownership-pre@discretionary{}{}{}served-p}, @code{file-readable-p}, @code{file-regular-p}, -@code{file-selinux-context}, +@code{file-remote-p}, @code{file-selinux-context}, @code{file-symlink-p}, @code{file-truename}, @code{file-writable-p}, @code{find-backup-file-name}, @c Not sure why it was here: @code{find-file-noselect}, === modified file 'doc/lispref/os.texi' --- doc/lispref/os.texi 2013-01-02 16:13:04 +0000 +++ doc/lispref/os.texi 2013-07-22 09:19:00 +0000 @@ -34,7 +34,8 @@ * X11 Keysyms:: Operating on key symbols for X Windows. * Batch Mode:: Running Emacs without terminal interaction. * Session Management:: Saving and restoring state with X Session Management. -* Notifications:: Desktop notifications. +* Desktop Notifications:: Desktop notifications. +* File Notifications:: File notifications. * Dynamic Libraries:: On-demand loading of support libraries. @end menu @@ -2270,7 +2271,7 @@ @end group @end example -@node Notifications +@node Desktop Notifications @section Desktop Notifications @cindex desktop notifications @@ -2510,6 +2511,163 @@ specification prior to @samp{"1.0"}. @end defun +@node File Notifications +@section Notifications on File Changes +@cindex file notifications + +Several operating systems support watching of filesystems for changes +of files. If configured properly, Emacs links a respective library +like @file{gfilenotify}, @file{inotify}, or @file{w32notify} +statically. These libraries enable watching of filesystems on the +local machine. + +It is also possible to watch filesystems on remote machines, +@pxref{Remote Files,, Remote Files, emacs, The GNU Emacs Manual} +This does not depend on one of the libraries linked to Emacs. + +Since all these libraries emit different events on notified file +changes, there is the Emacs library @code{filenotify} which provides a +unique interface. + +@defun file-notify-supported-p file +This function returns non-nil if the filesystem pertaining to +@var{file} could be watched. This means, that Emacs is linked with a +respective library (for local files), or Emacs has found an applicable +file notification process on a remote machine. + +Sometimes, mounted filesystems cannot be watched for file changes. +This is not detected by this function, a non-@code{nil} return value +does not guarantee that changes on @var{file} will be notified. +@end defun + +@defun file-notify-add-watch file flags callback +Add a watch for filesystem events pertaining to @var{file}. This +arranges for filesystem events pertaining to @var{file} to be reported +to Emacs. + +The returned value is a descriptor for the added watch. Its type +depends on the underlying library, it cannot be assumed to be an +integer as in the example below. It should be used for comparison by +@code{equal} only. + +If the @var{file} cannot be watched for some reason, this function +signals a @code{file-notify-error} error. + +@var{flags} is a list of conditions to set what will be watched for. +It can include the following symbols: + +@table @code +@item change +watch for file changes +@item attribute-change +watch for file attribute changes, like permissions or modification +time +@end table + +If @var{file} is a directory, changes for all files in that directory +will be notified. This does not work recursively. + +When any event happens, Emacs will call the @var{callback} function +passing it a single argument @var{event}, which is of the form + +@lisp +(@var{descriptor} @var{action} @var{file} [@var{file1}]) +@end lisp + +@var{descriptor} is the same object as the one returned by this +function. @var{action} is the description of the event. It could be +any one of the following symbols: + +@table @code +@item created +@var{file} was created +@item deleted +@var{file} was deleted +@item changed +@var{file} has changed +@item renamed +@var{file} has been renamed to @var{file1} +@item attribute-changed +a @var{file} attribute was changed +@end table + +@var{file} and @var{file1} are the name of the file(s) whose event is +being reported. For example: + +@example +@group +(require 'filenotify) + @result{} filenotify +@end group + +@group +(defun my-notify-callback (event) + (message "Event %S" event)) + @result{} my-notify-callback +@end group + +@group +(file-notify-add-watch + "/tmp" '(change attribute-change) 'my-notify-callback) + @result{} 35025468 +@end group + +@group +(write-region "foo" nil "/tmp/foo") + @result{} Event (35025468 created "/tmp/.#foo") + Event (35025468 created "/tmp/foo") + Event (35025468 changed "/tmp/foo") + Event (35025468 deleted "/tmp/.#foo") +@end group + +@group +(write-region "bla" nil "/tmp/foo") + @result{} Event (35025468 created "/tmp/.#foo") + Event (35025468 changed "/tmp/foo") [2 times] + Event (35025468 deleted "/tmp/.#foo") +@end group + +@group +(set-file-modes "/tmp/foo" (default-file-modes)) + @result{} Event (35025468 attribute-changed "/tmp/foo") +@end group +@end example + +Whether the action @code{renamed} is returned, depends on the used +watch library. It can be expected, when a directory is watched, and +both @var{file} and @var{file1} belong to this directory. Otherwise, +the actions @code{deleted} and @code{created} could be returned in a +random order. + +@example +@group +(rename-file "/tmp/foo" "/tmp/bla") + @result{} Event (35025468 renamed "/tmp/foo" "/tmp/bla") +@end group + +@group +(file-notify-add-watch + "/var/tmp" '(change attribute-change) 'my-notify-callback) + @result{} 35025504 +@end group + +@group +(rename-file "/tmp/bla" "/var/tmp/bla") + @result{} ;; gfilenotify + Event (35025468 renamed "/tmp/bla" "/var/tmp/bla") + + @result{} ;; inotify + Event (35025504 created "/var/tmp/bla") + Event (35025468 deleted "/tmp/bla") +@end group +@end example +@end defun + +@defun file-notify-rm-watch descriptor +Removes an existing file watch specified by its @var{descriptor}. +@var{descriptor} should be an object returned by +@code{file-notify-add-watch}. +@end defun @node Dynamic Libraries @section Dynamically Loaded Libraries ------------------------------------------------------------ revno: 113487 committer: Michael Albinus branch nick: trunk timestamp: Mon 2013-07-22 11:17:21 +0200 message: Fix typo. diff: === modified file 'etc/NEWS' --- etc/NEWS 2013-07-19 12:18:16 +0000 +++ etc/NEWS 2013-07-22 09:17:21 +0000 @@ -483,7 +483,8 @@ - advice-add/advice-remove to add/remove a piece of advice on a named function, much like `defadvice' does. -** The package file-notify.el provides an interface for file system ++++ +** The package filenotify.el provides an interface for file system notifications. It requires, that Emacs is compiled with one of the low-level libraries gfilenotify.c, inotify.c or w32notify.c. ------------------------------------------------------------ revno: 113486 committer: Stefan Monnier branch nick: trunk timestamp: Mon 2013-07-22 00:06:21 -0400 message: * lisp/url/url-http.el (status): Remove, unused. (success): Remove var. (url-http-handle-authentication): Return the value that `success' should take instead of setting `success' directly. Don't set `status' since it's not used. (url-http-parse-headers): Avoid unneeded setq. Move the `setq success'. (url-http): Use pcase. (url-http-file-exists-p): Simplify. diff: === modified file 'lisp/url/ChangeLog' --- lisp/url/ChangeLog 2013-06-26 16:54:48 +0000 +++ lisp/url/ChangeLog 2013-07-22 04:06:21 +0000 @@ -1,3 +1,15 @@ +2013-07-22 Stefan Monnier + + * url-http.el (status): Remove, unused. + (success): Remove var. + (url-http-handle-authentication): Return the value that `success' + should take instead of setting `success' directly. Don't set `status' + since it's not used. + (url-http-parse-headers): Avoid unneeded setq. + Move the `setq success'. + (url-http): Use pcase. + (url-http-file-exists-p): Simplify. + 2013-06-26 Lars Magne Ingebrigtsen * url-cookie.el: Implement a command and mode for displaying and === modified file 'lisp/url/url-http.el' --- lisp/url/url-http.el 2013-02-16 02:05:32 +0000 +++ lisp/url/url-http.el 2013-07-22 04:06:21 +0000 @@ -375,9 +375,6 @@ (replace-match "")) (- end url-http-end-of-headers))) -(defvar status) -(defvar success) - (defun url-http-handle-authentication (proxy) (url-http-debug "Handling %s authentication" (if proxy "proxy" "normal")) (let ((auths (or (nreverse @@ -404,9 +401,9 @@ (url-strip-leading-spaces this-auth))) (let* ((this-type - (if (string-match "[ \t]" this-auth) - (downcase (substring this-auth 0 (match-beginning 0))) - (downcase this-auth))) + (downcase (if (string-match "[ \t]" this-auth) + (substring this-auth 0 (match-beginning 0)) + this-auth))) (registered (url-auth-registered this-type)) (this-strength (cddr registered))) (when (and registered (> this-strength strength)) @@ -421,20 +418,26 @@ (insert "
Sorry, but I do not know how to handle " type " authentication. If you'd like to write it," " send it to " url-bug-address ".
") - (setq status t)) + ;; We used to set a `status' var (declared "special") but I can't + ;; find the corresponding let-binding, so it's probably an error. + ;; FIXME: Maybe it was supposed to set `success', i.e. to return t? + ;; (setq status t) + nil) ;; Not success yet. + (let* ((args (url-parse-args (subst-char-in-string ?, ?\; auth))) (auth (url-get-authentication auth-url (cdr-safe (assoc "realm" args)) type t args))) (if (not auth) - (setq success t) + t ;Success. (push (cons (if proxy "Proxy-Authorization" "Authorization") auth) url-http-extra-headers) (let ((url-request-method url-http-method) (url-request-data url-http-data) (url-request-extra-headers url-http-extra-headers)) (url-retrieve-internal url url-callback-function - url-callback-arguments))))))) + url-callback-arguments)) + nil))))) ;; Not success yet. (defun url-http-parse-response () "Parse just the response code." @@ -498,12 +501,11 @@ (when (and connection (string= (downcase connection) "close")) (delete-process url-http-process))))) - (let ((buffer (current-buffer)) - (class nil) - (success nil) - ;; other status symbols: jewelry and luxury cars - (status-symbol (cadr (assq url-http-response-status url-http-codes)))) - (setq class (/ url-http-response-status 100)) + (let* ((buffer (current-buffer)) + (class (/ url-http-response-status 100)) + (success nil) + ;; other status symbols: jewelry and luxury cars + (status-symbol (cadr (assq url-http-response-status url-http-codes)))) (url-http-debug "Parsed HTTP headers: class=%d status=%d" class url-http-response-status) (when (url-use-cookies url-http-target-url) @@ -536,15 +538,14 @@ (pcase status-symbol ((or `no-content `reset-content) ;; No new data, just stay at the same document - (url-mark-buffer-as-dead buffer) - (setq success t)) + (url-mark-buffer-as-dead buffer)) (_ ;; Generic success for all others. Store in the cache, and ;; mark it as successful. (widen) (if (and url-automatic-caching (equal url-http-method "GET")) - (url-store-in-cache buffer)) - (setq success t)))) + (url-store-in-cache buffer)))) + (setq success t)) (3 ; Redirection ;; 300 Multiple choices ;; 301 Moved permanently @@ -684,106 +685,107 @@ ;; 422 Unprocessable Entity (Added by DAV) ;; 423 Locked ;; 424 Failed Dependency - (pcase status-symbol - (`unauthorized ; 401 - ;; The request requires user authentication. The response - ;; MUST include a WWW-Authenticate header field containing a - ;; challenge applicable to the requested resource. The - ;; client MAY repeat the request with a suitable - ;; Authorization header field. - (url-http-handle-authentication nil)) - (`payment-required ; 402 - ;; This code is reserved for future use - (url-mark-buffer-as-dead buffer) - (error "Somebody wants you to give them money")) - (`forbidden ; 403 - ;; The server understood the request, but is refusing to - ;; fulfill it. Authorization will not help and the request - ;; SHOULD NOT be repeated. - (setq success t)) - (`not-found ; 404 - ;; Not found - (setq success t)) - (`method-not-allowed ; 405 - ;; The method specified in the Request-Line is not allowed - ;; for the resource identified by the Request-URI. The - ;; response MUST include an Allow header containing a list of - ;; valid methods for the requested resource. - (setq success t)) - (`not-acceptable ; 406 - ;; The resource identified by the request is only capable of - ;; generating response entities which have content - ;; characteristics not acceptable according to the accept - ;; headers sent in the request. - (setq success t)) - (`proxy-authentication-required ; 407 - ;; This code is similar to 401 (Unauthorized), but indicates - ;; that the client must first authenticate itself with the - ;; proxy. The proxy MUST return a Proxy-Authenticate header - ;; field containing a challenge applicable to the proxy for - ;; the requested resource. - (url-http-handle-authentication t)) - (`request-timeout ; 408 - ;; The client did not produce a request within the time that - ;; the server was prepared to wait. The client MAY repeat - ;; the request without modifications at any later time. - (setq success t)) - (`conflict ; 409 - ;; The request could not be completed due to a conflict with - ;; the current state of the resource. This code is only - ;; allowed in situations where it is expected that the user - ;; might be able to resolve the conflict and resubmit the - ;; request. The response body SHOULD include enough - ;; information for the user to recognize the source of the - ;; conflict. - (setq success t)) - (`gone ; 410 - ;; The requested resource is no longer available at the - ;; server and no forwarding address is known. - (setq success t)) - (`length-required ; 411 - ;; The server refuses to accept the request without a defined - ;; Content-Length. The client MAY repeat the request if it - ;; adds a valid Content-Length header field containing the - ;; length of the message-body in the request message. - ;; - ;; NOTE - this will never happen because - ;; `url-http-create-request' automatically calculates the - ;; content-length. - (setq success t)) - (`precondition-failed ; 412 - ;; The precondition given in one or more of the - ;; request-header fields evaluated to false when it was - ;; tested on the server. - (setq success t)) - ((or `request-entity-too-large `request-uri-too-large) ; 413 414 - ;; The server is refusing to process a request because the - ;; request entity|URI is larger than the server is willing or - ;; able to process. - (setq success t)) - (`unsupported-media-type ; 415 - ;; The server is refusing to service the request because the - ;; entity of the request is in a format not supported by the - ;; requested resource for the requested method. - (setq success t)) - (`requested-range-not-satisfiable ; 416 - ;; A server SHOULD return a response with this status code if - ;; a request included a Range request-header field, and none - ;; of the range-specifier values in this field overlap the - ;; current extent of the selected resource, and the request - ;; did not include an If-Range request-header field. - (setq success t)) - (`expectation-failed ; 417 - ;; The expectation given in an Expect request-header field - ;; could not be met by this server, or, if the server is a - ;; proxy, the server has unambiguous evidence that the - ;; request could not be met by the next-hop server. - (setq success t)) - (_ - ;; The request could not be understood by the server due to - ;; malformed syntax. The client SHOULD NOT repeat the - ;; request without modifications. - (setq success t))) + (setq success + (pcase status-symbol + (`unauthorized ; 401 + ;; The request requires user authentication. The response + ;; MUST include a WWW-Authenticate header field containing a + ;; challenge applicable to the requested resource. The + ;; client MAY repeat the request with a suitable + ;; Authorization header field. + (url-http-handle-authentication nil)) + (`payment-required ; 402 + ;; This code is reserved for future use + (url-mark-buffer-as-dead buffer) + (error "Somebody wants you to give them money")) + (`forbidden ; 403 + ;; The server understood the request, but is refusing to + ;; fulfill it. Authorization will not help and the request + ;; SHOULD NOT be repeated. + t) + (`not-found ; 404 + ;; Not found + t) + (`method-not-allowed ; 405 + ;; The method specified in the Request-Line is not allowed + ;; for the resource identified by the Request-URI. The + ;; response MUST include an Allow header containing a list of + ;; valid methods for the requested resource. + t) + (`not-acceptable ; 406 + ;; The resource identified by the request is only capable of + ;; generating response entities which have content + ;; characteristics not acceptable according to the accept + ;; headers sent in the request. + t) + (`proxy-authentication-required ; 407 + ;; This code is similar to 401 (Unauthorized), but indicates + ;; that the client must first authenticate itself with the + ;; proxy. The proxy MUST return a Proxy-Authenticate header + ;; field containing a challenge applicable to the proxy for + ;; the requested resource. + (url-http-handle-authentication t)) + (`request-timeout ; 408 + ;; The client did not produce a request within the time that + ;; the server was prepared to wait. The client MAY repeat + ;; the request without modifications at any later time. + t) + (`conflict ; 409 + ;; The request could not be completed due to a conflict with + ;; the current state of the resource. This code is only + ;; allowed in situations where it is expected that the user + ;; might be able to resolve the conflict and resubmit the + ;; request. The response body SHOULD include enough + ;; information for the user to recognize the source of the + ;; conflict. + t) + (`gone ; 410 + ;; The requested resource is no longer available at the + ;; server and no forwarding address is known. + t) + (`length-required ; 411 + ;; The server refuses to accept the request without a defined + ;; Content-Length. The client MAY repeat the request if it + ;; adds a valid Content-Length header field containing the + ;; length of the message-body in the request message. + ;; + ;; NOTE - this will never happen because + ;; `url-http-create-request' automatically calculates the + ;; content-length. + t) + (`precondition-failed ; 412 + ;; The precondition given in one or more of the + ;; request-header fields evaluated to false when it was + ;; tested on the server. + t) + ((or `request-entity-too-large `request-uri-too-large) ; 413 414 + ;; The server is refusing to process a request because the + ;; request entity|URI is larger than the server is willing or + ;; able to process. + t) + (`unsupported-media-type ; 415 + ;; The server is refusing to service the request because the + ;; entity of the request is in a format not supported by the + ;; requested resource for the requested method. + t) + (`requested-range-not-satisfiable ; 416 + ;; A server SHOULD return a response with this status code if + ;; a request included a Range request-header field, and none + ;; of the range-specifier values in this field overlap the + ;; current extent of the selected resource, and the request + ;; did not include an If-Range request-header field. + t) + (`expectation-failed ; 417 + ;; The expectation given in an Expect request-header field + ;; could not be met by this server, or, if the server is a + ;; proxy, the server has unambiguous evidence that the + ;; request could not be met by the next-hop server. + t) + (_ + ;; The request could not be understood by the server due to + ;; malformed syntax. The client SHOULD NOT repeat the + ;; request without modifications. + t))) ;; Tell the callback that an error occurred, and what the ;; status code was. (when success @@ -1222,18 +1224,17 @@ (set-process-buffer connection buffer) (set-process-filter connection 'url-http-generic-filter) - (let ((status (process-status connection))) - (cond - ((eq status 'connect) - ;; Asynchronous connection - (set-process-sentinel connection 'url-http-async-sentinel)) - ((eq status 'failed) - ;; Asynchronous connection failed - (error "Could not create connection to %s:%d" host port)) - (t - (set-process-sentinel connection - 'url-http-end-of-document-sentinel) - (process-send-string connection (url-http-create-request))))))) + (pcase (process-status connection) + (`connect + ;; Asynchronous connection + (set-process-sentinel connection 'url-http-async-sentinel)) + (`failed + ;; Asynchronous connection failed + (error "Could not create connection to %s:%d" host port)) + (_ + (set-process-sentinel connection + 'url-http-end-of-document-sentinel) + (process-send-string connection (url-http-create-request)))))) buffer)) (defun url-http-async-sentinel (proc why) @@ -1302,17 +1303,14 @@ (url-retrieve-synchronously url))) (defun url-http-file-exists-p (url) - (let ((status nil) - (exists nil) - (buffer (url-http-head url))) - (if (not buffer) - (setq exists nil) - (setq status (url-http-symbol-value-in-buffer 'url-http-response-status - buffer 500) - exists (and (integerp status) - (>= status 200) (< status 300))) - (kill-buffer buffer)) - exists)) + (let ((buffer (url-http-head url))) + (when buffer + (let ((status (url-http-symbol-value-in-buffer 'url-http-response-status + buffer 500))) + (prog1 + (and (integerp status) + (>= status 200) (< status 300)) + (kill-buffer buffer)))))) (defalias 'url-http-file-readable-p 'url-http-file-exists-p)