commit 1a99d5dda2460946b1035827bd2407b5f0d8336c (HEAD, refs/remotes/origin/master) Author: Lars Ingebrigtsen Date: Fri Oct 14 01:35:15 2016 +0200 Cosmetic change to last mm-url change * lisp/gnus/mm-url.el (mm-url-encode-multipart-form-data): Tweak last change slightly for more readability. diff --git a/lisp/gnus/mm-url.el b/lisp/gnus/mm-url.el index d5debdb..76c3772 100644 --- a/lisp/gnus/mm-url.el +++ b/lisp/gnus/mm-url.el @@ -411,41 +411,43 @@ DATA is a list where the elements can have the following form: (\"filename\" . \"FILENAME\") (\"content-type\" . \"CONTENT-TYPE\") (\"filedata\" . \"FILEDATA\"))) -Lowercase names above are literals and uppercase can -be various values." +Lowercase strings above are literals and uppercase are not." ;; RFC1867 - ;; Get a good boundary + ;; Get a good boundary. (unless boundary (setq boundary (mml-compute-boundary '()))) (with-temp-buffer (set-buffer-multibyte nil) - (cl-loop for (name . value) in data - do (insert "--" boundary "\r\n") - (cond - ((equal name "file") - (insert (format "Content-Disposition: form-data; name=%S; filename=%S\r\n" - (or (cdr (assoc "name" value)) name) - (cdr (assoc "filename" value)))) - (insert "Content-Transfer-Encoding: binary\r\n") - (insert (format "Content-Type: %s\r\n\r\n" - (or (cdr (assoc "content-type" value)) - "text/plain"))) - (let ((filedata (cdr (assoc "filedata" value)))) - (cond - ((stringp filedata) - (insert filedata)) - ;; How can this possibly be useful? - ((integerp filedata) - (insert (number-to-string filedata)))))) - ((equal name "submit") - (insert - "Content-Disposition: form-data; name=\"submit\"\r\n\r\nSubmit\r\n")) - (t - (insert (format "Content-Disposition: form-data; name=%S\r\n\r\n" - name)) - (insert value))) - (unless (bolp) - (insert "\r\n"))) + (dolist (elem data) + (let ((name (car elem)) + (value (cdr elem))) + (insert "--" boundary "\r\n") + (cond + ((equal name "file") + (insert (format + "Content-Disposition: form-data; name=%S; filename=%S\r\n" + (or (cdr (assoc "name" value)) name) + (cdr (assoc "filename" value)))) + (insert "Content-Transfer-Encoding: binary\r\n") + (insert (format "Content-Type: %s\r\n\r\n" + (or (cdr (assoc "content-type" value)) + "text/plain"))) + (let ((filedata (cdr (assoc "filedata" value)))) + (cond + ((stringp filedata) + (insert filedata)) + ;; How can this possibly be useful? + ((integerp filedata) + (insert (number-to-string filedata)))))) + ((equal name "submit") + (insert + "Content-Disposition: form-data; name=\"submit\"\r\n\r\nSubmit\r\n")) + (t + (insert (format "Content-Disposition: form-data; name=%S\r\n\r\n" + name)) + (insert value))) + (unless (bolp) + (insert "\r\n")))) (insert "--" boundary "--\r\n") (buffer-string))) commit a6e0188dffc394698d9ffbef50401f14a31c8722 Author: Lars Ingebrigtsen Date: Thu Oct 13 21:39:29 2016 +0200 Fix problem with submitting binary data via HTTP forms * lisp/gnus/mm-url.el (mm-url-encode-multipart-form-data): Document the parameters, clean up the code, and make uploading binary data really work (which it didn't if the binary bits were in the last part of the data). diff --git a/lisp/gnus/mm-url.el b/lisp/gnus/mm-url.el index cbea134..d5debdb 100644 --- a/lisp/gnus/mm-url.el +++ b/lisp/gnus/mm-url.el @@ -402,43 +402,52 @@ spaces. Die Die Die." (autoload 'mml-compute-boundary "mml") -(defun mm-url-encode-multipart-form-data (pairs &optional boundary) - "Return PAIRS encoded in multipart/form-data." +(defun mm-url-encode-multipart-form-data (data &optional boundary) + "Return DATA encoded in multipart/form-data. +DATA is a list where the elements can have the following form: + (\"NAME\" . \"VALUE\") + (\"submit\") + (\"file\" . ((\"name\" . \"NAME\") + (\"filename\" . \"FILENAME\") + (\"content-type\" . \"CONTENT-TYPE\") + (\"filedata\" . \"FILEDATA\"))) +Lowercase names above are literals and uppercase can +be various values." ;; RFC1867 ;; Get a good boundary (unless boundary (setq boundary (mml-compute-boundary '()))) - (concat - ;; Start with the boundary - "--" boundary "\r\n" - ;; Create name value pairs - (mapconcat - 'identity - ;; Delete any returned items that are empty - (delq nil - (mapcar (lambda (data) - (cond ((equal (car data) "file") - ;; For each pair - (format - ;; Encode the name - "Content-Disposition: form-data; name=%S; filename=%S\r\nContent-Type: text/plain; charset=utf-8\r\nContent-Transfer-Encoding: binary\r\n\r\n%s" - (cdr (assoc "name" (cdr data))) (cdr (assoc "filename" (cdr data))) - (cond ((stringp (cdr (assoc "filedata" (cdr data)))) - (cdr (assoc "filedata" (cdr data)))) - ((integerp (cdr (assoc "filedata" (cdr data)))) - (number-to-string (cdr (assoc "filedata" (cdr data)))))))) - ((equal (car data) "submit") - "Content-Disposition: form-data; name=\"submit\"\r\n\r\nSubmit\r\n") - (t - (format - "Content-Disposition: form-data;name=%S\r\n\r\n%s\r\n" - (car data) (concat (mm-url-form-encode-xwfu (cdr data))) - )))) - pairs)) - ;; use the boundary as a separator - (concat "\r\n--" boundary "\r\n")) - ;; put a boundary at the end. - "--" boundary "--\r\n")) + (with-temp-buffer + (set-buffer-multibyte nil) + (cl-loop for (name . value) in data + do (insert "--" boundary "\r\n") + (cond + ((equal name "file") + (insert (format "Content-Disposition: form-data; name=%S; filename=%S\r\n" + (or (cdr (assoc "name" value)) name) + (cdr (assoc "filename" value)))) + (insert "Content-Transfer-Encoding: binary\r\n") + (insert (format "Content-Type: %s\r\n\r\n" + (or (cdr (assoc "content-type" value)) + "text/plain"))) + (let ((filedata (cdr (assoc "filedata" value)))) + (cond + ((stringp filedata) + (insert filedata)) + ;; How can this possibly be useful? + ((integerp filedata) + (insert (number-to-string filedata)))))) + ((equal name "submit") + (insert + "Content-Disposition: form-data; name=\"submit\"\r\n\r\nSubmit\r\n")) + (t + (insert (format "Content-Disposition: form-data; name=%S\r\n\r\n" + name)) + (insert value))) + (unless (bolp) + (insert "\r\n"))) + (insert "--" boundary "--\r\n") + (buffer-string))) (defun mm-url-remove-markup () "Remove all HTML markup, leaving just plain text." commit 4c620c20d4cfd15e6c54fc10c1000dabc01064f7 Author: Mark Oteiza Date: Thu Oct 13 14:41:46 2016 -0400 * lisp/time.el (display-time-string-forms): Fix custom type. diff --git a/lisp/time.el b/lisp/time.el index 651dd56..a0419c9 100644 --- a/lisp/time.el +++ b/lisp/time.el @@ -314,7 +314,7 @@ For example, the form (if mail \" Mail\" \"\")) would give mode line times like `94/12/30 21:07:48 (UTC)'." - :type 'sexp + :type '(repeat sexp) :group 'display-time) (defun display-time-event-handler () commit 506a97a58d0cff595f13e6238b59c9e8c70440d5 Author: Mark Oteiza Date: Thu Oct 13 14:29:32 2016 -0400 Derive Man and WoMan modes from special-mode * lisp/man.el (Man-mode-map): Set parent to map composed from both button-buffer-map and special-mode-map. Remove redundant bindings. Fix menu to refer to the quit-window command. (Man-mode): Derive from special-mode. Fix docstring. Remove redundant buffer-read-only binding. (Man-quit): Remove. * lisp/woman.el (woman-really-find-file): Use setq-local. (woman-mode-map): Refer to woman-mode in docstring. (woman-mode): Derive from special-mode. Document woman-mode-map in docstring. Use setq-local where possible; imenu-generic-expression is already buffer-local. (woman-negative-vertical-space): Replace unused binding with _. diff --git a/lisp/man.el b/lisp/man.el index 0f3c4ba..82691f5 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -432,29 +432,23 @@ Otherwise, the value is whatever the function (defvar Man-mode-map (let ((map (make-sparse-keymap))) (suppress-keymap map) - (set-keymap-parent map button-buffer-map) + (set-keymap-parent map + (make-composed-keymap button-buffer-map special-mode-map)) - (define-key map [?\S-\ ] 'scroll-down-command) - (define-key map " " 'scroll-up-command) - (define-key map "\177" 'scroll-down-command) (define-key map "n" 'Man-next-section) (define-key map "p" 'Man-previous-section) (define-key map "\en" 'Man-next-manpage) (define-key map "\ep" 'Man-previous-manpage) - (define-key map ">" 'end-of-buffer) - (define-key map "<" 'beginning-of-buffer) (define-key map "." 'beginning-of-buffer) (define-key map "r" 'Man-follow-manual-reference) (define-key map "g" 'Man-goto-section) (define-key map "s" 'Man-goto-see-also-section) (define-key map "k" 'Man-kill) - (define-key map "q" 'Man-quit) (define-key map "u" 'Man-update-manpage) (define-key map "m" 'man) ;; Not all the man references get buttons currently. The text in the ;; manual page can contain references to other man pages (define-key map "\r" 'man-follow) - (define-key map "?" 'describe-mode) (easy-menu-define nil map "`Man-mode' menu." @@ -476,7 +470,7 @@ Otherwise, the value is whatever the function "--" ["Man..." man t] ["Kill Buffer" Man-kill t] - ["Quit" Man-quit t])) + ["Quit" quit-window t])) map) "Keymap for Man mode.") @@ -1474,9 +1468,7 @@ manpage command." (defvar bookmark-make-record-function) -(put 'Man-mode 'mode-class 'special) - -(define-derived-mode Man-mode fundamental-mode "Man" +(define-derived-mode Man-mode special-mode "Man" "A mode for browsing Un*x manual pages. The following man commands are available in the buffer. Try @@ -1490,7 +1482,7 @@ The following man commands are available in the buffer. Try \\[Man-previous-section] Jump to previous manpage section. \\[Man-goto-section] Go to a manpage section. \\[Man-goto-see-also-section] Jumps to the SEE ALSO manpage section. -\\[Man-quit] Deletes the manpage window, bury its buffer. +\\[quit-window] Deletes the manpage window, bury its buffer. \\[Man-kill] Deletes the manpage window, kill its buffer. \\[describe-mode] Prints this help text. @@ -1517,8 +1509,7 @@ The following key bindings are currently in effect in the buffer: mode-line-buffer-identification (list (default-value 'mode-line-buffer-identification) " {" 'Man-page-mode-string "}") - truncate-lines t - buffer-read-only t) + truncate-lines t) (buffer-disable-undo) (auto-fill-mode -1) (setq imenu-generic-expression (list (list nil Man-heading-regexp 0))) @@ -1794,11 +1785,6 @@ Specify which REFERENCE to use; default is based on word at point." (interactive) (quit-window t)) -(defun Man-quit () - "Bury the buffer containing the manpage." - (interactive) - (quit-window)) - (defun Man-goto-page (page &optional noerror) "Go to the manual page on page PAGE." (interactive diff --git a/lisp/woman.el b/lisp/woman.el index 3822ce6..45b03a9 100644 --- a/lisp/woman.el +++ b/lisp/woman.el @@ -1657,7 +1657,7 @@ Do not call directly!" (woman-insert-file-contents filename compressed) ;; Set buffer's default directory to that of the file. (setq default-directory (file-name-directory filename)) - (set (make-local-variable 'backup-inhibited) t) + (setq-local backup-inhibited t) (set-visited-file-name "") (woman-process-buffer))) @@ -1780,7 +1780,7 @@ Leave point at end of new text. Return length of inserted text." (define-key map [remap man] 'woman) (define-key map [remap man-follow] 'woman-follow) map) - "Keymap for woman mode.") + "Keymap for `woman-mode'.") (defun woman-follow (topic) "Get a Un*x manual page of the item under point and put it in a buffer." @@ -1872,15 +1872,15 @@ Argument EVENT is the invoking mouse event." (woman-reformat-last-file)) (defvar bookmark-make-record-function) -(put 'woman-mode 'mode-class 'special) -(defun woman-mode () +(define-derived-mode woman-mode special-mode "WoMan" "Turn on (most of) Man mode to browse a buffer formatted by WoMan. WoMan is an ELisp emulation of much of the functionality of the Emacs `man' command running the standard UN*X man and ?roff programs. WoMan author: F.J.Wright@Maths.QMW.ac.uk WoMan version: see `woman-version'. -See `Man-mode' for additional details." +See `Man-mode' for additional details. +\\{woman-mode-map}" (let ((Man-build-page-list (symbol-function 'Man-build-page-list)) (Man-strip-page-headers (symbol-function 'Man-strip-page-headers)) (Man-unindent (symbol-function 'Man-unindent)) @@ -1905,13 +1905,10 @@ See `Man-mode' for additional details." (kill-local-variable 'mode-line-buffer-identification) (use-local-map woman-mode-map) ;; Imenu support: - (set (make-local-variable 'imenu-generic-expression) - ;; `make-local-variable' in case imenu not yet loaded! - woman-imenu-generic-expression) - (set (make-local-variable 'imenu-space-replacement) " ") + (setq imenu-generic-expression woman-imenu-generic-expression) + (setq-local imenu-space-replacement " ") ;; Bookmark support. - (set (make-local-variable 'bookmark-make-record-function) - 'woman-bookmark-make-record) + (setq-local bookmark-make-record-function 'woman-bookmark-make-record) ;; For reformat ... ;; necessary when reformatting a file in its old buffer: (setq imenu--last-menubar-index-alist nil) @@ -1919,9 +1916,7 @@ See `Man-mode' for additional details." (setq woman-imenu-done nil) (if woman-imenu (woman-imenu)) (let ((inhibit-read-only t)) - (Man-highlight-references 'WoMan-xref-man-page)) - (set-buffer-modified-p nil) - (run-mode-hooks 'woman-mode-hook)) + (Man-highlight-references 'WoMan-xref-man-page))) (defun woman-imenu (&optional redraw) "Add a \"Contents\" menu to the menubar. @@ -3884,7 +3879,7 @@ Leave 1 blank line. Format paragraphs upto TO." ((eq c ?\t) ; skip (if (eq (following-char) ?\t) (forward-char) ; both tabs, just skip - (dotimes (i woman-tab-width) + (dotimes (_ woman-tab-width) (if (eolp) (insert ?\s) ; extend line (forward-char)) ; skip commit 8ee95221c7112a763ae6ce41c7c58b3c32ece5fc Author: Philipp Stephani Date: Wed Oct 12 22:48:32 2016 +0200 Fix crash in evaluating functions See Bug#24673 * src/eval.c (funcall_lambda): Fix crash for bogus functions such as (closure). * test/src/eval-tests.el (eval-tests--bug24673): Add test. diff --git a/src/eval.c b/src/eval.c index 2fedbf3..a9bad24 100644 --- a/src/eval.c +++ b/src/eval.c @@ -2841,9 +2841,11 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, { if (EQ (XCAR (fun), Qclosure)) { - fun = XCDR (fun); /* Drop `closure'. */ + Lisp_Object cdr = XCDR (fun); /* Drop `closure'. */ + if (! CONSP (cdr)) + xsignal1 (Qinvalid_function, fun); + fun = cdr; lexenv = XCAR (fun); - CHECK_LIST_CONS (fun, fun); } else lexenv = Qnil; diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el new file mode 100644 index 0000000..75999e1 --- /dev/null +++ b/test/src/eval-tests.el @@ -0,0 +1,35 @@ +;;; eval-tests.el --- unit tests for src/eval.c -*- lexical-binding: t; -*- + +;; Copyright (C) 2016 Free Software Foundation, Inc. + +;; Author: Philipp Stephani + +;; 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: + +;; Unit tests for src/eval.c. + +;;; Code: + +(require 'ert) + +(ert-deftest eval-tests--bug24673 () + "Checks that Bug#24673 has been fixed." + ;; This should not crash. + (should-error (funcall '(closure)) :type 'invalid-function)) + +;;; eval-tests.el ends here commit b0f1d23ec482aa71a0ae0251f6f44f4b8d261259 Author: Tino Calancha Date: Thu Oct 13 17:56:22 2016 +0900 Add test for Bug#24627 * /test/lisp/thingatpt-tests.el (thing-at-point-bug24627): New test. diff --git a/test/lisp/thingatpt-tests.el b/test/lisp/thingatpt-tests.el index d3ecbf8..2b8e067 100644 --- a/test/lisp/thingatpt-tests.el +++ b/test/lisp/thingatpt-tests.el @@ -84,4 +84,19 @@ position to retrieve THING.") (goto-char (nth 1 test)) (should (equal (thing-at-point (nth 2 test)) (nth 3 test)))))) +(ert-deftest thing-at-point-bug24627 () + "Test for http://debbugs.gnu.org/24627 ." + :expected-result :failed + (let ((file + (expand-file-name "lisp/thingatpt.el" source-directory)) + buf) + (when (file-exists-p file) + (unwind-protect + (progn + (setq buf (find-file file)) + (goto-char (point-max)) + (forward-line -1) + (should-not (thing-at-point 'list))) + (kill-buffer buf))))) + ;;; thingatpt.el ends here