commit 76fb19b359dec8556dc66dbac3ad3d333feea3c3 (HEAD, refs/remotes/origin/master) Author: Stefan Monnier Date: Sun May 29 20:45:43 2016 -0400 * lisp/wid-edit.el (link): Remove :follow-link property (bug#22434) * lisp/recentf.el (recentf-dialog-mode-map): Remove unecessary mapping. diff --git a/lisp/recentf.el b/lisp/recentf.el index df7f3e2..3321f2f 100644 --- a/lisp/recentf.el +++ b/lisp/recentf.el @@ -1064,7 +1064,6 @@ Go to the beginning of buffer if not found." (define-key km "q" 'recentf-cancel-dialog) (define-key km "n" 'next-line) (define-key km "p" 'previous-line) - (define-key km [follow-link] "\C-m") km) "Keymap used in recentf dialogs.") diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 0a0f458..9ede9a5 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -1789,7 +1789,13 @@ If END is omitted, it defaults to the length of LIST." "An embedded link." :button-prefix 'widget-link-prefix :button-suffix 'widget-link-suffix - :follow-link 'mouse-face + ;; The `follow-link' property should only be used in those contexts where the + ;; mouse-1 event normally doesn't follow the link, yet the `link' widget + ;; seems to almost always be used in contexts where (down-)mouse-1 is bound + ;; to `widget-button-click' and hence the "mouse-1 to mouse-2" remapping is + ;; not necessary (and can even be harmful). So let's not add a :follow-link + ;; by default. See (bug#22434). + ;; :follow-link 'mouse-face :help-echo "Follow the link." :format "%[%t%]") commit 190942baeff3f541abf2a937e0fb4d3f9ea104be Author: Lars Magne Ingebrigtsen Date: Sun May 29 19:42:36 2016 +0200 Fix up remainder of the mml property change * lisp/gnus/message.el (message-send-mail): Use the renamed mml-buffer-substring-no-properties-except-some function. (message-send-news): Ditto. diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index a998687..03ce789 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -4545,7 +4545,7 @@ This function could be useful in `message-setup-hook'." (setq message-options options) ;; Avoid copying text props (except hard newlines). (insert (with-current-buffer mailbuf - (mml-buffer-substring-no-properties-except-hard-newlines + (mml-buffer-substring-no-properties-except-some (point-min) (point-max)))) ;; Remove some headers. (message-encode-message-body) @@ -4909,7 +4909,7 @@ Otherwise, generate and save a value for `canlock-password' first." ;; Avoid copying text props (except hard newlines). (insert (with-current-buffer messbuf - (mml-buffer-substring-no-properties-except-hard-newlines + (mml-buffer-substring-no-properties-except-some (point-min) (point-max)))) (message-encode-message-body) ;; Remove some headers. commit b7735ab0419de3eb16560bdbab01edadecfc353e Author: Lars Ingebrigtsen Date: Sun May 29 17:59:33 2016 +0200 Allow preserving EXIF rotations when sending HTML messages * lisp/gnus/mml.el (mml--possibly-alter-image): Allow image rotation if you have exiftool installed and the image format supports it. (mml-expand-html-into-multipart-related): Use it. (mml-buffer-substring-no-properties-except-some): Renamed and copy display properties, too. diff --git a/etc/NEWS b/etc/NEWS index b2e42e3..185b1a4 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -276,6 +276,13 @@ for the ChangeLog file, if none already exists. Customize built-in IDNA support now). --- +*** When sending HTML messages with embedded images, and you have +exiftool installed, and you rotate images with EXIF data (i.e., +JPEGs), the rotational information will be inserted into the outgoing +image in the message. (The original image will not have its +orientation affected.) + +--- *** The 'message-valid-fqdn-regexp' variable has been removed, since there are now top-level domains added all the time. Message will no longer warn about sending emails to top-level domains it hasn't heard diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index 97cc87d..eae4c61 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -413,12 +413,21 @@ A message part needs to be split into %d charset parts. Really send? " (setq contents (append (list (cons 'tag-location orig-point)) contents)) (cons (intern name) (nreverse contents)))) -(defun mml-buffer-substring-no-properties-except-hard-newlines (start end) +(defun mml-buffer-substring-no-properties-except-some (start end) (let ((str (buffer-substring-no-properties start end)) - (bufstart start) tmp) - (while (setq tmp (text-property-any start end 'hard 't)) - (set-text-properties (- tmp bufstart) (- tmp bufstart -1) - '(hard t) str) + (bufstart start) + tmp) + ;; Copy over all hard newlines. + (while (setq tmp (text-property-any start end 'hard t)) + (put-text-property (- tmp bufstart) (- tmp bufstart -1) + 'hard t str) + (setq start (1+ tmp))) + ;; Copy over all `display' properties (which are usually images). + (setq start bufstart) + (while (setq tmp (text-property-not-all start end 'display nil)) + (put-text-property (- tmp bufstart) (- tmp bufstart -1) + 'display (get-text-property tmp 'display) + str) (setq start (1+ tmp))) str)) @@ -435,21 +444,21 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (if (re-search-forward "<#\\(/\\)?mml." nil t) (setq count (+ count (if (match-beginning 1) -1 1))) (goto-char (point-max)))) - (mml-buffer-substring-no-properties-except-hard-newlines + (mml-buffer-substring-no-properties-except-some beg (if (> count 0) (point) (match-beginning 0)))) (if (re-search-forward "<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)." nil t) (prog1 - (mml-buffer-substring-no-properties-except-hard-newlines + (mml-buffer-substring-no-properties-except-some beg (match-beginning 0)) (if (or (not (match-beginning 1)) (equal (match-string 2) "multipart")) (goto-char (match-beginning 0)) (when (looking-at "[ \t]*\n") (forward-line 1)))) - (mml-buffer-substring-no-properties-except-hard-newlines + (mml-buffer-substring-no-properties-except-some beg (goto-char (point-max))))))) (defvar mml-boundary nil) @@ -514,7 +523,9 @@ be \"related\" or \"alternate\"." (when (search-forward (url-filename parsed) end t) (let ((cid (format "fsf.%d" cid))) (replace-match (concat "cid:" cid) t t) - (push (list cid (url-filename parsed)) new-parts)) + (push (list cid (url-filename parsed) + (get-text-property start 'display)) + new-parts)) (setq cid (1+ cid))))))) ;; We have local images that we want to include. (if (not new-parts) @@ -527,11 +538,41 @@ be \"related\" or \"alternate\"." (setq cont (nconc cont (list `(part (type . "image/png") - (filename . ,(nth 1 new-part)) + ,@(mml--possibly-alter-image + (nth 1 new-part) + (nth 2 new-part)) (id . ,(concat "<" (nth 0 new-part) ">"))))))) cont)))) +(defun mml--possibly-alter-image (file-name image) + (if (or (null image) + (not (consp image)) + (not (eq (car image) 'image)) + (not (image-property image :rotation)) + (not (executable-find "exiftool"))) + `((filename . ,file-name)) + `((filename . ,file-name) + (buffer + . + ,(with-current-buffer (mml-generate-new-buffer " *mml rotation*") + (set-buffer-multibyte nil) + (call-process "exiftool" + file-name + (list (current-buffer) nil) + nil + (format "-Orientation#=%d" + (cl-case (truncate + (image-property image :rotation)) + (0 0) + (90 6) + (180 3) + (270 8) + (otherwise 0))) + "-o" "-" + "-") + (current-buffer)))))) + (defun mml-generate-mime-1 (cont) (let ((mm-use-ultra-safe-encoding (or mm-use-ultra-safe-encoding (assq 'sign cont)))) commit 78d3f5494b3b35b96289f8dd7a6bcb0c67228584 Author: Lars Ingebrigtsen Date: Sun May 29 17:16:07 2016 +0200 Make message-toggle-image-thumbnails work better * lisp/gnus/message.el (message-toggle-image-thumbnails): Use `insert-image' instead of `put-image' to make it possible to edit the resulting text in a sensible manner. diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 1ca7c5c..a998687 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -8386,30 +8386,32 @@ Used in `message-simplify-recipients'." (defun message-toggle-image-thumbnails () "For any included image files, insert a thumbnail of that image." (interactive) - (let ((overlays (overlays-in (point-min) (point-max))) - (displayed nil)) - (while overlays - (let ((overlay (car overlays))) - (when (overlay-get overlay 'put-image) - (delete-overlay overlay) - (setq displayed t))) - (setq overlays (cdr overlays))) + (let ((displayed nil)) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (when-let ((props (get-text-property (point) 'display))) + (when (and (consp props) + (eq (car props) 'image)) + (put-text-property (point) (1+ (point)) 'display nil) + (setq displayed t))))) (unless displayed (save-excursion (goto-char (point-min)) - (while (re-search-forward "" nil t) + (let ((string (match-string 0)) + (file (match-string 1)) (edges (window-inside-pixel-edges (get-buffer-window (current-buffer))))) - (put-image + (delete-region (match-beginning 0) (match-end 0)) + (insert-image (create-image file 'imagemagick nil :max-width (truncate (* 0.7 (- (nth 2 edges) (nth 0 edges)))) :max-height (truncate (* 0.5 (- (nth 3 edges) (nth 1 edges))))) - (match-beginning 0) - " "))))))) + string))))))) (provide 'message) commit 80dcc2370927a18fd033c928416e7d57e7addd89 Author: Alan Mackenzie Date: Sun May 29 12:22:17 2016 +0000 Rationalize the use of c-new-BEG and c-new-END in CC Mode. Remove the now redundant c-old-BOM and c-old-EOM. * lisp/progmodes/cc-engine.el (c-macro-cache-syntactic): Change and simplify meaning. (c-macro-cache-no-comment): New variable. (c-invalidate-macro-cache, c-beginning-of-macro, c-end-of-macro): incorporate the new c-macro-cache-no-comment. (c-syntactic-end-of-macro): Make better use of c-macro-cache-syntactic. (c-no-comment-end-of-macro): New function. * lisp/progmodes/cc-langs.el (c-before-font-lock-functions): Add c-extend-font-lock-region-for-macros to C/C++/ObjC value. * lisp/progmodes/cc-mode.el (c-old-BOM, c-old-EOM): Remove. (c-extend-region-for-CPP): Put results in c-new-BEG/END rather than c-old-BOM/EOM. (c-extend-font-lock-region-for-macros): Simplify meaning, no longer returning a cons for the new region, since the function is now called as an after-change function. No longer adjust c-new-END for the length of inserted/deleted text. Move the size restrictions on macros to here from c-neutralize-syntax-in-and-mark-CPP. (c-neutralize-syntax-in-and-mark-CPP): No longer adjust c-new-BEG/END here. Use c-no-comment-end-of-macro rather than c-syntactic-end-of-macro to find the upper boundary to "neutralize" syntactically obtrusive characters. (c-change-expand-fl-region): Don't set c-new-END to next BOL when already at one. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index b9f25ee..4d6a120 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -229,8 +229,12 @@ ;; The starting position from where we determined `c-macro-cache'. (defvar c-macro-cache-syntactic nil) (make-variable-buffer-local 'c-macro-cache-syntactic) -;; non-nil iff `c-macro-cache' has both elements set AND the cdr is at a -;; syntactic end of macro, not merely an apparent one. +;; Either nil, or the syntactic end of the macro currently represented by +;; `c-macro-cache'. +(defvar c-macro-cache-no-comment nil) +(make-variable-buffer-local 'c-macro-cache-no-comment) +;; Either nil, or the last character of the macro currently represented by +;; `c-macro-cache' which isn't in a comment. */ (defun c-invalidate-macro-cache (beg end) ;; Called from a before-change function. If the change region is before or @@ -242,12 +246,14 @@ ((< beg (car c-macro-cache)) (setq c-macro-cache nil c-macro-cache-start-pos nil - c-macro-cache-syntactic nil)) + c-macro-cache-syntactic nil + c-macro-cache-no-comment nil)) ((and (cdr c-macro-cache) (< beg (cdr c-macro-cache))) (setcdr c-macro-cache nil) (setq c-macro-cache-start-pos beg - c-macro-cache-syntactic nil)))) + c-macro-cache-syntactic nil + c-macro-cache-no-comment nil)))) (defun c-macro-is-genuine-p () ;; Check that the ostensible CPP construct at point is a real one. In @@ -288,7 +294,8 @@ comment at the start of cc-engine.el for more info." t)) (setq c-macro-cache nil c-macro-cache-start-pos nil - c-macro-cache-syntactic nil) + c-macro-cache-syntactic nil + c-macro-cache-no-comment nil) (save-restriction (if lim (narrow-to-region lim (point-max))) @@ -323,7 +330,8 @@ comment at the start of cc-engine.el for more info." (>= (point) (car c-macro-cache))) (setq c-macro-cache nil c-macro-cache-start-pos nil - c-macro-cache-syntactic nil)) + c-macro-cache-syntactic nil + c-macro-cache-no-comment nil)) (while (progn (end-of-line) (when (and (eq (char-before) ?\\) @@ -347,14 +355,38 @@ comment at the start of cc-engine.el for more info." (let* ((here (point)) (there (progn (c-end-of-macro) (point))) s) - (unless c-macro-cache-syntactic + (if c-macro-cache-syntactic + (goto-char c-macro-cache-syntactic) (setq s (parse-partial-sexp here there)) (while (and (or (nth 3 s) ; in a string (nth 4 s)) ; in a comment (maybe at end of line comment) (> there here)) ; No infinite loops, please. (setq there (1- (nth 8 s))) (setq s (parse-partial-sexp here there))) - (setq c-macro-cache-syntactic (car c-macro-cache))) + (setq c-macro-cache-syntactic (point))) + (point))) + +(defun c-no-comment-end-of-macro () + ;; Go to the end of a CPP directive, or a pos just before which isn't in a + ;; comment. For this purpose, open strings are ignored. + ;; + ;; This function must only be called from the beginning of a CPP construct. + ;; + ;; Note that this function might do hidden buffer changes. See the comment + ;; at the start of cc-engine.el for more info. + (let* ((here (point)) + (there (progn (c-end-of-macro) (point))) + s) + (if c-macro-cache-no-comment + (goto-char c-macro-cache-no-comment) + (setq s (parse-partial-sexp here there)) + (while (and (nth 3 s) ; in a string + (> there here)) ; No infinite loops, please. + (setq here (1+ (nth 8 s))) + (setq s (parse-partial-sexp here there))) + (when (nth 4 s) + (goto-char (1- (nth 8 s)))) + (setq c-macro-cache-no-comment (point))) (point))) (defun c-forward-over-cpp-define-id () diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index 10fed6d..6f4d1f1 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -476,7 +476,8 @@ so that all identifiers are recognized as words.") c++ '(c-extend-region-for-CPP c-before-change-check-<>-operators c-invalidate-macro-cache) - (c objc) '(c-extend-region-for-CPP c-invalidate-macro-cache) + (c objc) '(c-extend-region-for-CPP + c-invalidate-macro-cache) ;; java 'c-before-change-check-<>-operators awk 'c-awk-record-region-clear-NL) (c-lang-defvar c-get-state-before-change-functions @@ -505,9 +506,11 @@ parameters \(point-min) and \(point-max).") ;; For documentation see the following c-lang-defvar of the same name. ;; The value here may be a list of functions or a single function. t 'c-change-expand-fl-region - (c objc) '(c-neutralize-syntax-in-and-mark-CPP + (c objc) '(c-extend-font-lock-region-for-macros + c-neutralize-syntax-in-and-mark-CPP c-change-expand-fl-region) - c++ '(c-neutralize-syntax-in-and-mark-CPP + c++ '(c-extend-font-lock-region-for-macros + c-neutralize-syntax-in-and-mark-CPP c-restore-<>-properties c-change-expand-fl-region) java '(c-restore-<>-properties diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index de903b8..9ab0480 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -865,14 +865,6 @@ Note that the style variables are always made local to the buffer." ;;; Change hooks, linking with Font Lock and electric-indent-mode. -;; Buffer local variables recording Beginning/End-of-Macro position before a -;; change, when a macro straddles, respectively, the BEG or END (or both) of -;; the change region. Otherwise these have the values BEG/END. -(defvar c-old-BOM 0) -(make-variable-buffer-local 'c-old-BOM) -(defvar c-old-EOM 0) -(make-variable-buffer-local 'c-old-EOM) - (defun c-called-from-text-property-change-p () ;; Is the primitive which invoked `before-change-functions' or ;; `after-change-functions' one which merely changes text properties? This @@ -886,8 +878,8 @@ Note that the style variables are always made local to the buffer." '(put-text-property remove-list-of-text-properties))) (defun c-extend-region-for-CPP (beg end) - ;; Set c-old-BOM or c-old-EOM respectively to BEG, END, each extended to the - ;; beginning/end of any preprocessor construct they may be in. + ;; Adjust `c-new-BEG', `c-new-END' respectively to the beginning and end of + ;; any preprocessor construct they may be in. ;; ;; Point is undefined both before and after this function call; the buffer ;; has already been widened, and match-data saved. The return value is @@ -896,45 +888,33 @@ Note that the style variables are always made local to the buffer." ;; This function is in the C/C++/ObjC values of ;; `c-get-state-before-change-functions' and is called exclusively as a ;; before change function. - (goto-char beg) + (goto-char c-new-BEG) (c-beginning-of-macro) - (setq c-old-BOM (point)) + (setq c-new-BEG (point)) - (goto-char end) + (goto-char c-new-END) (when (c-beginning-of-macro) (c-end-of-macro) (or (eobp) (forward-char))) ; Over the terminating NL which may be marked ; with a c-cpp-delimiter category property - (setq c-old-EOM (point))) - -(defun c-extend-font-lock-region-for-macros (begg endd &optional old-len) - ;; Extend the region (BEGG ENDD) to cover all (possibly changed) - ;; preprocessor macros; return the cons (new-BEG . new-END). OLD-LEN should - ;; be either the old length parameter when called from an - ;; after-change-function, or nil otherwise. This defun uses the variables - ;; c-old-BOM, c-new-BOM. + (setq c-new-END (point))) + +(defun c-extend-font-lock-region-for-macros (begg endd old-len) + ;; Extend the region (c-new-BEG c-new-END) to cover all (possibly changed) + ;; preprocessor macros; The return value has no significance. ;; ;; Point is undefined on both entry and exit to this function. The buffer ;; will have been widened on entry. - (let (limits new-beg new-end) - (goto-char c-old-BOM) ; already set to old start of macro or begg. - (setq new-beg - (min begg - (if (setq limits (c-state-literal-at (point))) - (cdr limits) ; go forward out of any string or comment. - (point)))) - - (goto-char endd) - (if (setq limits (c-state-literal-at (point))) - (goto-char (car limits))) ; go backward out of any string or comment. - (if (c-beginning-of-macro) - (c-end-of-macro)) - (setq new-end (max endd - (if old-len - (+ (- c-old-EOM old-len) (- endd begg)) - c-old-EOM) - (point))) - (cons new-beg new-end))) + ;; + ;; This function is in the C/C++/ObjC value of `c-before-font-lock-functions'. + (goto-char endd) + (if (c-beginning-of-macro) + (c-end-of-macro)) + (setq c-new-END (max endd c-new-END (point))) + ;; Determine the region, (c-new-BEG c-new-END), which will get font + ;; locked. This restricts the region should there be long macros. + (setq c-new-BEG (max c-new-BEG (c-determine-limit 500 begg)) + c-new-END (min c-new-END (c-determine-+ve-limit 500 endd)))) (defun c-neutralize-CPP-line (beg end) ;; BEG and END bound a region, typically a preprocessor line. Put a @@ -963,19 +943,14 @@ Note that the style variables are always made local to the buffer." (t nil))))))) (defun c-neutralize-syntax-in-and-mark-CPP (begg endd old-len) - ;; (i) Extend the font lock region to cover all changed preprocessor - ;; regions; it does this by setting the variables `c-new-BEG' and - ;; `c-new-END' to the new boundaries. - ;; - ;; (ii) "Neutralize" every preprocessor line wholly or partially in the - ;; extended changed region. "Restore" lines which were CPP lines before the - ;; change and are no longer so; these can be located from the Buffer local - ;; variables `c-old-BOM' and `c-old-EOM'. + ;; (i) "Neutralize" every preprocessor line wholly or partially in the + ;; changed region. "Restore" lines which were CPP lines before the change + ;; and are no longer so. ;; - ;; (iii) Mark every CPP construct by placing a `category' property value + ;; (ii) Mark each CPP construct by placing a `category' property value ;; `c-cpp-delimiter' at its start and end. The marked characters are the ;; opening # and usually the terminating EOL, but sometimes the character - ;; before a comment/string delimiter. + ;; before a comment delimiter. ;; ;; That is, set syntax-table properties on characters that would otherwise ;; interact syntactically with those outside the CPP line(s). @@ -992,15 +967,8 @@ Note that the style variables are always made local to the buffer." ;; Note: SPEED _MATTERS_ IN THIS FUNCTION!!! ;; ;; This function might make hidden buffer changes. - (c-save-buffer-state (new-bounds) - ;; First determine the region, (c-new-BEG c-new-END), which will get font - ;; locked. It might need "neutralizing". This region may not start - ;; inside a string, comment, or macro. - (setq new-bounds (c-extend-font-lock-region-for-macros - c-new-BEG c-new-END old-len)) - (setq c-new-BEG (max (car new-bounds) (c-determine-limit 500 begg)) - c-new-END (min (cdr new-bounds) (c-determine-+ve-limit 500 endd))) - ;; Clear all old relevant properties. + (c-save-buffer-state (limits ) + ;; Clear 'syntax-table properties "punctuation": (c-clear-char-property-with-value c-new-BEG c-new-END 'syntax-table '(1)) ;; CPP "comment" markers: @@ -1011,6 +979,8 @@ Note that the style variables are always made local to the buffer." ;; Add needed properties to each CPP construct in the region. (goto-char c-new-BEG) + (if (setq limits (c-literal-limits)) ; Go past any literal. + (goto-char (cdr limits))) (skip-chars-backward " \t") (let ((pps-position (point)) pps-state mbeg) (while (and (< (point) c-new-END) @@ -1030,7 +1000,7 @@ Note that the style variables are always made local to the buffer." (nth 4 pps-state)))) ; in a comment? (goto-char (match-beginning 1)) (setq mbeg (point)) - (if (> (c-syntactic-end-of-macro) mbeg) + (if (> (c-no-comment-end-of-macro) mbeg) (progn (c-neutralize-CPP-line mbeg (point)) ; "punctuation" properties (if (eval-when-compile @@ -1256,10 +1226,15 @@ Note that the style variables are always made local to the buffer." ;; ;; This is called from an after-change-function, but the parameters BEG END ;; and OLD-LEN are not used. - (if font-lock-mode - (setq c-new-BEG - (or (c-fl-decl-start c-new-BEG) (c-point 'bol c-new-BEG)) - c-new-END (c-point 'bonl c-new-END)))) + (if font-lock-mode + (setq c-new-BEG + (or (c-fl-decl-start c-new-BEG) (c-point 'bol c-new-BEG)) + c-new-END + (save-excursion + (goto-char c-new-END) + (if (bolp) + (point) + (c-point 'bonl c-new-END)))))) (defun c-context-expand-fl-region (beg end) ;; Return a cons (NEW-BEG . NEW-END), where NEW-BEG is the beginning of a