commit ffec11d9b47d71978fbfc26fe37d936037f2dfac (HEAD, refs/remotes/origin/master) Author: Martin Rudalics Date: Sat Feb 14 18:50:37 2015 +0100 Fix doc-string of x_frame_normalize_before_maximize. * xterm.c (x_frame_normalize_before_maximize): Fix doc-string. Suggested by Alan Mackenzie . diff --git a/src/ChangeLog b/src/ChangeLog index 5144738..c89fa60 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2015-02-14 Martin Rudalics + + * xterm.c (x_frame_normalize_before_maximize): Fix doc-string. + Suggested by Alan Mackenzie . + 2015-02-14 Eli Zaretskii * menu.c (Fx_popup_menu) [HAVE_X_WINDOWS]: Call diff --git a/src/xterm.c b/src/xterm.c index 0b3efe7..03c0811 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -11729,9 +11729,11 @@ default is nil, which is the same as `super'. */); DEFVAR_BOOL ("x-frame-normalize-before-maximize", x_frame_normalize_before_maximize, doc: /* Non-nil means normalize frame before maximizing. -If this variable is t, Emacs asks the window manager to give the frame -intermediately its normal size whenever changing from a full-height or -full-width state to the fully maximized one and vice versa. +If this variable is t, Emacs first asks the window manager to give the +frame its normal size, and only then the final state, whenever changing +from a full-height, full-width or full-both state to the maximized one +or when changing from the maximized to the full-height or full-width +state. Set this variable only if your window manager cannot handle the transition between the various maximization states. */); commit f4f4f93e42a0ae572a62c9f64b90e4401232d9f4 Author: Artur Malabarba Date: Sat Feb 14 15:06:27 2015 -0200 emacs-lisp/package.el (describe-package-1): Describe incompatibility. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 42b386f..3cc42a5 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -5,6 +5,7 @@ (package-refresh-contents, package-initialize): Do build the compatibility table. (package--build-compatibility-table): New function. + (describe-package-1): Describe why a package is incompatible. 2015-02-14 Stefan Monnier diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 64a646a..d8a4fc9 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1817,8 +1817,9 @@ the table." (built-in (eq pkg-dir 'builtin)) (installable (and archive (not built-in))) (status (if desc (package-desc-status desc) "orphan")) + (incompatible-reason (package--incompatible-p desc)) (signed (if desc (package-desc-signed desc)))) - (when (string= status "incompat") + (when incompatible-reason (setq status "incompatible")) (prin1 name) (princ " is ") @@ -1850,6 +1851,12 @@ the table." (if signed (insert ".") (insert " (unsigned)."))) + (incompatible-reason + (insert (propertize "Incompatible" 'face font-lock-warning-face) + " because it depends on ") + (if (stringp incompatible-reason) + (insert "Emacs " incompatible-reason ".") + (insert "uninstallable packages."))) (installable (insert (capitalize status)) (insert " from " (format "%s" archive)) @@ -1870,19 +1877,22 @@ the table." (setq reqs (if desc (package-desc-reqs desc))) (when reqs (insert " " (propertize "Requires" 'font-lock-face 'bold) ": ") - (let ((first t) - name vers text) + (let ((first t)) (dolist (req reqs) - (setq name (car req) - vers (cadr req) - text (format "%s-%s" (symbol-name name) - (package-version-join vers))) - (cond (first (setq first nil)) - ((>= (+ 2 (current-column) (length text)) - (window-width)) - (insert ",\n ")) - (t (insert ", "))) - (help-insert-xref-button text 'help-package name)) + (let* ((name (car req)) + (vers (cadr req)) + (text (format "%s-%s" (symbol-name name) + (package-version-join vers))) + (reason (if (and (listp incompatible-reason) + (assq name incompatible-reason)) + " (not available)" ""))) + (cond (first (setq first nil)) + ((>= (+ 2 (current-column) (length text) (length reason)) + (window-width)) + (insert ",\n ")) + (t (insert ", "))) + (help-insert-xref-button text 'help-package name) + (insert reason))) (insert "\n"))) (insert " " (propertize "Summary" 'font-lock-face 'bold) ": " (if desc (package-desc-summary desc)) "\n") commit 93888585deba41f7f67a83cda2c69927ffb130c8 Author: Eli Zaretskii Date: Sat Feb 14 15:11:30 2015 +0200 Fix assertion violations when popping menus on TTY (Bug#19862) src/menu.c (Fx_popup_menu) [HAVE_X_WINDOWS]: Call x_relative_mouse_position only for X frames. diff --git a/src/ChangeLog b/src/ChangeLog index 6d246fb..5144738 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2015-02-14 Eli Zaretskii + + * menu.c (Fx_popup_menu) [HAVE_X_WINDOWS]: Call + x_relative_mouse_position only for X frames. (Bug#19862) + 2015-02-13 Paul Eggert Better support for future plugins diff --git a/src/menu.c b/src/menu.c index 5a8ea34..e925f29 100644 --- a/src/menu.c +++ b/src/menu.c @@ -1243,35 +1243,39 @@ no quit occurs and `x-popup-menu' returns nil. */) /* Use the mouse's current position. */ struct frame *new_f = SELECTED_FRAME (); #ifdef HAVE_X_WINDOWS - /* Can't use mouse_position_hook for X since it returns - coordinates relative to the window the mouse is in, - we need coordinates relative to the edit widget always. */ - if (new_f != 0) + if (FRAME_X_P (new_f)) { - int cur_x, cur_y; - - x_relative_mouse_position (new_f, &cur_x, &cur_y); - /* cur_x/y may be negative, so use make_number. */ - x = make_number (cur_x); - y = make_number (cur_y); + /* Can't use mouse_position_hook for X since it returns + coordinates relative to the window the mouse is in, + we need coordinates relative to the edit widget always. */ + if (new_f != 0) + { + int cur_x, cur_y; + + x_relative_mouse_position (new_f, &cur_x, &cur_y); + /* cur_x/y may be negative, so use make_number. */ + x = make_number (cur_x); + y = make_number (cur_y); + } + } + else +#endif /* HAVE_X_WINDOWS */ + { + Lisp_Object bar_window; + enum scroll_bar_part part; + Time time; + void (*mouse_position_hook) (struct frame **, int, + Lisp_Object *, + enum scroll_bar_part *, + Lisp_Object *, + Lisp_Object *, + Time *) = + FRAME_TERMINAL (new_f)->mouse_position_hook; + + if (mouse_position_hook) + (*mouse_position_hook) (&new_f, 1, &bar_window, + &part, &x, &y, &time); } - -#else /* not HAVE_X_WINDOWS */ - Lisp_Object bar_window; - enum scroll_bar_part part; - Time time; - void (*mouse_position_hook) (struct frame **, int, - Lisp_Object *, - enum scroll_bar_part *, - Lisp_Object *, - Lisp_Object *, - Time *) = - FRAME_TERMINAL (new_f)->mouse_position_hook; - - if (mouse_position_hook) - (*mouse_position_hook) (&new_f, 1, &bar_window, - &part, &x, &y, &time); -#endif /* not HAVE_X_WINDOWS */ if (new_f != 0) XSETFRAME (window, new_f); commit 34c75359126e78367e4542a39b4b687c8955e1c6 Author: Artur Malabarba Date: Sat Feb 14 11:13:29 2015 -0200 emacs-lisp/package.el: Move the compatibility-table building logic. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 24cf80a..42b386f 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,11 @@ +2015-02-14 Artur Malabarba + + * emacs-lisp/package.el (package-read-all-archive-contents): Don't + build the compatibility table. + (package-refresh-contents, package-initialize): Do build the + compatibility table. + (package--build-compatibility-table): New function. + 2015-02-14 Stefan Monnier * emacs-lisp/cl-preloaded.el (cl-struct-define): Register as children diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index d8b4595..64a646a 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1144,10 +1144,7 @@ Will throw an error if the archive version is too new." If successful, set `package-archive-contents'." (setq package-archive-contents nil) (dolist (archive package-archives) - (package-read-archive-contents (car archive))) - ;; Build compat table. - (setq package--compatibility-table (make-hash-table :test 'eq)) - (package--mapc #'package--add-to-compatibility-table)) + (package-read-archive-contents (car archive)))) (defun package-read-archive-contents (archive) "Re-read archive contents for ARCHIVE. @@ -1691,6 +1688,12 @@ similar to an entry in `package-alist'. Save the cached copy to (epg-import-keys-from-file context file) (message "Importing %s...done" (file-name-nondirectory file)))) +(defun package--build-compatibility-table () + "Build `package--compatibility-table' with `package--mapc'." + ;; Build compat table. + (setq package--compatibility-table (make-hash-table :test 'eq)) + (package--mapc #'package--add-to-compatibility-table)) + ;;;###autoload (defun package-refresh-contents () "Download the ELPA archive description if needed. @@ -1713,7 +1716,8 @@ makes them available for download." (package--download-one-archive archive "archive-contents") (error (message "Failed to download `%s' archive." (car archive))))) - (package-read-all-archive-contents)) + (package-read-all-archive-contents) + (package--build-compatibility-table)) (defun package--find-non-dependencies () "Return a list of installed packages which are not dependencies. @@ -1742,7 +1746,10 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." (unless no-activate (dolist (elt package-alist) (package-activate (car elt)))) - (setq package--initialized t)) + (setq package--initialized t) + ;; This uses `package--mapc' so it must be called after + ;; `package--initialized' is t. + (package--build-compatibility-table)) (defun package--add-to-compatibility-table (pkg) "If PKG is compatible (without dependencies), add to the compatibility table. commit 61b4c22c6eba96718327a0d208a8492d8bad76e0 Author: Stefan Monnier Date: Sat Feb 14 00:46:29 2015 -0500 * lisp/emacs-lisp/cl*.el: Use define-inline and move some code * lisp/emacs-lisp/cl-lib.el: Move autoloaded code to cl-preload. * lisp/emacs-lisp/cl-preloaded.el (cl-struct-define): Register as children of the parent. (cl--assertion-failed): New function. (cl-assertion-failed): Move in from cl-lib.el. * lisp/emacs-lisp/cl-macs.el (cl-defstruct): Don't generate code to register as children of its parents. (cl--make-type-test, cl--compiler-macro-typep): Remove functions. (cl-typep): Reimplement using define-inline. (cl-assert): Use cl--assertion-failed. (cl-struct-slot-value): Use define-inline. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 257b11b..24cf80a 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,19 @@ 2015-02-14 Stefan Monnier + * emacs-lisp/cl-preloaded.el (cl-struct-define): Register as children + of the parent. + (cl--assertion-failed): New function. + (cl-assertion-failed): Move in from cl-lib.el. + + * emacs-lisp/cl-macs.el (cl-defstruct): Don't generate code to register + as children of its parents. + (cl--make-type-test, cl--compiler-macro-typep): Remove functions. + (cl-typep): Reimplement using define-inline. + (cl-assert): Use cl--assertion-failed. + (cl-struct-slot-value): Use define-inline. + + * emacs-lisp/cl-lib.el: Move autoloaded code to cl-preload. + * textmodes/flyspell.el (flyspell-word): Defvar (bug#19844). (flyspell-generic-check-word-p): Mark as obsolete. diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index 0f53418..4b12495 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -731,22 +731,6 @@ If ALIST is non-nil, the new pairs are prepended to it." ;;; Miscellaneous. -;;;###autoload -(progn - ;; The `assert' macro from the cl package signals - ;; `cl-assertion-failed' at runtime so always define it. - (define-error 'cl-assertion-failed (purecopy "Assertion failed")) - ;; Make sure functions defined with cl-defsubst can be inlined even in - ;; packages which do not require CL. We don't put an autoload cookie - ;; directly on that function, since those cookies only go to cl-loaddefs. - (autoload 'cl--defsubst-expand "cl-macs") - ;; Autoload, so autoload.el and font-lock can use it even when CL - ;; is not loaded. - (put 'cl-defun 'doc-string-elt 3) - (put 'cl-defmacro 'doc-string-elt 3) - (put 'cl-defsubst 'doc-string-elt 3) - (put 'cl-defstruct 'doc-string-elt 2)) - (provide 'cl-lib) (or (load "cl-loaddefs" 'noerror 'quiet) ;; When bootstrapping, cl-loaddefs hasn't been built yet! diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index eaec2c5..2861d66 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2488,13 +2488,7 @@ non-nil value, that slot cannot be set via `setf'. (setq descs (append old-descs (delq (assq 'cl-tag-slot descs) descs)) type (car inc-type) named (assq 'cl-tag-slot descs)) - (if (cadr inc-type) (setq tag name named t)) - (let ((incl include)) - (while incl - (push `(cl-pushnew ',tag - ,(intern (format "cl-struct-%s-tags" incl))) - forms) - (setq incl (get incl 'cl-struct-include))))) + (if (cadr inc-type) (setq tag name named t))) (if type (progn (or (memq type '(vector list)) @@ -2661,64 +2655,70 @@ Of course, we really can't know that for sure, so it's just a heuristic." (or (cdr (assq sym byte-compile-function-environment)) (cdr (assq sym byte-compile-macro-environment)))))) -(defun cl--make-type-test (val type) - (pcase type - ((and `(,name . ,args) (guard (get name 'cl-deftype-handler))) - (cl--make-type-test val (apply (get name 'cl-deftype-handler) - args))) - (`(,(and name (or 'integer 'float 'real 'number)) - . ,(or `(,min ,max) pcase--dontcare)) - `(and ,(cl--make-type-test val name) - ,(if (memq min '(* nil)) t - (if (consp min) `(> ,val ,(car min)) - `(>= ,val ,min))) - ,(if (memq max '(* nil)) t - (if (consp max) - `(< ,val ,(car max)) - `(<= ,val ,max))))) - (`(,(and name (or 'and 'or 'not)) . ,args) - (cons name (mapcar (lambda (x) (cl--make-type-test val x)) args))) - (`(member . ,args) - `(and (cl-member ,val ',args) t)) - (`(satisfies ,pred) `(funcall #',pred ,val)) - ((and (pred symbolp) (guard (get type 'cl-deftype-handler))) - (cl--make-type-test val (funcall (get type 'cl-deftype-handler)))) - ((and (pred symbolp) (guard (get type 'cl-deftype-satisfies))) - `(funcall #',(get type 'cl-deftype-satisfies) ,val)) - ((or 'nil 't) type) - ('null `(null ,val)) - ('atom `(atom ,val)) - ('float `(floatp ,val)) - ('real `(numberp ,val)) - ('fixnum `(integerp ,val)) - ;; FIXME: Implement `base-char' and `extended-char'. - ('character `(characterp ,val)) - ((pred symbolp) - (let* ((name (symbol-name type)) - (namep (intern (concat name "p")))) - (cond - ((cl--macroexp-fboundp namep) (list namep val)) - ((cl--macroexp-fboundp - (setq namep (intern (concat name "-p")))) - (list namep val)) - ((cl--macroexp-fboundp type) (list type val)) - (t (error "Unknown type %S" type))))) - (_ (error "Bad type spec: %s" type)))) - -(defvar cl--object) +(put 'null 'cl-deftype-satisfies #'null) +(put 'atom 'cl-deftype-satisfies #'atom) +(put 'real 'cl-deftype-satisfies #'numberp) +(put 'fixnum 'cl-deftype-satisfies #'integerp) +(put 'base-char 'cl-deftype-satisfies #'characterp) +(put 'character 'cl-deftype-satisfies #'integerp) + + ;;;###autoload -(defun cl-typep (object type) ; See compiler macro below. - "Check that OBJECT is of type TYPE. -TYPE is a Common Lisp-style type specifier." - (declare (compiler-macro cl--compiler-macro-typep)) - (let ((cl--object object)) ;; Yuck!! - (eval (cl--make-type-test 'cl--object type)))) - -(defun cl--compiler-macro-typep (form val type) - (if (macroexp-const-p type) - (macroexp-let2 macroexp-copyable-p temp val - (cl--make-type-test temp (cl--const-expr-val type))) - form)) +(define-inline cl-typep (val type) + (inline-letevals (val) + (pcase (inline-const-val type) + ((and `(,name . ,args) (guard (get name 'cl-deftype-handler))) + (inline-quote + (cl-typep ,val ',(apply (get name 'cl-deftype-handler) args)))) + (`(,(and name (or 'integer 'float 'real 'number)) + . ,(or `(,min ,max) pcase--dontcare)) + (inline-quote + (and (cl-typep ,val ',name) + ,(if (memq min '(* nil)) t + (if (consp min) + (inline-quote (> ,val ',(car min))) + (inline-quote (>= ,val ',min)))) + ,(if (memq max '(* nil)) t + (if (consp max) + (inline-quote (< ,val ',(car max))) + (inline-quote (<= ,val ',max))))))) + (`(not ,type) (inline-quote (not (cl-typep ,val ',type)))) + (`(,(and name (or 'and 'or)) . ,types) + (cond + ((null types) (inline-quote ',(eq name 'and))) + ((null (cdr types)) + (inline-quote (cl-typep ,val ',(car types)))) + (t + (let ((head (car types)) + (rest `(,name . ,(cdr types)))) + (cond + ((eq name 'and) + (inline-quote (and (cl-typep ,val ',head) + (cl-typep ,val ',rest)))) + (t + (inline-quote (or (cl-typep ,val ',head) + (cl-typep ,val ',rest))))))))) + (`(member . ,args) + (inline-quote (and (memql ,val ',args) t))) + (`(satisfies ,pred) (inline-quote (funcall #',pred ,val))) + ((and (pred symbolp) type (guard (get type 'cl-deftype-handler))) + (inline-quote + (cl-typep ,val ',(funcall (get type 'cl-deftype-handler))))) + ((and (pred symbolp) type (guard (get type 'cl-deftype-satisfies))) + (inline-quote (funcall #',(get type 'cl-deftype-satisfies) ,val))) + ((and (or 'nil 't) type) (inline-quote ',type)) + ((and (pred symbolp) type) + (let* ((name (symbol-name type)) + (namep (intern (concat name "p")))) + (cond + ((cl--macroexp-fboundp namep) (inline-quote (funcall #',namep ,val))) + ((cl--macroexp-fboundp + (setq namep (intern (concat name "-p")))) + (inline-quote (funcall #',namep ,val))) + ((cl--macroexp-fboundp type) (inline-quote (funcall #',type ,val))) + (t (error "Unknown type %S" type))))) + (type (error "Bad type spec: %s" type))))) + ;;;###autoload (defmacro cl-check-type (form type &optional string) @@ -2751,10 +2751,9 @@ omitted, a default message listing FORM itself is used." (cdr form)))))) `(progn (or ,form - ,(if string - `(error ,string ,@sargs ,@args) - `(signal 'cl-assertion-failed - (list ',form ,@sargs)))) + (cl--assertion-failed + ',form ,@(if (or string sargs args) + `(,string (list ,@sargs) (list ,@args))))) nil)))) ;;; Compiler macros. @@ -2962,23 +2961,26 @@ The type name can then be used in `cl-typecase', `cl-check-type', etc." (put ',name 'cl-deftype-handler (cl-function (lambda (&cl-defs '('*) ,@arglist) ,@body))))) +(cl-deftype extended-char () `(and character (not base-char))) + ;;; Additional functions that we can now define because we've defined ;;; `cl-defsubst' and `cl-typep'. -(cl-defsubst cl-struct-slot-value (struct-type slot-name inst) - ;; The use of `cl-defsubst' here gives us both a compiler-macro - ;; and a gv-expander "for free". +(define-inline cl-struct-slot-value (struct-type slot-name inst) "Return the value of slot SLOT-NAME in INST of STRUCT-TYPE. STRUCT and SLOT-NAME are symbols. INST is a structure instance." (declare (side-effect-free t)) - (unless (cl-typep inst struct-type) - (signal 'wrong-type-argument (list struct-type inst))) - ;; We could use `elt', but since the byte compiler will resolve the - ;; branch below at compile time, it's more efficient to use the - ;; type-specific accessor. - (if (eq (cl-struct-sequence-type struct-type) 'vector) - (aref inst (cl-struct-slot-offset struct-type slot-name)) - (nth (cl-struct-slot-offset struct-type slot-name) inst))) + (inline-letevals (struct-type slot-name inst) + (inline-quote + (progn + (unless (cl-typep ,inst ,struct-type) + (signal 'wrong-type-argument (list ,struct-type ,inst))) + ;; We could use `elt', but since the byte compiler will resolve the + ;; branch below at compile time, it's more efficient to use the + ;; type-specific accessor. + (if (eq (cl-struct-sequence-type ,struct-type) 'vector) + (aref ,inst (cl-struct-slot-offset ,struct-type ,slot-name)) + (nth (cl-struct-slot-offset ,struct-type ,slot-name) ,inst)))))) (run-hooks 'cl-macs-load-hook) diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index c9867b4..03045de 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -33,6 +33,10 @@ (if (boundp children-sym) (add-to-list children-sym tag) (set children-sym (list tag))) + (let* ((parent-class parent)) + (while parent-class + (add-to-list (intern (format "cl-struct-%s-tags" parent-class)) tag) + (setq parent-class (get parent-class 'cl-struct-include)))) ;; If the cl-generic support, we need to be able to check ;; if a vector is a cl-struct object, without knowing its particular type. ;; So we use the (otherwise) unused function slots of the tag symbol @@ -44,5 +48,27 @@ (if print-auto (put name 'cl-struct-print print-auto)) (if docstring (put name 'structure-documentation docstring))) +;; The `assert' macro from the cl package signals +;; `cl-assertion-failed' at runtime so always define it. +(define-error 'cl-assertion-failed (purecopy "Assertion failed")) + +(defun cl--assertion-failed (form &optional string sargs args) + (if debug-on-error + (debug `(cl-assertion-failed ,form ,string ,@sargs)) + (if string + (apply #'error string (append sargs args)) + (signal 'cl-assertion-failed `(,form ,@sargs))))) + +;; Make sure functions defined with cl-defsubst can be inlined even in +;; packages which do not require CL. We don't put an autoload cookie +;; directly on that function, since those cookies only go to cl-loaddefs. +(autoload 'cl--defsubst-expand "cl-macs") +;; Autoload, so autoload.el and font-lock can use it even when CL +;; is not loaded. +(put 'cl-defun 'doc-string-elt 3) +(put 'cl-defmacro 'doc-string-elt 3) +(put 'cl-defsubst 'doc-string-elt 3) +(put 'cl-defstruct 'doc-string-elt 2) + (provide 'cl-preloaded) ;;; cl-preloaded.el ends here commit 0d54f2f51c799cc372d9521233a8009adc4c3691 Author: Stefan Monnier Date: Fri Feb 13 22:45:18 2015 -0500 * lisp/textmodes/flyspell.el (flyspell-word): Defvar. Fixes: debbugs:19844 (flyspell-generic-check-word-p): Mark as obsolete. * lisp/erc/erc-spelling.el (erc-spelling-init): Use flyspell-generic-check-word-predicate. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 030d572..257b11b 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2015-02-14 Stefan Monnier + + * textmodes/flyspell.el (flyspell-word): Defvar (bug#19844). + (flyspell-generic-check-word-p): Mark as obsolete. + 2015-02-13 Artur Malabarba * emacs-lisp/package.el (package--compatibility-table): New var. @@ -14,8 +19,8 @@ * net/sasl-scram-rfc.el: New file. - * net/sasl.el (sasl-mechanisms): Remove SCRAM-MD5. Add - SCRAM-SHA-1 first. + * net/sasl.el (sasl-mechanisms): Remove SCRAM-MD5. + Add SCRAM-SHA-1 first. (sasl-mechanism-alist): Remove SCRAM-MD5 entry. Add SCRAM-SHA-1 entry (bug#17636). @@ -34,8 +39,8 @@ python.el: Allow killing shell buffer if process is dead. (Bug#19823) - * progmodes/python.el (python-shell-font-lock-kill-buffer): Don't - require a running process. + * progmodes/python.el (python-shell-font-lock-kill-buffer): + Don't require a running process. (python-shell-font-lock-post-command-hook): Fontify only if the shell process is running. diff --git a/lisp/erc/ChangeLog b/lisp/erc/ChangeLog index 44971cc..4c1c843 100644 --- a/lisp/erc/ChangeLog +++ b/lisp/erc/ChangeLog @@ -1,3 +1,8 @@ +2015-02-14 Stefan Monnier + + * erc-spelling.el (erc-spelling-init): + Use flyspell-generic-check-word-predicate. + 2015-01-28 Dima Kogan * erc-backend.el (define-erc-response-handler): Give hook-name diff --git a/lisp/erc/erc-spelling.el b/lisp/erc/erc-spelling.el index e2ddb04..0cba956 100644 --- a/lisp/erc/erc-spelling.el +++ b/lisp/erc/erc-spelling.el @@ -71,7 +71,7 @@ The current buffer is given by BUFFER." (if dicts (cadr (car dicts)) (erc-with-server-buffer ispell-local-dictionary))))) - (setq flyspell-generic-check-word-p 'erc-spelling-flyspell-verify) + (setq flyspell-generic-check-word-predicate #'erc-spelling-flyspell-verify) (flyspell-mode 1))) (defun erc-spelling-unhighlight-word (word) @@ -85,6 +85,7 @@ The cadr is the beginning and the caddr is the end." (defun erc-spelling-flyspell-verify () "Flyspell only the input line, nothing else." + ;; FIXME: Don't use `flyspell-word'! (let ((word-data (and (boundp 'flyspell-word) flyspell-word))) (when word-data diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index 91a43f0..ffaf7e7 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -304,8 +304,8 @@ Returns t to continue checking, nil otherwise. Flyspell mode sets this variable to whatever is the `flyspell-mode-predicate' property of the major mode name.") (make-variable-buffer-local 'flyspell-generic-check-word-predicate) -(defvaralias 'flyspell-generic-check-word-p - 'flyspell-generic-check-word-predicate) +(define-obsolete-variable-alias 'flyspell-generic-check-word-p + 'flyspell-generic-check-word-predicate "25.1") ;;*--- mail mode -------------------------------------------------------*/ (put 'mail-mode 'flyspell-mode-predicate 'mail-mode-flyspell-verify) @@ -398,7 +398,7 @@ like \"Some." "Turn on `flyspell-mode' for comments and strings." (interactive) (setq flyspell-generic-check-word-predicate - 'flyspell-generic-progmode-verify) + #'flyspell-generic-progmode-verify) (flyspell-mode 1) (run-hooks 'flyspell-prog-mode-hook)) @@ -1040,6 +1040,8 @@ Mostly we check word delimiters." (goto-char (1+ p))))) r))) +(defvar flyspell-word) ;Backward compatibility; some predicates made use of it! + ;;*---------------------------------------------------------------------*/ ;;* flyspell-word ... */ ;;*---------------------------------------------------------------------*/ commit 03306795dd19a07ea3ed845b508b5ef0638048e0 Author: Glenn Morris Date: Fri Feb 13 18:45:40 2015 -0800 # Add 2015 to copyright years diff --git a/lisp/net/sasl-scram-rfc.el b/lisp/net/sasl-scram-rfc.el index 3d86da4..6c8c009 100644 --- a/lisp/net/sasl-scram-rfc.el +++ b/lisp/net/sasl-scram-rfc.el @@ -1,6 +1,6 @@ ;;; sasl-scram-rfc.el --- SCRAM-SHA-1 module for the SASL client framework -*- lexical-binding: t; -*- -;; Copyright (C) 2014 Free Software Foundation, Inc. +;; Copyright (C) 2014-2015 Free Software Foundation, Inc. ;; Author: Magnus Henoch diff --git a/test/automated/sasl-scram-rfc-tests.el b/test/automated/sasl-scram-rfc-tests.el index c747e5f..46b139b 100644 --- a/test/automated/sasl-scram-rfc-tests.el +++ b/test/automated/sasl-scram-rfc-tests.el @@ -1,6 +1,6 @@ ;;; sasl-scram-rfc-tests.el --- tests for SCRAM-SHA-1 -*- lexical-binding: t; -*- -;; Copyright (C) 2014 Free Software Foundation, Inc. +;; Copyright (C) 2014-2015 Free Software Foundation, Inc. ;; Author: Magnus Henoch commit b9d8edcf6dbe5651919bfb42687d16794f2d86f8 Author: Jan D Date: Fri Feb 13 17:44:26 2015 +0100 Fixes: debbugs:19850 * configure.ac: Set locallisppath to empty for NS self contained, unless --enable-loadllisppath was given. diff --git a/ChangeLog b/ChangeLog index a574ac8..4365668 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2015-02-13 Jan Djärv + + * configure.ac: Set locallisppath to empty for NS self contained, + unless --enable-loadllisppath was given (Bug#19850). + 2015-02-09 Paul Eggert * configure.ac (HAVE_LIBXML2): Add missing comma. diff --git a/configure.ac b/configure.ac index 68291b8..0bcc55c 100644 --- a/configure.ac +++ b/configure.ac @@ -423,6 +423,7 @@ AC_ARG_ENABLE(ns-self-contained, EN_NS_SELF_CONTAINED=$enableval, EN_NS_SELF_CONTAINED=yes) +locallisppathset=no AC_ARG_ENABLE(locallisppath, [AS_HELP_STRING([--enable-locallisppath=PATH], [directories Emacs should search for lisp files specific @@ -430,7 +431,7 @@ AC_ARG_ENABLE(locallisppath, if test "${enableval}" = "no"; then locallisppath= elif test "${enableval}" != "yes"; then - locallisppath=${enableval} + locallisppath=${enableval} locallisppathset=yes fi) AC_ARG_ENABLE(checking, @@ -1871,6 +1872,7 @@ if test "${HAVE_NS}" = yes; then infodir="\${ns_appresdir}/info" mandir="\${ns_appresdir}/man" lispdir="\${ns_appresdir}/lisp" + test "$locallisppathset" = no && locallisppath="" INSTALL_ARCH_INDEP_EXTRA= fi commit a03ab7eaf532075d2948ece70b8f3c97cd26b577 Author: Artur Malabarba Date: Fri Feb 13 13:08:38 2015 +0000 emacs-lisp/package.el (describe-package-1): Fix "incompat" handling. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 75adddb..030d572 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -4,6 +4,7 @@ (package--add-to-compatibility-table): New function. (package-read-all-archive-contents): Populate compatibility table. (package--incompatible-p): Also look in dependencies. + (describe-package-1): Fix "incompat" handling. 2015-02-13 Lars Ingebrigtsen diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index d9340e1..d8b4595 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1811,6 +1811,8 @@ the table." (installable (and archive (not built-in))) (status (if desc (package-desc-status desc) "orphan")) (signed (if desc (package-desc-signed desc)))) + (when (string= status "incompat") + (setq status "incompatible")) (prin1 name) (princ " is ") (princ (if (memq (aref status 0) '(?a ?e ?i ?o ?u)) "an " "a ")) @@ -1825,9 +1827,7 @@ the table." (pkg-dir (insert (propertize (if (member status '("unsigned" "dependency")) "Installed" - (if (equal status "incompat") - "Incompatible" - (capitalize status))) ;FIXME: Why comment-face? + (capitalize status)) ;FIXME: Why comment-face? 'font-lock-face 'font-lock-comment-face)) (insert " in `") ;; Todo: Add button for uninstalling. commit 3b8b549ffff5b5e774266a9662f738a9335997f2 Author: Artur Malabarba Date: Fri Feb 13 12:10:42 2015 +0000 emacs-lisp/package.el (package--incompatible-p): Check dependencies. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index d0038f4..75adddb 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,10 @@ +2015-02-13 Artur Malabarba + + * emacs-lisp/package.el (package--compatibility-table): New var. + (package--add-to-compatibility-table): New function. + (package-read-all-archive-contents): Populate compatibility table. + (package--incompatible-p): Also look in dependencies. + 2015-02-13 Lars Ingebrigtsen * net/rfc2104.el: Moved here from lisp/gnus. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 67e2f40..d9340e1 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -468,6 +468,19 @@ called via `package-initialize'. To change which packages are loaded and/or activated, customize `package-load-list'.") (put 'package-alist 'risky-local-variable t) +(defvar package--compatibility-table nil + "Hash table connecting package names to their compatibility. +Each key is a symbol, the name of a package. + +The value is either nil, representing an incompatible package, or +a version list, representing the highest compatible version of +that package which is available. + +A package is considered incompatible if it requires an Emacs +version higher than the one being used. To check for package +\(in)compatibility, don't read this table directly, use +`package--incompatible-p' which also checks dependencies.") + (defvar package-activated-list nil ;; FIXME: This should implicitly include all builtin packages. "List of the names of currently activated packages.") @@ -1131,7 +1144,10 @@ Will throw an error if the archive version is too new." If successful, set `package-archive-contents'." (setq package-archive-contents nil) (dolist (archive package-archives) - (package-read-archive-contents (car archive)))) + (package-read-archive-contents (car archive))) + ;; Build compat table. + (setq package--compatibility-table (make-hash-table :test 'eq)) + (package--mapc #'package--add-to-compatibility-table)) (defun package-read-archive-contents (archive) "Re-read archive contents for ARCHIVE. @@ -1728,6 +1744,19 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." (package-activate (car elt)))) (setq package--initialized t)) +(defun package--add-to-compatibility-table (pkg) + "If PKG is compatible (without dependencies), add to the compatibility table. +PKG is a package-desc object. +Only adds if its version is higher than what's already stored in +the table." + (unless (package--incompatible-p pkg 'shallow) + (let* ((name (package-desc-name pkg)) + (version (or (package-desc-version pkg) '(0))) + (table-version (gethash name package--compatibility-table))) + (when (or (not table-version) + (version-list-< table-version version)) + (puthash name version package--compatibility-table))))) + ;;;; Package description buffer. @@ -2059,21 +2088,32 @@ package PKG-DESC, add one. The alist is keyed with PKG-DESC." (defvar package--emacs-version-list (version-to-list emacs-version) "`emacs-version', as a list.") -(defun package--incompatible-p (pkg) +(defun package--incompatible-p (pkg &optional shallow) "Return non-nil if PKG has no chance of being installable. PKG is a package-desc object. -Return value is a string describing the reason why the package is -incompatible. -Currently, this only checks if PKG depends on a higher -`emacs-version' than the one being used." +If SHALLOW is non-nil, this only checks if PKG depends on a +higher `emacs-version' than the one being used. Otherwise, also +checks the viability of dependencies, according to +`package--compatibility-table'. + +If PKG requires an incompatible Emacs version, the return value +is this version (as a string). +If PKG requires incompatible packages, the return value is a list +of these dependencies, similar to the list returned by +`package-desc-reqs'." (let* ((reqs (package-desc-reqs pkg)) (version (cadr (assq 'emacs reqs)))) (if (and version (version-list-< package--emacs-version-list version)) - (format "`%s' requires Emacs %s, but current version is %s" - (package-desc-full-name pkg) - (package-version-join version) - emacs-version)))) + (package-version-join version) + (unless shallow + (let (out) + (dolist (dep (package-desc-reqs pkg) out) + (let ((dep-name (car dep))) + (unless (eq 'emacs dep-name) + (let ((cv (gethash dep-name package--compatibility-table))) + (when (version-list-< (or cv '(0)) (or (cadr dep) '(0))) + (push dep out))))))))))) (defun package-desc-status (pkg-desc) (let* ((name (package-desc-name pkg-desc)) commit 69e38a5b1fdb5ac20440b6ce7ba1fc2cd575f4e6 Author: Lars Magne Ingebrigtsen Date: Fri Feb 13 19:57:13 2015 +1100 Move rfc2104 from gnus to net * net/rfc2104.el: Moved here from lisp/gnus. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 02a7c3a..d0038f4 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2015-02-13 Lars Ingebrigtsen + + * net/rfc2104.el: Moved here from lisp/gnus. + 2015-02-13 Magnus Henoch * net/sasl-scram-rfc.el: New file. diff --git a/lisp/gnus/rfc2104.el b/lisp/gnus/rfc2104.el deleted file mode 100644 index f80e228..0000000 --- a/lisp/gnus/rfc2104.el +++ /dev/null @@ -1,124 +0,0 @@ -;;; rfc2104.el --- RFC2104 Hashed Message Authentication Codes - -;; Copyright (C) 1998-2015 Free Software Foundation, Inc. - -;; Author: Simon Josefsson -;; Keywords: mail - -;; This file is part of GNU Emacs. - -;; GNU Emacs 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. - -;; GNU Emacs 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 GNU Emacs. If not, see . - -;;; Commentary: - -;; This is a high performance implementation of RFC2104. -;; -;; Example: -;; -;; (require 'md5) -;; (rfc2104-hash 'md5 64 16 "Jefe" "what do ya want for nothing?") -;; "750c783e6ab0b503eaa86e310a5db738" -;; -;; (require 'sha1) -;; (rfc2104-hash 'sha1 64 20 "Jefe" "what do ya want for nothing?") -;; "effcdf6ae5eb2fa2d27416d5f184df9c259a7c79" -;; -;; 64 is block length of hash function (64 for MD5 and SHA), 16 is -;; resulting hash length (16 for MD5, 20 for SHA). -;; -;; Tested with Emacs 20.2 and XEmacs 20.3. -;; -;; Test case reference: RFC 2202. - -;;; History: - -;; 1998-08-16 initial release posted to gnu.emacs.sources -;; 1998-08-17 use append instead of char-list-to-string -;; 1998-08-26 don't require hexl -;; 1998-09-25 renamed from hmac.el to rfc2104.el, also renamed functions -;; 1999-10-23 included in pgnus -;; 2000-08-15 `rfc2104-hexstring-to-bitstring' -;; 2000-05-12 added sha-1 example, added test case reference -;; 2003-11-13 change rfc2104-hexstring-to-bitstring to ...-byte-list -;; 2008-04-25 rewrite rfc2104-hash for speed - -;;; Code: - -(eval-when-compile (require 'cl)) - -;; Magic character for inner HMAC round. 0x36 == 54 == '6' -(defconst rfc2104-ipad ?\x36) - -;; Magic character for outer HMAC round. 0x5C == 92 == '\' -(defconst rfc2104-opad ?\x5C) - -(defconst rfc2104-nybbles - (let ((v (make-vector - ;; Find upper bound to save some space. - (1+ (max ?0 ?9 ?a ?f ?A ?F)) - ;; Use non-numeric default to catch bogus hex strings. - nil)) - (ls '((?0 . 0) (?a . 10) (?A . 10) - (?1 . 1) (?b . 11) (?B . 11) - (?2 . 2) (?c . 12) (?C . 12) - (?3 . 3) (?d . 13) (?D . 13) - (?4 . 4) (?e . 14) (?E . 14) - (?5 . 5) (?f . 15) (?F . 15) - (?6 . 6) - (?7 . 7) - (?8 . 8) - (?9 . 9)))) - (while ls - (aset v (caar ls) (cdar ls)) - (setq ls (cdr ls))) - v)) - -(eval-when-compile - (defmacro rfc2104-string-make-unibyte (string) - "Return the unibyte equivalent of STRING. -In XEmacs return just STRING." - (if (featurep 'xemacs) - string - `(string-make-unibyte ,string)))) - -(defun rfc2104-hash (hash block-length hash-length key text) - (let* (;; if key is longer than B, reset it to HASH(key) - (key (if (> (length key) block-length) - (funcall hash key) key)) - (len (length key)) - (ipad (make-string block-length rfc2104-ipad)) - (opad (make-string (+ block-length hash-length) rfc2104-opad)) - c partial) - ;; Prefix *pad with key, appropriately XORed. - (do ((i 0 (1+ i))) - ((= len i)) - (setq c (aref key i)) - (aset ipad i (logxor rfc2104-ipad c)) - (aset opad i (logxor rfc2104-opad c))) - ;; Perform inner hash. - (setq partial (rfc2104-string-make-unibyte - (funcall hash (concat ipad text)))) - ;; Pack latter part of opad. - (do ((r 0 (+ 2 r)) - (w block-length (1+ w))) - ((= (* 2 hash-length) r)) - (aset opad w - (+ (* 16 (aref rfc2104-nybbles (aref partial r))) - ( aref rfc2104-nybbles (aref partial (1+ r)))))) - ;; Perform outer hash. - (rfc2104-string-make-unibyte (funcall hash opad)))) - -(provide 'rfc2104) - -;;; rfc2104.el ends here diff --git a/lisp/net/rfc2104.el b/lisp/net/rfc2104.el new file mode 100644 index 0000000..f80e228 --- /dev/null +++ b/lisp/net/rfc2104.el @@ -0,0 +1,124 @@ +;;; rfc2104.el --- RFC2104 Hashed Message Authentication Codes + +;; Copyright (C) 1998-2015 Free Software Foundation, Inc. + +;; Author: Simon Josefsson +;; Keywords: mail + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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. + +;; GNU Emacs 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 GNU Emacs. If not, see . + +;;; Commentary: + +;; This is a high performance implementation of RFC2104. +;; +;; Example: +;; +;; (require 'md5) +;; (rfc2104-hash 'md5 64 16 "Jefe" "what do ya want for nothing?") +;; "750c783e6ab0b503eaa86e310a5db738" +;; +;; (require 'sha1) +;; (rfc2104-hash 'sha1 64 20 "Jefe" "what do ya want for nothing?") +;; "effcdf6ae5eb2fa2d27416d5f184df9c259a7c79" +;; +;; 64 is block length of hash function (64 for MD5 and SHA), 16 is +;; resulting hash length (16 for MD5, 20 for SHA). +;; +;; Tested with Emacs 20.2 and XEmacs 20.3. +;; +;; Test case reference: RFC 2202. + +;;; History: + +;; 1998-08-16 initial release posted to gnu.emacs.sources +;; 1998-08-17 use append instead of char-list-to-string +;; 1998-08-26 don't require hexl +;; 1998-09-25 renamed from hmac.el to rfc2104.el, also renamed functions +;; 1999-10-23 included in pgnus +;; 2000-08-15 `rfc2104-hexstring-to-bitstring' +;; 2000-05-12 added sha-1 example, added test case reference +;; 2003-11-13 change rfc2104-hexstring-to-bitstring to ...-byte-list +;; 2008-04-25 rewrite rfc2104-hash for speed + +;;; Code: + +(eval-when-compile (require 'cl)) + +;; Magic character for inner HMAC round. 0x36 == 54 == '6' +(defconst rfc2104-ipad ?\x36) + +;; Magic character for outer HMAC round. 0x5C == 92 == '\' +(defconst rfc2104-opad ?\x5C) + +(defconst rfc2104-nybbles + (let ((v (make-vector + ;; Find upper bound to save some space. + (1+ (max ?0 ?9 ?a ?f ?A ?F)) + ;; Use non-numeric default to catch bogus hex strings. + nil)) + (ls '((?0 . 0) (?a . 10) (?A . 10) + (?1 . 1) (?b . 11) (?B . 11) + (?2 . 2) (?c . 12) (?C . 12) + (?3 . 3) (?d . 13) (?D . 13) + (?4 . 4) (?e . 14) (?E . 14) + (?5 . 5) (?f . 15) (?F . 15) + (?6 . 6) + (?7 . 7) + (?8 . 8) + (?9 . 9)))) + (while ls + (aset v (caar ls) (cdar ls)) + (setq ls (cdr ls))) + v)) + +(eval-when-compile + (defmacro rfc2104-string-make-unibyte (string) + "Return the unibyte equivalent of STRING. +In XEmacs return just STRING." + (if (featurep 'xemacs) + string + `(string-make-unibyte ,string)))) + +(defun rfc2104-hash (hash block-length hash-length key text) + (let* (;; if key is longer than B, reset it to HASH(key) + (key (if (> (length key) block-length) + (funcall hash key) key)) + (len (length key)) + (ipad (make-string block-length rfc2104-ipad)) + (opad (make-string (+ block-length hash-length) rfc2104-opad)) + c partial) + ;; Prefix *pad with key, appropriately XORed. + (do ((i 0 (1+ i))) + ((= len i)) + (setq c (aref key i)) + (aset ipad i (logxor rfc2104-ipad c)) + (aset opad i (logxor rfc2104-opad c))) + ;; Perform inner hash. + (setq partial (rfc2104-string-make-unibyte + (funcall hash (concat ipad text)))) + ;; Pack latter part of opad. + (do ((r 0 (+ 2 r)) + (w block-length (1+ w))) + ((= (* 2 hash-length) r)) + (aset opad w + (+ (* 16 (aref rfc2104-nybbles (aref partial r))) + ( aref rfc2104-nybbles (aref partial (1+ r)))))) + ;; Perform outer hash. + (rfc2104-string-make-unibyte (funcall hash opad)))) + +(provide 'rfc2104) + +;;; rfc2104.el ends here commit e7d21b4ab11e73c709420eeeb32ffe2421fafe98 Author: Magnus Henoch Date: Fri Feb 13 19:54:57 2015 +1100 Implement SCRAM-SHA-1 SASL mechanism Fixes: debbugs:17636 * lisp/net/sasl-scram-rfc.el: New file. * lisp/net/sasl.el (sasl-mechanisms): Remove SCRAM-MD5. Add SCRAM-SHA-1 first. (sasl-mechanism-alist): Remove SCRAM-MD5 entry. Add SCRAM-SHA-1 entry. * test/automated/sasl-scram-rfc-tests.el: New file. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 8393009..02a7c3a 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,12 @@ +2015-02-13 Magnus Henoch + + * net/sasl-scram-rfc.el: New file. + + * net/sasl.el (sasl-mechanisms): Remove SCRAM-MD5. Add + SCRAM-SHA-1 first. + (sasl-mechanism-alist): Remove SCRAM-MD5 entry. Add SCRAM-SHA-1 + entry (bug#17636). + 2015-02-13 Lars Ingebrigtsen * net/shr.el (shr-tag-li): Speed up rendering pages with lots of diff --git a/lisp/net/sasl-scram-rfc.el b/lisp/net/sasl-scram-rfc.el new file mode 100644 index 0000000..3d86da4 --- /dev/null +++ b/lisp/net/sasl-scram-rfc.el @@ -0,0 +1,160 @@ +;;; sasl-scram-rfc.el --- SCRAM-SHA-1 module for the SASL client framework -*- lexical-binding: t; -*- + +;; Copyright (C) 2014 Free Software Foundation, Inc. + +;; Author: Magnus Henoch + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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. + +;; GNU Emacs 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 GNU Emacs. If not, see . + +;;; Commentary: + +;; This program is implemented from RFC 5802. It implements the +;; SCRAM-SHA-1 SASL mechanism. +;; +;; RFC 5802 foresees "hash agility", i.e. new mechanisms based on the +;; same protocol but using a different hash function. Likewise, this +;; module attempts to separate generic and specific functions, which +;; should make it easy to implement any future SCRAM-* SASL mechanism. +;; It should be as simple as copying the SCRAM-SHA-1 section below and +;; replacing all SHA-1 references. +;; +;; This module does not yet implement the variants with channel +;; binding, i.e. SCRAM-*-PLUS. That would require cooperation from +;; the TLS library. + +;;; Code: + +(require 'cl-lib) +(require 'sasl) + +;;; SCRAM-SHA-1 + +(require 'hex-util) +(require 'rfc2104) + +(defconst sasl-scram-sha-1-steps + '(sasl-scram-client-first-message + sasl-scram-sha-1-client-final-message + sasl-scram-sha-1-authenticate-server)) + +(defun sasl-scram-sha-1-client-final-message (client step) + (sasl-scram--client-final-message + ;; HMAC-SHA1 uses block length 64 and hash length 20; see RFC 2104. + 'sha1 64 20 client step)) + +(defun sasl-scram-sha-1-authenticate-server (client step) + (sasl-scram--authenticate-server + 'sha1 64 20 client step)) + +(put 'sasl-scram-sha-1 'sasl-mechanism + (sasl-make-mechanism "SCRAM-SHA-1" sasl-scram-sha-1-steps)) + +(provide 'sasl-scram-sha-1) + +;;; Generic for SCRAM-* + +(defun sasl-scram-client-first-message (client _step) + (let ((c-nonce (sasl-unique-id))) + (sasl-client-set-property client 'c-nonce c-nonce)) + (concat + ;; n = client doesn't support channel binding + "n," + ;; TODO: where would we get authorization id from? + "," + (sasl-scram--client-first-message-bare client))) + +(defun sasl-scram--client-first-message-bare (client) + (let ((c-nonce (sasl-client-property client 'c-nonce))) + (concat + ;; TODO: saslprep username or disallow non-ASCII characters + "n=" (sasl-client-name client) "," + "r=" c-nonce))) + +(defun sasl-scram--client-final-message (hash-fun block-length hash-length client step) + (unless (string-match + "^r=\\([^,]+\\),s=\\([^,]+\\),i=\\([0-9]+\\)\\(?:$\\|,\\)" + (sasl-step-data step)) + (sasl-error "Unexpected server response")) + (let* ((hmac-fun (lambda (text key) + (decode-hex-string + (rfc2104-hash hash-fun block-length hash-length key text)))) + (step-data (sasl-step-data step)) + (nonce (match-string 1 step-data)) + (salt-base64 (match-string 2 step-data)) + (iteration-count (string-to-number (match-string 3 step-data))) + + (c-nonce (sasl-client-property client 'c-nonce)) + ;; no channel binding, no authorization id + (cbind-input "n,,")) + (unless (string-prefix-p c-nonce nonce) + (sasl-error "Invalid nonce from server")) + (let* ((client-final-message-without-proof + (concat "c=" (base64-encode-string cbind-input) "," + "r=" nonce)) + (password + ;; TODO: either apply saslprep or disallow non-ASCII characters + (sasl-read-passphrase + (format "%s passphrase for %s: " + (sasl-mechanism-name (sasl-client-mechanism client)) + (sasl-client-name client)))) + (salt (base64-decode-string salt-base64)) + (salted-password + ;; Hi(str, salt, i): + (let ((digest (concat salt (string 0 0 0 1))) + (xored nil)) + (dotimes (_i iteration-count xored) + (setq digest (funcall hmac-fun digest password)) + (setq xored (if (null xored) + digest + (cl-map 'string 'logxor xored digest)))))) + (client-key + (funcall hmac-fun "Client Key" salted-password)) + (stored-key (decode-hex-string (funcall hash-fun client-key))) + (auth-message + (concat + (sasl-scram--client-first-message-bare client) "," + step-data "," + client-final-message-without-proof)) + (client-signature (funcall hmac-fun (encode-coding-string auth-message 'utf-8) stored-key)) + (client-proof (cl-map 'string 'logxor client-key client-signature)) + (client-final-message + (concat client-final-message-without-proof "," + "p=" (base64-encode-string client-proof)))) + (sasl-client-set-property client 'auth-message auth-message) + (sasl-client-set-property client 'salted-password salted-password) + client-final-message))) + +(defun sasl-scram--authenticate-server (hash-fun block-length hash-length client step) + (cond + ((string-match "^e=\\([^,]+\\)" (sasl-step-data step)) + (sasl-error (format "Server error: %s" (match-string 1 (sasl-step-data step))))) + ((string-match "^v=\\([^,]+\\)" (sasl-step-data step)) + (let* ((hmac-fun (lambda (text key) + (decode-hex-string + (rfc2104-hash hash-fun block-length hash-length key text)))) + (verifier (base64-decode-string (match-string 1 (sasl-step-data step)))) + (auth-message (sasl-client-property client 'auth-message)) + (salted-password (sasl-client-property client 'salted-password)) + (server-key (funcall hmac-fun "Server Key" salted-password)) + (expected-server-signature + (funcall hmac-fun (encode-coding-string auth-message 'utf-8) server-key))) + (unless (string= expected-server-signature verifier) + (sasl-error "Server not authenticated")))) + (t + (sasl-error "Invalid response from server")))) + +(provide 'sasl-scram-rfc) +;;; sasl-scram-rfc.el ends here diff --git a/lisp/net/sasl.el b/lisp/net/sasl.el index 648e622..e59ed5d 100644 --- a/lisp/net/sasl.el +++ b/lisp/net/sasl.el @@ -35,8 +35,8 @@ ;;; Code: (defvar sasl-mechanisms - '("CRAM-MD5" "DIGEST-MD5" "PLAIN" "LOGIN" "ANONYMOUS" - "NTLM" "SCRAM-MD5")) + '("SCRAM-SHA-1" "CRAM-MD5" "DIGEST-MD5" "PLAIN" "LOGIN" "ANONYMOUS" + "NTLM")) (defvar sasl-mechanism-alist '(("CRAM-MD5" sasl-cram) @@ -45,7 +45,7 @@ ("LOGIN" sasl-login) ("ANONYMOUS" sasl-anonymous) ("NTLM" sasl-ntlm) - ("SCRAM-MD5" sasl-scram))) + ("SCRAM-SHA-1" sasl-scram-sha-1))) (defvar sasl-unique-id-function #'sasl-unique-id-function) diff --git a/test/ChangeLog b/test/ChangeLog index 979214c..29b7c7d 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -1,3 +1,7 @@ +2015-02-13 Magnus Henoch + + * automated/sasl-scram-rfc-tests.el: New file. + 2015-02-11 Nicolas Petton * automated/seq-tests.el (test-seq-reverse, test-seq-group-by): diff --git a/test/automated/sasl-scram-rfc-tests.el b/test/automated/sasl-scram-rfc-tests.el new file mode 100644 index 0000000..c747e5f --- /dev/null +++ b/test/automated/sasl-scram-rfc-tests.el @@ -0,0 +1,50 @@ +;;; sasl-scram-rfc-tests.el --- tests for SCRAM-SHA-1 -*- lexical-binding: t; -*- + +;; Copyright (C) 2014 Free Software Foundation, Inc. + +;; Author: Magnus Henoch + +;; GNU Emacs 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. + +;; GNU Emacs 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 GNU Emacs. If not, see . + +;;; Commentary: + +;; Test cases from RFC 5802. + +;;; Code: + +(require 'sasl) +(require 'sasl-scram-rfc) + +(ert-deftest sasl-scram-sha-1-test () + ;; The following strings are taken from section 5 of RFC 5802. + (let ((client + (sasl-make-client (sasl-find-mechanism '("SCRAM-SHA-1")) + "user" + "imap" + "localhost")) + (data "r=fyko+d2lbbFgONRv9qkxdawL3rfcNHYJY1ZVvWVs7j,s=QSXCR+Q6sek8bf92,i=4096") + (c-nonce "fyko+d2lbbFgONRv9qkxdawL") + (sasl-read-passphrase + (lambda (_prompt) (copy-sequence "pencil")))) + (sasl-client-set-property client 'c-nonce c-nonce) + (should + (equal + (sasl-scram-sha-1-client-final-message client (vector nil data)) + "c=biws,r=fyko+d2lbbFgONRv9qkxdawL3rfcNHYJY1ZVvWVs7j,p=v0X8v3Bz2T0CJGbJQyF0X+HI4Ts=")) + + ;; This should not throw an error: + (sasl-scram-sha-1-authenticate-server client (vector nil "v=rmF9pqV8S7suAoZWja4dJRkFsKQ= +")))) + +;;; sasl-scram-rfc-tests.el ends here commit f61c87f12a36bb2063c25b6742380b5916618ab5 Author: Lars Magne Ingebrigtsen Date: Fri Feb 13 08:16:39 2015 +0000 lisp/gnus/gnus-msg.el (gnus-msg-mail): Buffer-local warning fix (bug#19573) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 9ff191d..67929a3 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,5 +1,9 @@ 2015-02-13 Lars Ingebrigtsen + * gnus-msg.el (gnus-msg-mail): Don't let-bind `gnus-newsgroup-name' so + that we don't get a warning when setting the buffer-local variable + (bug#19573). + * nnmail.el (nnmail-expiry-target-group): Supply the info structure to `gnus-request-group'. diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index 6c80c0d..bfd3da2 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -541,11 +541,15 @@ instead." nil yank-action send-actions return-action)) (let ((buf (current-buffer)) ;; Don't use posting styles corresponding to any existing group. - (gnus-newsgroup-name "") + (group-name gnus-newsgroup-name) mail-buf) - (gnus-setup-message 'message - (message-mail to subject other-headers continue - nil yank-action send-actions return-action)) + (unwind-protect + (progn + (setq gnus-newsgroup-name "") + (gnus-setup-message 'message + (message-mail to subject other-headers continue + nil yank-action send-actions return-action))) + (setq gnus-newsgroup-name group-name)) (when switch-action (setq mail-buf (current-buffer)) (switch-to-buffer buf) commit a8f93d14cbc7a54bc09c7e4d841331588e86afa6 Author: Lars Magne Ingebrigtsen Date: Fri Feb 13 06:44:40 2015 +0000 lisp/gnus/nnmail.el (nnmail-expiry-target-group): Allow expiring nnimap to a group again diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index f29a53e..9ff191d 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,8 @@ +2015-02-13 Lars Ingebrigtsen + + * nnmail.el (nnmail-expiry-target-group): Supply the info structure to + `gnus-request-group'. + 2015-02-12 Katsumi Yamaoka * gnus-art.el (gnus-article-browse-html-save-cid-content) diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el index 62fcc2d..5c54810 100644 --- a/lisp/gnus/nnmail.el +++ b/lisp/gnus/nnmail.el @@ -1921,7 +1921,7 @@ If TIME is nil, then return the cutoff time for oldness instead." (when (functionp target) (setq target (funcall target group))) (unless (eq target 'delete) - (when (or (gnus-request-group target) + (when (or (gnus-request-group target nil nil (gnus-get-info target)) (gnus-request-create-group target)) (let ((group-art (gnus-request-accept-article target nil nil t))) (when (and (consp group-art) commit 10a5a054ac7b1767623ed7e7f3ff5d7ae4ffe906 Author: Lars Magne Ingebrigtsen Date: Fri Feb 13 15:51:23 2015 +1100 * lisp/net/shr.el (shr-tag-li): Speed up rendering pages with lots of
    diff --git a/lisp/ChangeLog b/lisp/ChangeLog index ff2755d..8393009 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2015-02-13 Lars Ingebrigtsen + + * net/shr.el (shr-tag-li): Speed up rendering pages with lots of +
      . + 2015-02-12 Oleh Krehel * progmodes/gdb-mi.el (gdb-display-io-nopopup): New defcustom. diff --git a/lisp/net/shr.el b/lisp/net/shr.el index cf35a12..f6a390e 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -157,6 +157,7 @@ cid: URL as the argument.") (defvar shr-table-separator-pixel-width 0) (defvar shr-table-id nil) (defvar shr-current-font nil) +(defvar shr-internal-bullet nil) (defvar shr-map (let ((map (make-sparse-keymap))) @@ -216,6 +217,8 @@ DOM should be a parse tree as generated by (shr-table-id 0) (shr-warning nil) (shr-table-separator-pixel-width (shr-string-pixel-width "-")) + (shr-internal-bullet (cons shr-bullet + (shr-string-pixel-width shr-bullet))) (shr-internal-width (or (and shr-width (if (not shr-use-fonts) shr-width @@ -1408,11 +1411,13 @@ The preference is a float determined from `shr-prefer-media-type'." (prog1 (format "%d " shr-list-mode) (setq shr-list-mode (1+ shr-list-mode))) - shr-bullet))) + (car shr-internal-bullet))) + (width (if (numberp shr-list-mode) + (shr-string-pixel-width bullet) + (cdr shr-internal-bullet)))) (insert bullet) (shr-mark-fill start) - (let ((shr-indentation (+ shr-indentation - (shr-string-pixel-width bullet)))) + (let ((shr-indentation (+ shr-indentation width))) (put-text-property start (1+ start) 'shr-continuation-indentation shr-indentation) (put-text-property start (1+ start) 'shr-prefix-length (length bullet)) commit 65563fd7714271582d5146c09202c0f7a0631fe5 Author: Paul Eggert Date: Thu Feb 12 18:20:12 2015 -0800 Better support for future plugins See the thread containing: http://lists.gnu.org/archive/html/emacs-devel/2015-02/msg00720.html * lib-src/make-docfile.c (write_globals): Generate code that #defines Qxxx macros other than Qnil only if DEFINE_NONNIL_Q_SYMBOL_MACROS. Qnil is safe to define even in plugins, since it must be zero for other reasons. * src/lisp.h (DEFINE_LISP_SYMBOL): New macro, replacing and simplifying DEFINE_LISP_SYMBOL_BEGIN / DEFINE_LISP_SYMBOL_END. All uses changed. (DEFINE_NONNIL_Q_SYMBOL_MACROS): New macro, defaulting to true. diff --git a/lib-src/ChangeLog b/lib-src/ChangeLog index 8d2c95e..534d253 100644 --- a/lib-src/ChangeLog +++ b/lib-src/ChangeLog @@ -1,3 +1,13 @@ +2015-02-13 Paul Eggert + + Better support for future plugins + See the thread containing: + http://lists.gnu.org/archive/html/emacs-devel/2015-02/msg00720.html + * make-docfile.c (write_globals): Generate code that #defines + Qxxx macros other than Qnil only if DEFINE_NONNIL_Q_SYMBOL_MACROS. + Qnil is safe to define even in plugins, since it must be zero for + other reasons. + 2015-01-24 Paul Eggert Fix a couple of AM_V_GEN bugs diff --git a/lib-src/make-docfile.c b/lib-src/make-docfile.c index 79d421a..a7943e3 100644 --- a/lib-src/make-docfile.c +++ b/lib-src/make-docfile.c @@ -707,12 +707,9 @@ write_globals (void) globals[i].name, globals[i].name); } else if (globals[i].type == SYMBOL) - printf (("DEFINE_LISP_SYMBOL_BEGIN (%s)\n" - "#define i%s %d\n" - "#define %s builtin_lisp_symbol (i%s)\n" - "DEFINE_LISP_SYMBOL_END (%s)\n\n"), - globals[i].name, globals[i].name, symnum++, - globals[i].name, globals[i].name, globals[i].name); + printf (("#define i%s %d\n" + "DEFINE_LISP_SYMBOL (%s)\n"), + globals[i].name, symnum++, globals[i].name); else { if (globals[i].flags & DEFUN_noreturn) @@ -740,15 +737,19 @@ write_globals (void) puts ("#ifdef DEFINE_SYMBOLS"); puts ("static char const *const defsym_name[] = {"); for (int i = 0; i < num_globals; i++) - { - if (globals[i].type == SYMBOL) - printf ("\t\"%s\",\n", globals[i].v.svalue); - while (i + 1 < num_globals - && strcmp (globals[i].name, globals[i + 1].name) == 0) - i++; - } + if (globals[i].type == SYMBOL) + printf ("\t\"%s\",\n", globals[i].v.svalue); puts ("};"); puts ("#endif"); + + puts ("#define Qnil builtin_lisp_symbol (0)"); + puts ("#if DEFINE_NONNIL_Q_SYMBOL_MACROS"); + num_symbols = 0; + for (int i = 0; i < num_globals; i++) + if (globals[i].type == SYMBOL && num_symbols++ != 0) + printf ("# define %s builtin_lisp_symbol (%d)\n", + globals[i].name, num_symbols - 1); + puts ("#endif"); } diff --git a/src/ChangeLog b/src/ChangeLog index f8e65d5..6d246fb 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,10 @@ +2015-02-13 Paul Eggert + + Better support for future plugins + * lisp.h (DEFINE_LISP_SYMBOL): New macro, replacing and simplifying + DEFINE_LISP_SYMBOL_BEGIN / DEFINE_LISP_SYMBOL_END. All uses changed. + (DEFINE_NONNIL_Q_SYMBOL_MACROS): New macro, defaulting to true. + 2015-02-11 Martin Rudalics * w32term.c (w32_read_socket): In SIZE_MAXIMIZED and diff --git a/src/lisp.h b/src/lisp.h index 6c7b51f..7795c90 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -740,11 +740,18 @@ struct Lisp_Symbol /* Declare extern constants for Lisp symbols. These can be helpful when using a debugger like GDB, on older platforms where the debug format does not represent C macros. */ -#define DEFINE_LISP_SYMBOL_BEGIN(name) \ - DEFINE_GDB_SYMBOL_BEGIN (Lisp_Object, name) -#define DEFINE_LISP_SYMBOL_END(name) \ +#define DEFINE_LISP_SYMBOL(name) \ + DEFINE_GDB_SYMBOL_BEGIN (Lisp_Object, name) \ DEFINE_GDB_SYMBOL_END (LISP_INITIALLY (XLI_BUILTIN_LISPSYM (i##name))) +/* By default, define macros for Qt, etc., as this leads to a bit + better performance in the core Emacs interpreter. A plugin can + define DEFINE_NONNIL_Q_SYMBOL_MACROS to be false, to be portable to + other Emacs instances that assign different values to Qt, etc. */ +#ifndef DEFINE_NONNIL_Q_SYMBOL_MACROS +# define DEFINE_NONNIL_Q_SYMBOL_MACROS true +#endif + #include "globals.h" /* Convert a Lisp_Object to the corresponding EMACS_INT and vice versa. commit e39d96ebe4c342885433afc28232197ce398fe71 Author: Oleh Krehel Date: Thu Feb 12 11:22:16 2015 +0100 gdb-mi.el (gdb-display-io-nopopup): New defcustom. * lisp/progmodes/gdb-mi.el (gdb-inferior-filter): Don't pop up the buried output buffer when `gdb-display-io-nopopup' is non-nil. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index b56a5d1..ff2755d 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,9 @@ +2015-02-12 Oleh Krehel + + * progmodes/gdb-mi.el (gdb-display-io-nopopup): New defcustom. + (gdb-inferior-filter): Don't pop up the buried output buffer when + `gdb-display-io-nopopup' is non-nil. + 2015-02-12 Fabián Ezequiel Gallina python.el: Allow killing shell buffer if process is dead. (Bug#19823) diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index 27846ed..486d672 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -1629,9 +1629,19 @@ this trigger is subscribed to `gdb-buf-publisher' and called with :syntax-table nil :abbrev-table nil (make-comint-in-buffer "gdb-inferior" (current-buffer) nil)) +(defcustom gdb-display-io-nopopup nil + "When non-nil, and the 'gdb-inferior-io buffer is buried, don't pop it up." + :type 'boolean + :group 'gdb + :version "25.1") + (defun gdb-inferior-filter (proc string) (unless (string-equal string "") - (gdb-display-buffer (gdb-get-buffer-create 'gdb-inferior-io))) + (let (buf) + (unless (and gdb-display-io-nopopup + (setq buf (gdb-get-buffer 'gdb-inferior-io)) + (null (get-buffer-window buf))) + (gdb-display-buffer (gdb-get-buffer-create 'gdb-inferior-io))))) (with-current-buffer (gdb-get-buffer-create 'gdb-inferior-io) (comint-output-filter proc string))) commit c7d9dec837b0e372032ce2f103967e120729c7b4 Author: Katsumi Yamaoka Date: Thu Feb 12 09:39:24 2015 +0000 lisp/gnus/gnus-art.el (gnus-article-browse-html-save-cid-content, gnus-article-browse-html-parts): Make cid file names relative if and only if html doesn't specify directory diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index f21d01f..f29a53e 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,9 @@ +2015-02-12 Katsumi Yamaoka + + * gnus-art.el (gnus-article-browse-html-save-cid-content) + (gnus-article-browse-html-parts): Make cid file names relative if and + only if html doesn't specify directory. + 2015-02-11 Lars Ingebrigtsen * gnus-art.el (gnus-treat-buttonize): Don't re-buttonize URLs in HTML diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 4ad0601..b3121bf 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -2792,11 +2792,12 @@ summary buffer." (setq gnus-article-browse-html-temp-list nil)) gnus-article-browse-html-temp-list) -(defun gnus-article-browse-html-save-cid-content (cid handles directory) +(defun gnus-article-browse-html-save-cid-content (cid handles directory abs) "Find CID content in HANDLES and save it in a file in DIRECTORY. -Return file name." +Return absolute file name if ABS is non-nil, otherwise relative to +the parent of DIRECTORY." (save-match-data - (let (file) + (let (file afile) (catch 'found (dolist (handle handles) (cond @@ -2806,19 +2807,21 @@ Return file name." ((not (or (bufferp (car handle)) (stringp (car handle))))) ((equal (mm-handle-media-supertype handle) "multipart") (when (setq file (gnus-article-browse-html-save-cid-content - cid handle directory)) + cid handle directory abs)) (throw 'found file))) ((equal (concat "<" cid ">") (mm-handle-id handle)) - (setq file - (expand-file-name - (or (mm-handle-filename handle) - (concat - (make-temp-name "cid") - (car (rassoc (car (mm-handle-type handle)) - mailcap-mime-extensions)))) - directory)) - (mm-save-part-to-file handle file) - (throw 'found file)))))))) + (setq file (or (mm-handle-filename handle) + (concat + (make-temp-name "cid") + (car (rassoc (car (mm-handle-type handle)) + mailcap-mime-extensions)))) + afile (expand-file-name file directory)) + (mm-save-part-to-file handle afile) + (throw 'found (if abs + afile + (concat (file-name-nondirectory + (directory-file-name directory)) + "/" file)))))))))) (defun gnus-article-browse-html-parts (list &optional header) "View all \"text/html\" parts from LIST. @@ -2854,8 +2857,13 @@ message header will be added to the bodies of the \"text/html\" parts." (insert content) ;; resolve cid contents (let ((case-fold-search t) - cid-file) + abs st cid-file) (goto-char (point-min)) + (when (re-search-forward "]" nil t) + (setq st (match-end 0) + abs (or + (not (re-search-forward "]" nil t)) + (re-search-backward "]" st t)))) (while (re-search-forward "\ ]+[\t\n ]+\\)*src=\"\\(cid:\\([^\"]+\\)\\)\"" nil t) @@ -2869,17 +2877,19 @@ message header will be added to the bodies of the \"text/html\" parts." (match-string 2) (with-current-buffer gnus-article-buffer gnus-article-mime-handles) - cid-dir)) - (when (eq system-type 'cygwin) + cid-dir abs)) + (when abs (setq cid-file - (concat "/" (substring + (if (eq system-type 'cygwin) + (concat "file:///" + (substring (with-output-to-string (call-process "cygpath" nil standard-output nil "-m" cid-file)) - 0 -1)))) - (replace-match (concat "file://" cid-file) - nil nil nil 1)))) + 0 -1)) + (concat "file://" cid-file)))) + (replace-match cid-file nil nil nil 1)))) (unless content (setq content (buffer-string)))) (when (or charset header (not file)) (setq tmp-file (mm-make-temp-file commit da726ad0c6177a3442a374a135f40a24945d362c Author: Fabián Ezequiel Gallina Date: Thu Feb 12 00:41:07 2015 -0300 python.el: Allow killing shell buffer if process is dead. Fixes: debbugs:19823 * lisp/progmodes/python.el (python-shell-font-lock-kill-buffer): Don't require a running process. (python-shell-font-lock-post-command-hook): Fontify only if the shell process is running. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 6c51e2a..b56a5d1 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,12 @@ +2015-02-12 Fabián Ezequiel Gallina + + python.el: Allow killing shell buffer if process is dead. (Bug#19823) + + * progmodes/python.el (python-shell-font-lock-kill-buffer): Don't + require a running process. + (python-shell-font-lock-post-command-hook): Fontify only if the + shell process is running. + 2015-02-11 Stefan Monnier * hi-lock.el (hi-lock-unface-buffer): Don't call diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index be747d0..2026609 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -2301,12 +2301,11 @@ Signals an error if no shell buffer is available for current buffer." (defun python-shell-font-lock-kill-buffer () "Kill the font-lock buffer safely." - (python-shell-with-shell-buffer - (when (and python-shell--font-lock-buffer - (buffer-live-p python-shell--font-lock-buffer)) - (kill-buffer python-shell--font-lock-buffer) - (when (derived-mode-p 'inferior-python-mode) - (setq python-shell--font-lock-buffer nil))))) + (when (and python-shell--font-lock-buffer + (buffer-live-p python-shell--font-lock-buffer)) + (kill-buffer python-shell--font-lock-buffer) + (when (derived-mode-p 'inferior-python-mode) + (setq python-shell--font-lock-buffer nil)))) (defmacro python-shell-font-lock-with-font-lock-buffer (&rest body) "Execute the forms in BODY in the font-lock buffer. @@ -2357,7 +2356,8 @@ goes wrong and syntax highlighting in the shell gets messed up." (defun python-shell-font-lock-post-command-hook () "Fontifies current line in shell buffer." (let ((prompt-end (cdr (python-util-comint-last-prompt)))) - (when (and prompt-end (> (point) prompt-end)) + (when (and prompt-end (> (point) prompt-end) + (process-live-p (get-buffer-process (current-buffer)))) (let* ((input (buffer-substring-no-properties prompt-end (point-max))) (start-pos prompt-end) commit 511acc77a4b0be3ed997c335f270b346a4ed0d5f Author: Artur Malabarba Date: Wed Feb 11 14:53:21 2015 +0000 emacs-lisp/package.el: Indicate incompatible packages. These are packages which require a higher emacs version than the current one. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index def4620..6c51e2a 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -16,6 +16,15 @@ version of seq-reverse that works on sequences in Emacs 24. Bump seq.el version to 1.2. +2015-02-11 Artur Malabarba + + * emacs-lisp/package.el (package--incompatible-p): New function. + Return non-nil if PKG has no chance of being installable. + (package--emacs-version-list): New variable. + (describe-package-1, package-desc-status) + (package-menu--print-info, package-menu--status-predicate): + Account for the "incompat" status. + 2015-02-11 Martin Rudalics * frame.el (toggle-frame-maximized, toggle-frame-fullscreen): diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 60cf65d..67e2f40 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1796,7 +1796,9 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." (pkg-dir (insert (propertize (if (member status '("unsigned" "dependency")) "Installed" - (capitalize status)) ;FIXME: Why comment-face? + (if (equal status "incompat") + "Incompatible" + (capitalize status))) ;FIXME: Why comment-face? 'font-lock-face 'font-lock-comment-face)) (insert " in `") ;; Todo: Add button for uninstalling. @@ -2054,6 +2056,25 @@ package PKG-DESC, add one. The alist is keyed with PKG-DESC." (defvar package-list-unsigned nil "If non-nil, mention in the list which packages were installed w/o signature.") +(defvar package--emacs-version-list (version-to-list emacs-version) + "`emacs-version', as a list.") + +(defun package--incompatible-p (pkg) + "Return non-nil if PKG has no chance of being installable. +PKG is a package-desc object. +Return value is a string describing the reason why the package is +incompatible. + +Currently, this only checks if PKG depends on a higher +`emacs-version' than the one being used." + (let* ((reqs (package-desc-reqs pkg)) + (version (cadr (assq 'emacs reqs)))) + (if (and version (version-list-< package--emacs-version-list version)) + (format "`%s' requires Emacs %s, but current version is %s" + (package-desc-full-name pkg) + (package-version-join version) + emacs-version)))) + (defun package-desc-status (pkg-desc) (let* ((name (package-desc-name pkg-desc)) (dir (package-desc-dir pkg-desc)) @@ -2072,6 +2093,7 @@ package PKG-DESC, add one. The alist is keyed with PKG-DESC." ((version-list-< version hv) "obsolete") (t "disabled")))) ((package-built-in-p name version) "obsolete") + ((package--incompatible-p pkg-desc) "incompat") (dir ;One of the installed packages. (cond ((not (file-exists-p (package-desc-dir pkg-desc))) "deleted") @@ -2222,6 +2244,7 @@ Return (PKG-DESC [NAME VERSION STATUS DOC])." (`"installed" 'font-lock-comment-face) (`"dependency" 'font-lock-comment-face) (`"unsigned" 'font-lock-warning-face) + (`"incompat" 'font-lock-comment-face) (_ 'font-lock-warning-face)))) ; obsolete. (list pkg-desc `[,(list (symbol-name (package-desc-name pkg-desc)) @@ -2492,6 +2515,8 @@ Optional argument NOQUERY non-nil means do not ask the user to confirm." ((string= sB "built-in") nil) ((string= sA "obsolete") t) ((string= sB "obsolete") nil) + ((string= sA "incompat") t) + ((string= sB "incompat") nil) (t (string< sA sB))))) (defun package-menu--description-predicate (A B) commit 0a66ca36fa052fbd7c0c751c96c22b5d81dec658 Author: Artur Malabarba Date: Wed Feb 11 14:53:43 2015 +0000 emacs-lisp/package.el (package-install): Invert the second argument. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 34e4e9d..def4620 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -3,6 +3,13 @@ * hi-lock.el (hi-lock-unface-buffer): Don't call font-lock-remove-keywords if not needed (bug#19737). +2015-02-11 Artur Malabarba + + * emacs-lisp/package.el (package-install): Invert the second + argument, for better backwards compatibility. + (package-install-button-action, package-reinstall) + (package-menu-execute): Account for the change. + 2015-02-11 Nicolas Petton * emacs-lisp/seq.el (seq-reverse): Add a backward-compatible diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index c3a2061..60cf65d 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1221,15 +1221,15 @@ using `package-compute-transaction'." (mapc #'package-install-from-archive packages)) ;;;###autoload -(defun package-install (pkg &optional mark-selected) +(defun package-install (pkg &optional dont-select) "Install the package PKG. PKG can be a package-desc or the package name of one the available packages in an archive in `package-archives'. Interactively, prompt for its name. -If called interactively or if MARK-SELECTED is non-nil, add PKG -to `package-selected-packages'. +If called interactively or if DONT-SELECT nil, add PKG to +`package-selected-packages'. -if PKG is a package-desc and it is already installed, don't try +If PKG is a package-desc and it is already installed, don't try to install it but still mark it as selected." (interactive (progn @@ -1247,11 +1247,11 @@ to install it but still mark it as selected." (symbol-name (car elt)))) package-archive-contents)) nil t)) - t))) + nil))) (let ((name (if (package-desc-p pkg) (package-desc-name pkg) pkg))) - (when (and mark-selected (not (package--user-selected-p name))) + (unless (or dont-select (package--user-selected-p name)) (customize-save-variable 'package-selected-packages (cons name package-selected-packages)))) (if (package-desc-p pkg) @@ -1276,7 +1276,7 @@ object." (package-delete (if (package-desc-p pkg) pkg (cadr (assq pkg package-alist))) 'force 'nosave) - (package-install pkg)) + (package-install pkg 'dont-select)) (defun package-strip-rcs-id (str) "Strip RCS version ID from the version string STR. @@ -1929,7 +1929,7 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." (let ((pkg-desc (button-get button 'package-desc))) (when (y-or-n-p (format "Install package `%s'? " (package-desc-full-name pkg-desc))) - (package-install pkg-desc 1) + (package-install pkg-desc nil) (revert-buffer nil t) (goto-char (point-min))))) @@ -2427,13 +2427,11 @@ Optional argument NOQUERY non-nil means do not ask the user to confirm." (mapconcat #'package-desc-full-name install-list ", "))))) (mapc (lambda (p) - ;; Mark as selected if it's the exact version of a - ;; package that's already installed, or if it's not - ;; installed at all. Don't mark if it's a new - ;; version of an installed package. - (package-install p (or (package-installed-p p) - (not (package-installed-p - (package-desc-name p)))))) + ;; Don't mark as selected if it's a new version of + ;; an installed package. + (package-install p (and (not (package-installed-p p)) + (package-installed-p + (package-desc-name p))))) install-list))) ;; Delete packages, prompting if necessary. (when delete-list commit 517fc7b612344535087dc54178bd464fe9a74d1f Author: Stefan Monnier Date: Wed Feb 11 16:37:49 2015 -0500 * lisp/hi-lock.el: Don't call font-lock-remove-keywords if not needed. Fixes: debbugs:19737 (hi-lock-unface-buffer): Don't call font-lock-remove-keywords if not needed. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 7e45b9d..34e4e9d 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2015-02-11 Stefan Monnier + + * hi-lock.el (hi-lock-unface-buffer): Don't call + font-lock-remove-keywords if not needed (bug#19737). + 2015-02-11 Nicolas Petton * emacs-lisp/seq.el (seq-reverse): Add a backward-compatible @@ -8,8 +13,7 @@ * frame.el (toggle-frame-maximized, toggle-frame-fullscreen): Rename frame parameter `maximized' to `fullscreen-restore'. - Restore fullwidth/-height after fullboth state. Update - doc-strings. + Restore fullwidth/-height after fullboth state. Update doc-strings. 2015-02-11 Lars Ingebrigtsen @@ -23,8 +27,8 @@ * net/shr.el (shr-use-fonts): New variable. (shr-fill-text): Rename from "fold". - (shr-pixel-column, shr-pixel-region, shr-string-pixel-width): New - functions. + (shr-pixel-column, shr-pixel-region, shr-string-pixel-width): + New functions. (shr-insert): Just insert, don't fill the text. Filling is now done afterwards per display unit. (shr-fill-lines, shr-fill-line): New functions to fill text on a diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el index 65a4561..d74664a 100644 --- a/lisp/hi-lock.el +++ b/lisp/hi-lock.el @@ -596,7 +596,12 @@ then remove all hi-lock highlighting." ;; Make `face' the next one to use by default. (when (symbolp face) ;Don't add it if it's a list (bug#13297). (add-to-list 'hi-lock--unused-faces (face-name face)))) - (font-lock-remove-keywords nil (list keyword)) + ;; FIXME: Calling `font-lock-remove-keywords' causes + ;; `font-lock-specified-p' to go from nil to non-nil (because it + ;; calls font-lock-set-defaults). This is yet-another bug in + ;; font-lock-add/remove-keywords, which we circumvent here by + ;; testing `font-lock-fontified' (bug#19737). + (if font-lock-fontified (font-lock-remove-keywords nil (list keyword))) (setq hi-lock-interactive-patterns (delq keyword hi-lock-interactive-patterns)) (remove-overlays commit 4fb5565d0a0cd9640a242028c92b8b4e2bd4683e Author: Nicolas Petton Date: Wed Feb 11 09:21:03 2015 +0100 Add a backward-compatible version of seq-reverse * lisp/emacs-lisp/seq.el (seq-reverse): Add a backward-compatible version of seq-reverse that works on sequences in Emacs 24. Bump version to 1.2. * test/automated/seq-tests.el (test-seq-reverse, test-seq-group-by): Add a test for seq-reverse and update test for seq-group-by to test vectors and strings, not only lists. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index ece253b..7e45b9d 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,7 +1,8 @@ -2015-02-09 Nicolas Petton +2015-02-11 Nicolas Petton - * emacs-lisp/seq.el (seq-group-by): Improves seq-group-by to - return sequence elements in correct order. + * emacs-lisp/seq.el (seq-reverse): Add a backward-compatible + version of seq-reverse that works on sequences in Emacs 24. + Bump seq.el version to 1.2. 2015-02-11 Martin Rudalics @@ -74,6 +75,11 @@ (python-shell-font-lock-turn-off): Fix typo. (python-util-text-properties-replace-name): Delete function. +2015-02-09 Nicolas Petton + + * emacs-lisp/seq.el (seq-group-by): Improves seq-group-by to + return sequence elements in correct order. + 2015-02-09 Simen Heggestøyl (tiny change) * textmodes/css-mode.el (css-smie-rules): Fix paren indent (bug#19815). diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 5fbec18..ad4c353 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -4,7 +4,7 @@ ;; Author: Nicolas Petton ;; Keywords: sequences -;; Version: 1.1.1 +;; Version: 1.2 ;; Maintainer: emacs-devel@gnu.org @@ -171,9 +171,7 @@ The result is a sequence of the same type as SEQ." (if (listp seq) (sort (seq-copy seq) pred) (let ((result (seq-sort pred (append seq nil)))) - (cond ((stringp seq) (concat result)) - ((vectorp seq) (vconcat result)) - (t (error "Unsupported sequence: %s" seq)))))) + (seq--into result (type-of seq))))) (defun seq-contains-p (seq elt &optional testfn) "Return the first element in SEQ that equals to ELT. @@ -256,6 +254,27 @@ keys. Keys are compared using `equal'." (seq-reverse seq) nil)) +(defalias 'seq-reverse + (if (ignore-errors (reverse [1 2])) + #'reverse + (lambda (seq) + "Return the reversed copy of list, vector, or string SEQ. +See also the function `nreverse', which is used more often." + (let ((result '())) + (seq-map (lambda (elt) (push elt result)) + seq) + (if (listp seq) + result + (seq--into result (type-of seq))))))) + +(defun seq--into (seq type) + "Convert the sequence SEQ into a sequence of type TYPE." + (pcase type + (`vector (vconcat seq)) + (`string (concat seq)) + (`list (append seq nil)) + (t (error "Not a sequence type name: %s" type)))) + (defun seq--drop-list (list n) "Return a list from LIST without its first N elements. This is an optimization for lists in `seq-drop'." @@ -299,7 +318,6 @@ This is an optimization for lists in `seq-take-while'." (defalias 'seq-copy #'copy-sequence) (defalias 'seq-elt #'elt) -(defalias 'seq-reverse #'reverse) (defalias 'seq-length #'length) (defalias 'seq-do #'mapc) (defalias 'seq-each #'seq-do) diff --git a/test/ChangeLog b/test/ChangeLog index b080961..979214c 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -1,3 +1,9 @@ +2015-02-11 Nicolas Petton + + * automated/seq-tests.el (test-seq-reverse, test-seq-group-by): + Add a test for seq-reverse and update test for seq-group-by to + test vectors and strings, not only lists. + 2015-02-10 Glenn Morris * automated/package-test.el (package-test-signed): diff --git a/test/automated/seq-tests.el b/test/automated/seq-tests.el index b92a15c..badb326 100644 --- a/test/automated/seq-tests.el +++ b/test/automated/seq-tests.el @@ -216,10 +216,17 @@ Evaluate BODY for each created sequence. (should (equal (seq-partition '(1 2 3) -1) '()))) (ert-deftest test-seq-group-by () - (should (equal (seq-group-by #'test-sequences-oddp '(1 2 3 4)) - '((t 1 3) (nil 2 4)))) + (with-test-sequences (seq '(1 2 3 4)) + (should (equal (seq-group-by #'test-sequences-oddp seq) + '((t 1 3) (nil 2 4))))) (should (equal (seq-group-by #'car '((a 1) (b 3) (c 4) (a 2))) '((b (b 3)) (c (c 4)) (a (a 1) (a 2)))))) +(ert-deftest test-seq-reverse () + (with-test-sequences (seq '(1 2 3 4)) + (should (same-contents-p (seq-reverse seq) '(4 3 2 1))) + (should (equal (type-of (seq-reverse seq)) + (type-of seq))))) + (provide 'seq-tests) ;;; seq-tests.el ends here commit c49e769d8f141b0307db19ed2a5fa80e0696b1dc Author: Nicolas Petton Date: Mon Feb 9 13:14:52 2015 +0100 Improve seq-group-by to return sequence elements in correct order * lisp/emacs-lisp/seq.el (seq-group-by): Improves seq-group-by to return sequence elements in correct order * tests/automated/seq-tests.el: Update test for seq-group-by * doc/lispref/sequences.texi (Sequence Functions): Update documentation examples for seq-group-by diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index d82be3c..285c725 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -4,6 +4,11 @@ fullscreen frame parameter. Describe `fullscreen-restore' parameter. +2015-02-09 Nicolas Petton + + * sequences.texi (Sequence Functions): Update documentation + examples for seq-group-by. + 2015-02-09 Eli Zaretskii * positions.texi (Screen Lines): Update the documentation of diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index f268c0d..04404f8 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -731,11 +731,11 @@ of @var{sequence}. Keys are compared using @code{equal}. @example @group (seq-group-by #'integerp '(1 2.1 3 2 3.2)) -@result{} ((t 2 3 1) (nil 3.2 2.1)) +@result{} ((t 1 3 2) (nil 2.1 3.2)) @end group @group (seq-group-by #'car '((a 1) (b 2) (a 3) (c 4))) -@result{} ((a (a 3) (a 1)) (b (b 2)) (c (c 4))) +@result{} ((b (b 2)) (a (a 1) (a 3)) (c (c 4))) @end group @end example @end defun diff --git a/lisp/ChangeLog b/lisp/ChangeLog index a6e5f59..ece253b 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2015-02-09 Nicolas Petton + + * emacs-lisp/seq.el (seq-group-by): Improves seq-group-by to + return sequence elements in correct order. + 2015-02-11 Martin Rudalics * frame.el (toggle-frame-maximized, toggle-frame-fullscreen): diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 025d94e..5fbec18 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -4,7 +4,7 @@ ;; Author: Nicolas Petton ;; Keywords: sequences -;; Version: 1.1 +;; Version: 1.1.1 ;; Maintainer: emacs-devel@gnu.org @@ -245,17 +245,16 @@ negative integer or 0, nil is returned." "Apply FUNCTION to each element of SEQ. Separate the elements of SEQ into an alist using the results as keys. Keys are compared using `equal'." - (nreverse - (seq-reduce - (lambda (acc elt) - (let* ((key (funcall function elt)) - (cell (assoc key acc))) - (if cell - (setcdr cell (push elt (cdr cell))) - (push (list key elt) acc)) - acc)) - seq - nil))) + (seq-reduce + (lambda (acc elt) + (let* ((key (funcall function elt)) + (cell (assoc key acc))) + (if cell + (setcdr cell (push elt (cdr cell))) + (push (list key elt) acc)) + acc)) + (seq-reverse seq) + nil)) (defun seq--drop-list (list n) "Return a list from LIST without its first N elements. diff --git a/test/ChangeLog b/test/ChangeLog index 74fc7ce..b080961 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -3,6 +3,12 @@ * automated/package-test.el (package-test-signed): More informative failure messages. +2015-02-09 Nicolas Petton + + * automated/seq-tests.el (test-seq-group-by): Update test for + seq-group-by to check that sequence elements are returned in the + correct order. + 2015-02-07 Fabián Ezequiel Gallina * automated/python-tests.el (python-eldoc--get-symbol-at-point-1) diff --git a/test/automated/seq-tests.el b/test/automated/seq-tests.el index ecbc004..b92a15c 100644 --- a/test/automated/seq-tests.el +++ b/test/automated/seq-tests.el @@ -216,10 +216,10 @@ Evaluate BODY for each created sequence. (should (equal (seq-partition '(1 2 3) -1) '()))) (ert-deftest test-seq-group-by () - (should (equal (seq-group-by #'test-sequences-oddp [1 2 3 4]) - '((t 3 1) (nil 4 2)))) + (should (equal (seq-group-by #'test-sequences-oddp '(1 2 3 4)) + '((t 1 3) (nil 2 4)))) (should (equal (seq-group-by #'car '((a 1) (b 3) (c 4) (a 2))) - '((a (a 2) (a 1)) (b (b 3)) (c (c 4)))))) + '((b (b 3)) (c (c 4)) (a (a 1) (a 2)))))) (provide 'seq-tests) ;;; seq-tests.el ends here commit 061c7e2b5a5a5854b2b85f2ace5b1d9222dd7f11 Author: Martin Rudalics Date: Wed Feb 11 11:02:03 2015 +0100 Add manual entry for fullscreen-restore parameter. * frames.texi (Size Parameters): Describe `fullscreen-restore' parameter. diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index 3e5d9ac..d82be3c 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,7 +1,8 @@ 2015-02-11 Martin Rudalics * frames.texi (Size Parameters): Update description of - fullscreen frame parameter. + fullscreen frame parameter. Describe `fullscreen-restore' + parameter. 2015-02-09 Eli Zaretskii diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 559f4cc..0b8106d 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -757,6 +757,24 @@ make a frame truly appear ``maximized'' or ``fullscreen''. Moreover, some window managers might not support smooth transition between the various fullscreen or maximization states. Customizing the variable @code{x-frame-normalize-before-maximize} can help to overcome that. + +@vindex fullscreen-restore, a frame parameter +@item fullscreen-restore +This parameter specifies the desired ``fullscreen'' state of the frame +after invoking the @code{toggle-frame-fullscreen} command (@pxref{Frame +Commands,,, emacs, The GNU Emacs Manual}) in the ``fullboth'' state. +Normally this parameter is installed automatically by that command when +toggling the state to fullboth. If, however, you start Emacs in the +fullboth state, you have to specify the desired behavior in your initial +file as, for example + +@example +(setq default-frame-alist + '((fullscreen . fullboth) (fullscreen-restore . fullheight))) +@end example + +This will give a new frame full height after typing in it @key{F11} for +the first time. @end table diff --git a/lisp/frame.el b/lisp/frame.el index dfcebf1..0096ef9 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1906,7 +1906,7 @@ is already fullscreen. Before making the frame fullscreen remember the current value of the frame's `fullscreen' parameter in the `fullscreen-restore' parameter of the frame. That value is used to restore the -frame's size when toggling fullscreen the next time. +frame's fullscreen state when toggling fullscreen the next time. Note that with some window managers you may have to set `frame-resize-pixelwise' to non-nil in order to make a frame