diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/gnus/gnus-cloud.el | 4 | ||||
| -rw-r--r-- | lisp/help.el | 70 | ||||
| -rw-r--r-- | lisp/net/eww.el | 7 | ||||
| -rw-r--r-- | lisp/pixel-scroll.el | 10 | ||||
| -rw-r--r-- | lisp/progmodes/elisp-mode.el | 8 | ||||
| -rw-r--r-- | lisp/subr.el | 4 | ||||
| -rw-r--r-- | lisp/url/url-http.el | 2 |
7 files changed, 88 insertions, 17 deletions
diff --git a/lisp/gnus/gnus-cloud.el b/lisp/gnus/gnus-cloud.el index 409fc53df78..7e8d5e3f2f3 100644 --- a/lisp/gnus/gnus-cloud.el +++ b/lisp/gnus/gnus-cloud.el @@ -22,6 +22,10 @@ ;;; Commentary: +;; The name gnus-cloud parodizes but otherwise has little to do with +;; "cloud computing", a misleading term normally best avoided. See: +;; https://www.gnu.org/philosophy/words-to-avoid.html#CloudComputing + ;;; Code: (eval-when-compile (require 'cl)) diff --git a/lisp/help.el b/lisp/help.el index 212e3679dad..fa7f6b0d5b0 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -717,7 +717,7 @@ with `mouse-movement' events." (cursor-in-echo-area t) saved-yank-menu) (unwind-protect - (let (key down-ev) + (let (key keys down-ev discarded-up) ;; If yank-menu is empty, populate it temporarily, so that ;; "Select and Paste" menu can generate a complete event. (when (null (cdr yank-menu)) @@ -731,6 +731,7 @@ Describe the following key, mouse click, or menu item: ")) (or (and no-mouse-movement (string-match "mouse-movement" keyname)) + (progn (push key keys) nil) (and (string-match "\\(mouse\\|down\\|click\\|drag\\)" keyname) (progn @@ -738,14 +739,36 @@ Describe the following key, mouse click, or menu item: ")) ;; spuriously trigger the `sit-for'. (sleep-for 0.01) (while (read-event nil nil 0.01)) - (not (sit-for (/ double-click-time 1000.0) t)))))))) + (not (sit-for + (if (numberp double-click-time) + (/ double-click-time 1000.0) + 3.0) + t)))))))) + ;; When we have a sequence of mouse events, discard the most + ;; recent ones till we find one with a binding. + (let ((keys-1 keys)) + (while (and keys-1 + (not (key-binding (car keys-1)))) + ;; If we discard the last event, and this was a mouse + ;; up, remember this. + (if (and (eq keys-1 keys) + (vectorp (car keys-1)) + (let* ((last-idx (1- (length (car keys-1)))) + (last (aref (car keys-1) last-idx))) + (and (eventp last) + (memq 'click (event-modifiers last))))) + (setq discarded-up t)) + (setq keys-1 (cdr keys-1))) + (if keys-1 + (setq key (car keys-1)))) (list key ;; If KEY is a down-event, read and include the ;; corresponding up-event. Note that there are also ;; down-events on scroll bars and mode lines: the actual ;; event then is in the second element of the vector. - (and (vectorp key) + (and (not discarded-up) ; Don't attempt to ignore the up-event twice. + (vectorp key) (let ((last-idx (1- (length key)))) (and (eventp (aref key last-idx)) (memq 'down (event-modifiers (aref key last-idx))))) @@ -769,6 +792,28 @@ Describe the following key, mouse click, or menu item: ")) (setq yank-menu (copy-sequence saved-yank-menu)) (fset 'yank-menu (cons 'keymap yank-menu)))))) +(defun help-downify-mouse-event-type (base) + "Add \"down-\" to BASE if it is not already there. +BASE is a symbol, a mouse event type. If the modification is done, +return the new symbol. Otherwise return nil." + (let ((base-s (symbol-name base))) + ;; Note: the order of the components in the following string is + ;; determined by `apply_modifiers_uncached' in src/keyboard.c. + (string-match "\\(A-\\)?\ +\\(C-\\)?\ +\\(H-\\)?\ +\\(M-\\)?\ +\\(S-\\)?\ +\\(s-\\)?\ +\\(double-\\)?\ +\\(triple-\\)?\ +\\(up-\\)?\ +\\(\\(down-\\)?\\)\ +\\(drag-\\)?" base-s) + (when (and (null (match-beginning 11)) ; "down-" + (null (match-beginning 12))) ; "drag-" + (intern (replace-match "down-" t t base-s 10)) ))) + (defun describe-key (&optional key untranslated up-event) "Display documentation of the function invoked by KEY. KEY can be any kind of a key sequence; it can include keyboard events, @@ -828,6 +873,25 @@ temporarily enables it to allow getting help on disabled items and buttons." (princ (format " (found in %s)" key-locus)))) (princ ", which is ") (describe-function-1 defn) + (when (vectorp key) + (let* ((last (1- (length key))) + (elt (aref key last)) + (elt-1 (copy-sequence elt)) + key-1 down-event-type) + (when (and (listp elt-1) + (symbolp (car elt-1)) + (setq down-event-type (help-downify-mouse-event-type + (car elt-1)))) + (setcar elt-1 down-event-type) + (setq key-1 (vector elt-1)) + (when (key-binding key-1) + (princ (format " + +For documentation of the corresponding mouse down event <%s>, +click and hold the mouse button longer than %s second(s)." + down-event-type (if (numberp double-click-time) + (/ double-click-time 1000.0) + 3))))))) (when up-event (unless (or (null defn-up) (integerp defn-up) diff --git a/lisp/net/eww.el b/lisp/net/eww.el index bff592c3fe2..fcd2b98797a 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -261,9 +261,10 @@ word(s) will be searched for via `eww-search-prefix'." ;; IDNA characters. If not, transform to punycode to indicate that ;; there may be funny business going on. (let ((parsed (url-generic-parse-url url))) - (unless (puny-highly-restrictive-domain-p (url-host parsed)) - (setf (url-host parsed) (puny-encode-domain (url-host parsed))) - (setq url (url-recreate-url parsed)))) + (when (url-host parsed) + (unless (puny-highly-restrictive-domain-p (url-host parsed)) + (setf (url-host parsed) (puny-encode-domain (url-host parsed))) + (setq url (url-recreate-url parsed))))) (plist-put eww-data :url url) (plist-put eww-data :title "") (eww-update-header-line-format) diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el index f64a4392b49..70244873b4b 100644 --- a/lisp/pixel-scroll.el +++ b/lisp/pixel-scroll.el @@ -110,11 +110,11 @@ This is an alternative of `scroll-up'. Scope moves downward." pixel-resolution-fine-flag (frame-char-height)) (pixel-line-height)))) - (while (pixel-point-at-top-p amt) ; prevent too late (multi tries) - (vertical-motion 1)) ; move point downward - (if (pixel-eob-at-top-p) ; when end-of-the-buffer is close - (scroll-up 1) ; relay on robust method - (pixel-scroll-pixel-up amt))))) ; move scope downward + (if (pixel-eob-at-top-p) ; when end-of-the-buffer is close + (scroll-up 1) ; relay on robust method + (while (pixel-point-at-top-p amt) ; prevent too late (multi tries) + (vertical-motion 1)) ; move point downward + (pixel-scroll-pixel-up amt))))) ; move scope downward (defun pixel-scroll-down (&optional arg) "Scroll text of selected window down ARG lines. diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 5c553319f69..a8be6918bd4 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -1700,9 +1700,11 @@ current buffer state and calls REPORT-FN when done." (when (eq (process-status proc) 'exit) (unwind-protect (cond - ((not (eq proc (with-current-buffer source-buffer - elisp-flymake--byte-compile-process))) - (flymake-log :warning "byte-compile process %s obsolete" proc)) + ((not (and (buffer-live-p source-buffer) + (eq proc (with-current-buffer source-buffer + elisp-flymake--byte-compile-process)))) + (flymake-log :warning + "byte-compile process %s obsolete" proc)) ((zerop (process-exit-status proc)) (elisp-flymake--byte-compile-done report-fn source-buffer diff --git a/lisp/subr.el b/lisp/subr.el index e97ae54462c..67209b4d4f6 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3478,8 +3478,8 @@ See also `with-temp-file' and `with-output-to-string'." (defmacro with-silent-modifications (&rest body) "Execute BODY, pretending it does not modify the buffer. -This macro is Typically used around modifications of -text-properties which do not really affect the buffer's content. +This macro is typically used around modifications of +text properties which do not really affect the buffer's content. If BODY performs real modifications to the buffer's text, other than cosmetic ones, undo data may become corrupted. diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index 51f158e5c21..f9cf32cf046 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el @@ -1384,7 +1384,7 @@ The return value of this function is the retrieval buffer." (error "error: %s" e))) (error "error: gnutls support needed!"))) (t - (message "error response: %d" url-http-response-status) + (url-http-debug "error response: %d" url-http-response-status) (url-http-activate-callback)))))) (defun url-http-async-sentinel (proc why) |