mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-22 07:09:54 +00:00
Merge remote-tracking branch 'origin/master' into feature/android
This commit is contained in:
Po Lu
commit
e1261fff85
@ -618,21 +618,18 @@ Does nothing if the current buffer doesn't need reparsing."
|
||||
(lexically-safe t)
|
||||
)
|
||||
|
||||
(unwind-protect
|
||||
;; Perform the parsing.
|
||||
(progn
|
||||
(when (semantic-lex-catch-errors safe-refresh
|
||||
(save-excursion (semantic-fetch-tags))
|
||||
nil)
|
||||
;; If we are here, it is because the lexical step failed,
|
||||
;; probably due to unterminated lists or something like that.
|
||||
;; Perform the parsing.
|
||||
(when (semantic-lex-catch-errors safe-refresh
|
||||
(save-excursion (semantic-fetch-tags))
|
||||
nil)
|
||||
;; If we are here, it is because the lexical step failed,
|
||||
;; probably due to unterminated lists or something like that.
|
||||
|
||||
;; We do nothing, and just wait for the next idle timer
|
||||
;; to go off. In the meantime, remember this, and make sure
|
||||
;; no other idle services can get executed.
|
||||
(setq lexically-safe nil))
|
||||
|
||||
;; We do nothing, and just wait for the next idle timer
|
||||
;; to go off. In the meantime, remember this, and make sure
|
||||
;; no other idle services can get executed.
|
||||
(setq lexically-safe nil))
|
||||
)
|
||||
)
|
||||
;; Return if we are lexically safe
|
||||
lexically-safe))))
|
||||
|
||||
|
||||
@ -410,9 +410,7 @@ If multiple rules match, only first one is executed.")
|
||||
(goto-char pos)
|
||||
(funcall probe last-command-event))))
|
||||
(when res (throw 'done res))))))))))
|
||||
(when (and rule
|
||||
;; Not in a string or comment.
|
||||
(not (nth 8 (save-excursion (syntax-ppss pos)))))
|
||||
(when rule
|
||||
(goto-char pos)
|
||||
(when (functionp rule) (setq rule (funcall rule)))
|
||||
(dolist (sym (if (symbolp rule) (list rule) rule))
|
||||
|
||||
@ -2853,81 +2853,81 @@ See `edebug-behavior-alist' for implementations.")
|
||||
edebug-inside-windows
|
||||
)
|
||||
|
||||
(unwind-protect
|
||||
(let (
|
||||
;; Declare global values local but using the same global value.
|
||||
;; We could set these to the values for previous edebug call.
|
||||
(last-command last-command)
|
||||
(this-command this-command)
|
||||
(current-prefix-arg nil)
|
||||
|
||||
(last-input-event nil)
|
||||
(last-command-event nil)
|
||||
(last-event-frame nil)
|
||||
(last-nonmenu-event nil)
|
||||
(track-mouse nil)
|
||||
(let (
|
||||
;; Declare global values local but using the same global value.
|
||||
;; We could set these to the values for previous edebug call.
|
||||
(last-command last-command)
|
||||
(this-command this-command)
|
||||
(current-prefix-arg nil)
|
||||
|
||||
(standard-output t)
|
||||
(standard-input t)
|
||||
(last-input-event nil)
|
||||
(last-command-event nil)
|
||||
(last-event-frame nil)
|
||||
(last-nonmenu-event nil)
|
||||
(track-mouse nil)
|
||||
|
||||
;; Don't keep reading from an executing kbd macro
|
||||
;; within edebug unless edebug-continue-kbd-macro is
|
||||
;; non-nil. Again, local binding may not be best.
|
||||
(executing-kbd-macro
|
||||
(if edebug-continue-kbd-macro executing-kbd-macro))
|
||||
(standard-output t)
|
||||
(standard-input t)
|
||||
|
||||
;; Don't get confused by the user's keymap changes.
|
||||
(overriding-local-map nil)
|
||||
(overriding-terminal-local-map nil)
|
||||
;; Override other minor modes that may bind the keys
|
||||
;; edebug uses.
|
||||
(minor-mode-overriding-map-alist
|
||||
(list (cons 'edebug-mode edebug-mode-map)))
|
||||
;; Don't keep reading from an executing kbd macro
|
||||
;; within edebug unless edebug-continue-kbd-macro is
|
||||
;; non-nil. Again, local binding may not be best.
|
||||
(executing-kbd-macro
|
||||
(if edebug-continue-kbd-macro executing-kbd-macro))
|
||||
|
||||
;; Bind again to outside values.
|
||||
(debug-on-error edebug-outside-debug-on-error)
|
||||
(debug-on-quit edebug-outside-debug-on-quit)
|
||||
;; Don't get confused by the user's keymap changes.
|
||||
(overriding-local-map nil)
|
||||
(overriding-terminal-local-map nil)
|
||||
;; Override other minor modes that may bind the keys
|
||||
;; edebug uses.
|
||||
(minor-mode-overriding-map-alist
|
||||
(list (cons 'edebug-mode edebug-mode-map)))
|
||||
|
||||
;; Don't keep defining a kbd macro.
|
||||
(defining-kbd-macro
|
||||
(if edebug-continue-kbd-macro defining-kbd-macro))
|
||||
;; Bind again to outside values.
|
||||
(debug-on-error edebug-outside-debug-on-error)
|
||||
(debug-on-quit edebug-outside-debug-on-quit)
|
||||
|
||||
;; others??
|
||||
)
|
||||
;; Don't keep defining a kbd macro.
|
||||
(defining-kbd-macro
|
||||
(if edebug-continue-kbd-macro defining-kbd-macro))
|
||||
|
||||
(if (and (eq edebug-execution-mode 'go)
|
||||
(not (memq arg-mode '(after error))))
|
||||
(message "Break"))
|
||||
;; others??
|
||||
)
|
||||
|
||||
(setq signal-hook-function nil)
|
||||
(if (and (eq edebug-execution-mode 'go)
|
||||
(not (memq arg-mode '(after error))))
|
||||
(message "Break"))
|
||||
|
||||
(edebug-mode 1)
|
||||
(unwind-protect
|
||||
(recursive-edit) ; <<<<<<<<<< Recursive edit
|
||||
(setq signal-hook-function nil)
|
||||
|
||||
;; Do the following, even if quit occurs.
|
||||
(setq signal-hook-function #'edebug-signal)
|
||||
(if edebug-backtrace-buffer
|
||||
(kill-buffer edebug-backtrace-buffer))
|
||||
(edebug-mode 1)
|
||||
(unwind-protect
|
||||
(recursive-edit) ; <<<<<<<<<< Recursive edit
|
||||
|
||||
;; Remember selected-window after recursive-edit.
|
||||
;; (setq edebug-inside-window (selected-window))
|
||||
;; Do the following, even if quit occurs.
|
||||
(setq signal-hook-function #'edebug-signal)
|
||||
(if edebug-backtrace-buffer
|
||||
(kill-buffer edebug-backtrace-buffer))
|
||||
|
||||
(set-match-data edebug-outside-match-data)
|
||||
;; Remember selected-window after recursive-edit.
|
||||
;; (setq edebug-inside-window (selected-window))
|
||||
|
||||
;; Recursive edit may have changed buffers,
|
||||
;; so set it back before exiting let.
|
||||
(if (buffer-name edebug-buffer) ; if it still exists
|
||||
(progn
|
||||
(set-buffer edebug-buffer)
|
||||
(when (memq edebug-execution-mode '(go Go-nonstop))
|
||||
(edebug-overlay-arrow)
|
||||
(sit-for 0))
|
||||
(edebug-mode -1))
|
||||
;; gotta have a buffer to let its buffer local variables be set
|
||||
(get-buffer-create " bogus edebug buffer"))
|
||||
));; inner let
|
||||
)))
|
||||
(set-match-data edebug-outside-match-data)
|
||||
|
||||
;; Recursive edit may have changed buffers,
|
||||
;; so set it back before exiting let.
|
||||
(if (buffer-name edebug-buffer) ; if it still exists
|
||||
(progn
|
||||
(set-buffer edebug-buffer)
|
||||
(when (memq edebug-execution-mode '(go Go-nonstop))
|
||||
(edebug-overlay-arrow)
|
||||
(sit-for 0))
|
||||
(edebug-mode -1))
|
||||
;; gotta have a buffer to let its buffer local variables be set
|
||||
(get-buffer-create " bogus edebug buffer"))
|
||||
));; inner let
|
||||
))
|
||||
|
||||
|
||||
;;; Display related functions
|
||||
|
||||
@ -1218,15 +1218,14 @@ boundaries."
|
||||
"Read a `define-package' form in current buffer.
|
||||
Return the pkg-desc, with desc-kind set to KIND."
|
||||
(goto-char (point-min))
|
||||
(unwind-protect
|
||||
(let* ((pkg-def-parsed (read (current-buffer)))
|
||||
(pkg-desc
|
||||
(when (eq (car pkg-def-parsed) 'define-package)
|
||||
(apply #'package-desc-from-define
|
||||
(append (cdr pkg-def-parsed))))))
|
||||
(when pkg-desc
|
||||
(setf (package-desc-kind pkg-desc) kind)
|
||||
pkg-desc))))
|
||||
(let* ((pkg-def-parsed (read (current-buffer)))
|
||||
(pkg-desc
|
||||
(when (eq (car pkg-def-parsed) 'define-package)
|
||||
(apply #'package-desc-from-define
|
||||
(append (cdr pkg-def-parsed))))))
|
||||
(when pkg-desc
|
||||
(setf (package-desc-kind pkg-desc) kind)
|
||||
pkg-desc)))
|
||||
|
||||
(declare-function tar-get-file-descriptor "tar-mode" (file))
|
||||
(declare-function tar--extract "tar-mode" (descriptor))
|
||||
|
||||
@ -722,16 +722,12 @@ Vi's prefix argument will be used. Otherwise, the prefix argument passed to
|
||||
(let (viper-vi-kbd-minor-mode
|
||||
viper-insert-kbd-minor-mode
|
||||
viper-emacs-kbd-minor-mode)
|
||||
(unwind-protect
|
||||
(progn
|
||||
(setq com
|
||||
(key-binding (setq key (read-key-sequence nil))))
|
||||
;; In case of binding indirection--chase definitions.
|
||||
;; Have to do it here because we execute this command under
|
||||
;; different keymaps, so command-execute may not do the
|
||||
;; right thing there
|
||||
(while (vectorp com) (setq com (key-binding com))))
|
||||
nil)
|
||||
(setq com (key-binding (setq key (read-key-sequence nil))))
|
||||
;; In case of binding indirection--chase definitions.
|
||||
;; Have to do it here because we execute this command under
|
||||
;; different keymaps, so command-execute may not do the
|
||||
;; right thing there
|
||||
(while (vectorp com) (setq com (key-binding com)))
|
||||
;; Execute command com in the original Viper state, not in state
|
||||
;; `state'. Otherwise, if we switch buffers while executing the
|
||||
;; escaped to command, Viper's mode vars will remain those of
|
||||
@ -1950,16 +1946,16 @@ To turn this feature off, set this variable to nil."
|
||||
(if found
|
||||
()
|
||||
(viper-tmp-insert-at-eob " [Please complete file name]")
|
||||
(unwind-protect
|
||||
(while (not (memq cmd
|
||||
'(exit-minibuffer viper-exit-minibuffer)))
|
||||
(setq cmd
|
||||
(key-binding (setq key (read-key-sequence nil))))
|
||||
(cond ((eq cmd 'self-insert-command)
|
||||
(insert key))
|
||||
((memq cmd '(exit-minibuffer viper-exit-minibuffer))
|
||||
nil)
|
||||
(t (command-execute cmd))))))))))
|
||||
|
||||
(while (not (memq cmd
|
||||
'(exit-minibuffer viper-exit-minibuffer)))
|
||||
(setq cmd
|
||||
(key-binding (setq key (read-key-sequence nil))))
|
||||
(cond ((eq cmd 'self-insert-command)
|
||||
(insert key))
|
||||
((memq cmd '(exit-minibuffer viper-exit-minibuffer))
|
||||
nil)
|
||||
(t (command-execute cmd)))))))))
|
||||
|
||||
|
||||
(defun viper-minibuffer-trim-tail ()
|
||||
|
||||
@ -658,50 +658,49 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
|
||||
;; If getting from mail spool directory, use movemail to move
|
||||
;; rather than just renaming, so as to interlock with the
|
||||
;; mailer.
|
||||
(unwind-protect
|
||||
(save-excursion
|
||||
(setq errors (generate-new-buffer " *mail source loss*"))
|
||||
(let ((default-directory "/"))
|
||||
(setq result
|
||||
;; call-process looks in exec-path, which
|
||||
;; contains exec-directory, so will find
|
||||
;; Mailutils movemail if it exists, else it will
|
||||
;; find "our" movemail in exec-directory.
|
||||
;; Bug#31737
|
||||
(apply
|
||||
#'call-process
|
||||
(append
|
||||
(list
|
||||
mail-source-movemail-program
|
||||
nil errors nil from to)))))
|
||||
(when (file-exists-p to)
|
||||
(set-file-modes to mail-source-default-file-modes 'nofollow))
|
||||
(if (and (or (not (buffer-modified-p errors))
|
||||
(zerop (buffer-size errors)))
|
||||
(and (numberp result)
|
||||
(zerop result)))
|
||||
;; No output => movemail won.
|
||||
t
|
||||
(set-buffer errors)
|
||||
;; There may be a warning about older revisions. We
|
||||
;; ignore that.
|
||||
(goto-char (point-min))
|
||||
(if (search-forward "older revision" nil t)
|
||||
t
|
||||
;; Probably a real error.
|
||||
(subst-char-in-region (point-min) (point-max) ?\n ?\ )
|
||||
(goto-char (point-max))
|
||||
(skip-chars-backward " \t")
|
||||
(delete-region (point) (point-max))
|
||||
(goto-char (point-min))
|
||||
(when (looking-at "movemail: ")
|
||||
(delete-region (point-min) (match-end 0)))
|
||||
;; Result may be a signal description string.
|
||||
(unless (yes-or-no-p
|
||||
(format "movemail: %s (%s return). Continue? "
|
||||
(buffer-string) result))
|
||||
(error "%s" (buffer-string)))
|
||||
(setq to nil)))))))
|
||||
(save-excursion
|
||||
(setq errors (generate-new-buffer " *mail source loss*"))
|
||||
(let ((default-directory "/"))
|
||||
(setq result
|
||||
;; call-process looks in exec-path, which
|
||||
;; contains exec-directory, so will find
|
||||
;; Mailutils movemail if it exists, else it will
|
||||
;; find "our" movemail in exec-directory.
|
||||
;; Bug#31737
|
||||
(apply
|
||||
#'call-process
|
||||
(append
|
||||
(list
|
||||
mail-source-movemail-program
|
||||
nil errors nil from to)))))
|
||||
(when (file-exists-p to)
|
||||
(set-file-modes to mail-source-default-file-modes 'nofollow))
|
||||
(if (and (or (not (buffer-modified-p errors))
|
||||
(zerop (buffer-size errors)))
|
||||
(and (numberp result)
|
||||
(zerop result)))
|
||||
;; No output => movemail won.
|
||||
t
|
||||
(set-buffer errors)
|
||||
;; There may be a warning about older revisions. We
|
||||
;; ignore that.
|
||||
(goto-char (point-min))
|
||||
(if (search-forward "older revision" nil t)
|
||||
t
|
||||
;; Probably a real error.
|
||||
(subst-char-in-region (point-min) (point-max) ?\n ?\ )
|
||||
(goto-char (point-max))
|
||||
(skip-chars-backward " \t")
|
||||
(delete-region (point) (point-max))
|
||||
(goto-char (point-min))
|
||||
(when (looking-at "movemail: ")
|
||||
(delete-region (point-min) (match-end 0)))
|
||||
;; Result may be a signal description string.
|
||||
(unless (yes-or-no-p
|
||||
(format "movemail: %s (%s return). Continue? "
|
||||
(buffer-string) result))
|
||||
(error "%s" (buffer-string)))
|
||||
(setq to nil))))))
|
||||
(when (buffer-live-p errors)
|
||||
(kill-buffer errors))
|
||||
;; Return whether we moved successfully or not.
|
||||
|
||||
@ -674,8 +674,8 @@ depending on PATTERNS."
|
||||
(cons item (cdr menu)))))
|
||||
;; Go to the start of the match, to make sure we
|
||||
;; keep making progress backwards.
|
||||
(goto-char start))))
|
||||
(set-syntax-table old-table)))
|
||||
(goto-char start)))))
|
||||
(set-syntax-table old-table))
|
||||
;; Sort each submenu by position.
|
||||
;; This is in case one submenu gets items from two different regexps.
|
||||
(dolist (item index-alist)
|
||||
|
||||
@ -2511,22 +2511,20 @@ mapped to mostly alphanumerics for safety."
|
||||
feedmail-force-binary-write)
|
||||
'no-conversion
|
||||
coding-system-for-write)))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(insert fcc)
|
||||
(unless feedmail-nuke-bcc-in-fcc
|
||||
(if bcc-holder (insert bcc-holder))
|
||||
(if resent-bcc-holder
|
||||
(insert resent-bcc-holder)))
|
||||
(insert fcc)
|
||||
(unless feedmail-nuke-bcc-in-fcc
|
||||
(if bcc-holder (insert bcc-holder))
|
||||
(if resent-bcc-holder
|
||||
(insert resent-bcc-holder)))
|
||||
|
||||
(run-hooks 'feedmail-before-fcc-hook)
|
||||
(run-hooks 'feedmail-before-fcc-hook)
|
||||
|
||||
(when feedmail-nuke-body-in-fcc
|
||||
(goto-char eoh-marker)
|
||||
(if (natnump feedmail-nuke-body-in-fcc)
|
||||
(forward-line feedmail-nuke-body-in-fcc))
|
||||
(delete-region (point) (point-max)))
|
||||
(mail-do-fcc eoh-marker))))))
|
||||
(when feedmail-nuke-body-in-fcc
|
||||
(goto-char eoh-marker)
|
||||
(if (natnump feedmail-nuke-body-in-fcc)
|
||||
(forward-line feedmail-nuke-body-in-fcc))
|
||||
(delete-region (point) (point-max)))
|
||||
(mail-do-fcc eoh-marker))))
|
||||
;; User bailed out of one-last-look.
|
||||
(if feedmail-queue-runner-is-active
|
||||
(throw 'skip-me-q 'skip-me-q)
|
||||
@ -3046,30 +3044,30 @@ been weeded out."
|
||||
(address-blob)
|
||||
(this-line)
|
||||
(this-line-end))
|
||||
(unwind-protect
|
||||
(with-current-buffer (get-buffer-create " *FQM scratch*")
|
||||
(erase-buffer)
|
||||
(insert-buffer-substring message-buffer header-start header-end)
|
||||
(goto-char (point-min))
|
||||
(let ((case-fold-search t))
|
||||
(while (re-search-forward addr-regexp (point-max) t)
|
||||
(replace-match "")
|
||||
(setq this-line (match-beginning 0))
|
||||
(forward-line 1)
|
||||
;; get any continuation lines
|
||||
(while (and (looking-at "^[ \t]+") (< (point) (point-max)))
|
||||
(forward-line 1))
|
||||
(setq this-line-end (point-marker))
|
||||
;; only keep if we don't have it already
|
||||
(setq address-blob
|
||||
(mail-strip-quoted-names (buffer-substring-no-properties this-line this-line-end)))
|
||||
(while (string-match "\\([, \t\n\r]*\\)\\([^, \t\n\r]+\\)" address-blob)
|
||||
(setq simple-address (substring address-blob (match-beginning 2) (match-end 2)))
|
||||
(setq address-blob (replace-match "" t t address-blob))
|
||||
(if (not (member simple-address address-list))
|
||||
(push simple-address address-list)))
|
||||
))
|
||||
(kill-buffer nil)))
|
||||
|
||||
(with-current-buffer (get-buffer-create " *FQM scratch*")
|
||||
(erase-buffer)
|
||||
(insert-buffer-substring message-buffer header-start header-end)
|
||||
(goto-char (point-min))
|
||||
(let ((case-fold-search t))
|
||||
(while (re-search-forward addr-regexp (point-max) t)
|
||||
(replace-match "")
|
||||
(setq this-line (match-beginning 0))
|
||||
(forward-line 1)
|
||||
;; get any continuation lines
|
||||
(while (and (looking-at "^[ \t]+") (< (point) (point-max)))
|
||||
(forward-line 1))
|
||||
(setq this-line-end (point-marker))
|
||||
;; only keep if we don't have it already
|
||||
(setq address-blob
|
||||
(mail-strip-quoted-names (buffer-substring-no-properties this-line this-line-end)))
|
||||
(while (string-match "\\([, \t\n\r]*\\)\\([^, \t\n\r]+\\)" address-blob)
|
||||
(setq simple-address (substring address-blob (match-beginning 2) (match-end 2)))
|
||||
(setq address-blob (replace-match "" t t address-blob))
|
||||
(if (not (member simple-address address-list))
|
||||
(push simple-address address-list)))
|
||||
))
|
||||
(kill-buffer nil))
|
||||
(identity address-list)))
|
||||
|
||||
|
||||
|
||||
@ -111,104 +111,103 @@ The mail client is taken to be the handler of mailto URLs."
|
||||
(let ((case-fold-search nil)
|
||||
delimline
|
||||
(mailbuf (current-buffer)))
|
||||
(unwind-protect
|
||||
(with-temp-buffer
|
||||
(insert-buffer-substring mailbuf)
|
||||
;; Move to header delimiter
|
||||
(mail-sendmail-undelimit-header)
|
||||
(setq delimline (point-marker))
|
||||
(if mail-aliases
|
||||
(expand-mail-aliases (point-min) delimline))
|
||||
(goto-char (point-min))
|
||||
;; ignore any blank lines in the header
|
||||
(while (and (re-search-forward "\n\n\n*" delimline t)
|
||||
(< (point) delimline))
|
||||
(replace-match "\n"))
|
||||
(let ((case-fold-search t)
|
||||
(mime-charset-pattern
|
||||
(concat
|
||||
"^content-type:[ \t]*text/plain;"
|
||||
"\\(?:[ \t\n]*\\(?:format\\|delsp\\)=\"?[-a-z0-9]+\"?;\\)*"
|
||||
"[ \t\n]*charset=\"?\\([^ \t\n\";]+\\)\"?"))
|
||||
coding-system
|
||||
character-coding
|
||||
;; Use the external browser function to send the
|
||||
;; message.
|
||||
(browse-url-default-handlers nil))
|
||||
;; initialize limiter
|
||||
(setq mailclient-delim-static "?")
|
||||
;; construct and call up mailto URL
|
||||
(browse-url
|
||||
(with-temp-buffer
|
||||
(insert-buffer-substring mailbuf)
|
||||
;; Move to header delimiter
|
||||
(mail-sendmail-undelimit-header)
|
||||
(setq delimline (point-marker))
|
||||
(if mail-aliases
|
||||
(expand-mail-aliases (point-min) delimline))
|
||||
(goto-char (point-min))
|
||||
;; ignore any blank lines in the header
|
||||
(while (and (re-search-forward "\n\n\n*" delimline t)
|
||||
(< (point) delimline))
|
||||
(replace-match "\n"))
|
||||
(let ((case-fold-search t)
|
||||
(mime-charset-pattern
|
||||
(concat
|
||||
(save-excursion
|
||||
(narrow-to-region (point-min) delimline)
|
||||
;; We can't send multipart/* messages (i. e. with
|
||||
;; attachments or the like) via this method.
|
||||
(when-let ((type (mail-fetch-field "content-type")))
|
||||
(when (and (string-match "multipart"
|
||||
(car (mail-header-parse-content-type
|
||||
type)))
|
||||
(not (y-or-n-p "Message with attachments can't be sent via mailclient; continue anyway?")))
|
||||
(error "Choose a different `send-mail-function' to send attachments")))
|
||||
(goto-char (point-min))
|
||||
(setq coding-system
|
||||
(if (re-search-forward mime-charset-pattern nil t)
|
||||
(coding-system-from-name (match-string 1))
|
||||
'undecided))
|
||||
(setq character-coding
|
||||
(mail-fetch-field "content-transfer-encoding"))
|
||||
(when character-coding
|
||||
(setq character-coding (downcase character-coding)))
|
||||
(concat
|
||||
"mailto:"
|
||||
;; Some of the headers according to RFC 822 (or later).
|
||||
(mailclient-gather-addresses "To"
|
||||
'drop-first-name)
|
||||
(mailclient-gather-addresses "cc" )
|
||||
(mailclient-gather-addresses "bcc" )
|
||||
(mailclient-gather-addresses "Resent-To" )
|
||||
(mailclient-gather-addresses "Resent-cc" )
|
||||
(mailclient-gather-addresses "Resent-bcc" )
|
||||
(mailclient-gather-addresses "Reply-To" )
|
||||
;; The From field is not honored for now: it's
|
||||
;; not necessarily configured. The mail client
|
||||
;; knows the user's address(es)
|
||||
;; (mailclient-gather-addresses "From" )
|
||||
;; subject line
|
||||
(let ((subj (mail-fetch-field "Subject" nil t)))
|
||||
(widen) ;; so we can read the body later on
|
||||
(if subj ;; if non-blank
|
||||
;; the mail client will deal with
|
||||
;; warning the user etc.
|
||||
(concat (mailclient-url-delim) "subject="
|
||||
(mailclient-encode-string-as-url subj))
|
||||
""))))
|
||||
;; body
|
||||
(mailclient-url-delim) "body="
|
||||
(progn
|
||||
(delete-region (point-min) delimline)
|
||||
(unless (null character-coding)
|
||||
;; mailto: and clipboard need UTF-8 and cannot deal with
|
||||
;; Content-Transfer-Encoding or Content-Type.
|
||||
;; FIXME: There is code duplication here with rmail.el.
|
||||
(set-buffer-multibyte nil)
|
||||
(cond
|
||||
((string= character-coding "base64")
|
||||
(base64-decode-region (point-min) (point-max)))
|
||||
((string= character-coding "quoted-printable")
|
||||
(mail-unquote-printable-region (point-min) (point-max)
|
||||
nil nil t))
|
||||
(t (error "Unsupported Content-Transfer-Encoding: %s"
|
||||
character-coding)))
|
||||
(decode-coding-region (point-min) (point-max) coding-system))
|
||||
(mailclient-encode-string-as-url
|
||||
(if mailclient-place-body-on-clipboard-flag
|
||||
(progn
|
||||
(clipboard-kill-ring-save (point-min) (point-max))
|
||||
(concat
|
||||
"*** E-Mail body has been placed on clipboard, "
|
||||
"please paste it here! ***"))
|
||||
(buffer-string)))))))))))
|
||||
"^content-type:[ \t]*text/plain;"
|
||||
"\\(?:[ \t\n]*\\(?:format\\|delsp\\)=\"?[-a-z0-9]+\"?;\\)*"
|
||||
"[ \t\n]*charset=\"?\\([^ \t\n\";]+\\)\"?"))
|
||||
coding-system
|
||||
character-coding
|
||||
;; Use the external browser function to send the
|
||||
;; message.
|
||||
(browse-url-default-handlers nil))
|
||||
;; initialize limiter
|
||||
(setq mailclient-delim-static "?")
|
||||
;; construct and call up mailto URL
|
||||
(browse-url
|
||||
(concat
|
||||
(save-excursion
|
||||
(narrow-to-region (point-min) delimline)
|
||||
;; We can't send multipart/* messages (i. e. with
|
||||
;; attachments or the like) via this method.
|
||||
(when-let ((type (mail-fetch-field "content-type")))
|
||||
(when (and (string-match "multipart"
|
||||
(car (mail-header-parse-content-type
|
||||
type)))
|
||||
(not (y-or-n-p "Message with attachments can't be sent via mailclient; continue anyway?")))
|
||||
(error "Choose a different `send-mail-function' to send attachments")))
|
||||
(goto-char (point-min))
|
||||
(setq coding-system
|
||||
(if (re-search-forward mime-charset-pattern nil t)
|
||||
(coding-system-from-name (match-string 1))
|
||||
'undecided))
|
||||
(setq character-coding
|
||||
(mail-fetch-field "content-transfer-encoding"))
|
||||
(when character-coding
|
||||
(setq character-coding (downcase character-coding)))
|
||||
(concat
|
||||
"mailto:"
|
||||
;; Some of the headers according to RFC 822 (or later).
|
||||
(mailclient-gather-addresses "To"
|
||||
'drop-first-name)
|
||||
(mailclient-gather-addresses "cc" )
|
||||
(mailclient-gather-addresses "bcc" )
|
||||
(mailclient-gather-addresses "Resent-To" )
|
||||
(mailclient-gather-addresses "Resent-cc" )
|
||||
(mailclient-gather-addresses "Resent-bcc" )
|
||||
(mailclient-gather-addresses "Reply-To" )
|
||||
;; The From field is not honored for now: it's
|
||||
;; not necessarily configured. The mail client
|
||||
;; knows the user's address(es)
|
||||
;; (mailclient-gather-addresses "From" )
|
||||
;; subject line
|
||||
(let ((subj (mail-fetch-field "Subject" nil t)))
|
||||
(widen) ;; so we can read the body later on
|
||||
(if subj ;; if non-blank
|
||||
;; the mail client will deal with
|
||||
;; warning the user etc.
|
||||
(concat (mailclient-url-delim) "subject="
|
||||
(mailclient-encode-string-as-url subj))
|
||||
""))))
|
||||
;; body
|
||||
(mailclient-url-delim) "body="
|
||||
(progn
|
||||
(delete-region (point-min) delimline)
|
||||
(unless (null character-coding)
|
||||
;; mailto: and clipboard need UTF-8 and cannot deal with
|
||||
;; Content-Transfer-Encoding or Content-Type.
|
||||
;; FIXME: There is code duplication here with rmail.el.
|
||||
(set-buffer-multibyte nil)
|
||||
(cond
|
||||
((string= character-coding "base64")
|
||||
(base64-decode-region (point-min) (point-max)))
|
||||
((string= character-coding "quoted-printable")
|
||||
(mail-unquote-printable-region (point-min) (point-max)
|
||||
nil nil t))
|
||||
(t (error "Unsupported Content-Transfer-Encoding: %s"
|
||||
character-coding)))
|
||||
(decode-coding-region (point-min) (point-max) coding-system))
|
||||
(mailclient-encode-string-as-url
|
||||
(if mailclient-place-body-on-clipboard-flag
|
||||
(progn
|
||||
(clipboard-kill-ring-save (point-min) (point-max))
|
||||
(concat
|
||||
"*** E-Mail body has been placed on clipboard, "
|
||||
"please paste it here! ***"))
|
||||
(buffer-string))))))))))
|
||||
|
||||
(provide 'mailclient)
|
||||
|
||||
|
||||
@ -1068,52 +1068,51 @@ Returns an error if the server cannot be contacted."
|
||||
|
||||
(defun smtpmail-deduce-address-list (smtpmail-text-buffer header-start header-end)
|
||||
"Get address list suitable for smtp RCPT TO: <address>."
|
||||
(unwind-protect
|
||||
(with-current-buffer smtpmail-address-buffer
|
||||
(erase-buffer)
|
||||
(let ((case-fold-search t)
|
||||
(simple-address-list "")
|
||||
this-line
|
||||
this-line-end
|
||||
addr-regexp)
|
||||
(insert-buffer-substring smtpmail-text-buffer header-start header-end)
|
||||
(goto-char (point-min))
|
||||
;; RESENT-* fields should stop processing of regular fields.
|
||||
(save-excursion
|
||||
(setq addr-regexp
|
||||
(if (re-search-forward "^Resent-\\(To\\|Cc\\|Bcc\\):"
|
||||
header-end t)
|
||||
"^Resent-\\(To\\|Cc\\|Bcc\\):"
|
||||
"^\\(To:\\|Cc:\\|Bcc:\\)")))
|
||||
(with-current-buffer smtpmail-address-buffer
|
||||
(erase-buffer)
|
||||
(let ((case-fold-search t)
|
||||
(simple-address-list "")
|
||||
this-line
|
||||
this-line-end
|
||||
addr-regexp)
|
||||
(insert-buffer-substring smtpmail-text-buffer header-start header-end)
|
||||
(goto-char (point-min))
|
||||
;; RESENT-* fields should stop processing of regular fields.
|
||||
(save-excursion
|
||||
(setq addr-regexp
|
||||
(if (re-search-forward "^Resent-\\(To\\|Cc\\|Bcc\\):"
|
||||
header-end t)
|
||||
"^Resent-\\(To\\|Cc\\|Bcc\\):"
|
||||
"^\\(To:\\|Cc:\\|Bcc:\\)")))
|
||||
|
||||
(while (re-search-forward addr-regexp header-end t)
|
||||
(replace-match "")
|
||||
(setq this-line (match-beginning 0))
|
||||
(forward-line 1)
|
||||
;; get any continuation lines
|
||||
(while (and (looking-at "^[ \t]+") (< (point) header-end))
|
||||
(forward-line 1))
|
||||
(setq this-line-end (point-marker))
|
||||
(setq simple-address-list
|
||||
(concat simple-address-list " "
|
||||
(mail-strip-quoted-names (buffer-substring this-line this-line-end)))))
|
||||
(erase-buffer)
|
||||
(insert " " simple-address-list "\n")
|
||||
(subst-char-in-region (point-min) (point-max) 10 ? t) ; newline --> blank
|
||||
(subst-char-in-region (point-min) (point-max) ?, ? t) ; comma --> blank
|
||||
(subst-char-in-region (point-min) (point-max) 9 ? t) ; tab --> blank
|
||||
(while (re-search-forward addr-regexp header-end t)
|
||||
(replace-match "")
|
||||
(setq this-line (match-beginning 0))
|
||||
(forward-line 1)
|
||||
;; get any continuation lines
|
||||
(while (and (looking-at "^[ \t]+") (< (point) header-end))
|
||||
(forward-line 1))
|
||||
(setq this-line-end (point-marker))
|
||||
(setq simple-address-list
|
||||
(concat simple-address-list " "
|
||||
(mail-strip-quoted-names (buffer-substring this-line this-line-end)))))
|
||||
(erase-buffer)
|
||||
(insert " " simple-address-list "\n")
|
||||
(subst-char-in-region (point-min) (point-max) 10 ? t) ; newline --> blank
|
||||
(subst-char-in-region (point-min) (point-max) ?, ? t) ; comma --> blank
|
||||
(subst-char-in-region (point-min) (point-max) 9 ? t) ; tab --> blank
|
||||
|
||||
(goto-char (point-min))
|
||||
;; tidiness in case hook is not robust when it looks at this
|
||||
(while (re-search-forward "[ \t]+" header-end t) (replace-match " "))
|
||||
(goto-char (point-min))
|
||||
;; tidiness in case hook is not robust when it looks at this
|
||||
(while (re-search-forward "[ \t]+" header-end t) (replace-match " "))
|
||||
|
||||
(goto-char (point-min))
|
||||
(let (recipient-address-list)
|
||||
(while (re-search-forward " \\([^ ]+\\) " (point-max) t)
|
||||
(backward-char 1)
|
||||
(setq recipient-address-list (cons (buffer-substring (match-beginning 1) (match-end 1))
|
||||
recipient-address-list)))
|
||||
(setq smtpmail-recipient-address-list recipient-address-list))))))
|
||||
(goto-char (point-min))
|
||||
(let (recipient-address-list)
|
||||
(while (re-search-forward " \\([^ ]+\\) " (point-max) t)
|
||||
(backward-char 1)
|
||||
(setq recipient-address-list (cons (buffer-substring (match-beginning 1) (match-end 1))
|
||||
recipient-address-list)))
|
||||
(setq smtpmail-recipient-address-list recipient-address-list)))))
|
||||
|
||||
(defun smtpmail-do-bcc (header-end)
|
||||
"Delete [Resent-]Bcc: and their continuation lines from the header area.
|
||||
|
||||
@ -111,8 +111,8 @@
|
||||
(message "Warning: Size mismatch while decoding."))
|
||||
(goto-char start)
|
||||
(delete-region start end)
|
||||
(insert-buffer-substring work-buffer))))
|
||||
(and work-buffer (kill-buffer work-buffer))))))
|
||||
(insert-buffer-substring work-buffer)))))
|
||||
(and work-buffer (kill-buffer work-buffer)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun yenc-extract-filename ()
|
||||
|
||||
@ -79,8 +79,7 @@ commands \\[mh-ps-print-toggle-color] and
|
||||
This is the function that actually does the work.
|
||||
If FILE is nil, then the messages are spooled to the printer."
|
||||
(mh-iterate-on-range msg range
|
||||
(unwind-protect
|
||||
(mh-ps-spool-msg msg))
|
||||
(mh-ps-spool-msg msg)
|
||||
(mh-notate msg mh-note-printed mh-cmd-note))
|
||||
(ps-despool file))
|
||||
|
||||
|
||||
@ -451,13 +451,12 @@ See also `text-scale-adjust'."
|
||||
This invokes `global-text-scale-adjust', which see."
|
||||
(interactive (list last-input-event))
|
||||
(let ((button (mwheel-event-button event)))
|
||||
(unwind-protect
|
||||
(cond ((memq button (list mouse-wheel-down-event
|
||||
mouse-wheel-down-alternate-event))
|
||||
(global-text-scale-adjust 1))
|
||||
((memq button (list mouse-wheel-up-event
|
||||
mouse-wheel-up-alternate-event))
|
||||
(global-text-scale-adjust -1))))))
|
||||
(cond ((memq button (list mouse-wheel-down-event
|
||||
mouse-wheel-down-alternate-event))
|
||||
(global-text-scale-adjust 1))
|
||||
((memq button (list mouse-wheel-up-event
|
||||
mouse-wheel-up-alternate-event))
|
||||
(global-text-scale-adjust -1)))))
|
||||
|
||||
(defun mouse-wheel--add-binding (key fun)
|
||||
"Bind mouse wheel button KEY to function FUN.
|
||||
|
||||
@ -107,6 +107,7 @@
|
||||
(require 'subr-x))
|
||||
(require 'filenotify)
|
||||
(require 'ert)
|
||||
(require 'text-property-search nil t)
|
||||
|
||||
;; These dependencies are also GNU ELPA core packages. Because of
|
||||
;; bug#62576, since there is a risk that M-x package-install, despite
|
||||
@ -402,7 +403,7 @@ done by `eglot-reconnect'."
|
||||
If set to `messages', use *Messages* buffer, else use Eglot's
|
||||
mode line indicator."
|
||||
:type 'boolean
|
||||
:version "29.1")
|
||||
:version "1.10")
|
||||
|
||||
(defvar eglot-withhold-process-id nil
|
||||
"If non-nil, Eglot will not send the Emacs process id to the language server.
|
||||
@ -486,9 +487,7 @@ This can be useful when using docker to run a language server.")
|
||||
(SymbolInformation (:name :kind :location)
|
||||
(:deprecated :containerName))
|
||||
(DocumentSymbol (:name :range :selectionRange :kind)
|
||||
;; `:containerName' isn't really allowed , but
|
||||
;; it simplifies the impl of `eglot-imenu'.
|
||||
(:detail :deprecated :children :containerName))
|
||||
(:detail :deprecated :children))
|
||||
(TextDocumentEdit (:textDocument :edits) ())
|
||||
(TextEdit (:range :newText))
|
||||
(VersionedTextDocumentIdentifier (:uri :version) ())
|
||||
@ -1481,11 +1480,11 @@ Unless IMMEDIATE, send pending changes before making request."
|
||||
;;; Encoding fever
|
||||
;;;
|
||||
(define-obsolete-function-alias
|
||||
'eglot-lsp-abiding-column 'eglot-utf-16-linepos "29.1")
|
||||
'eglot-lsp-abiding-column 'eglot-utf-16-linepos "1.12")
|
||||
(define-obsolete-function-alias
|
||||
'eglot-current-column 'eglot-utf-32-linepos "29.1")
|
||||
'eglot-current-column 'eglot-utf-32-linepos "1.12")
|
||||
(define-obsolete-variable-alias
|
||||
'eglot-current-column-function 'eglot-current-linepos-function "29.1")
|
||||
'eglot-current-column-function 'eglot-current-linepos-function "1.12")
|
||||
|
||||
(defvar eglot-current-linepos-function #'eglot-utf-16-linepos
|
||||
"Function calculating position relative to line beginning.
|
||||
@ -1526,11 +1525,11 @@ LBP defaults to `eglot--bol'."
|
||||
(funcall eglot-current-linepos-function)))))
|
||||
|
||||
(define-obsolete-function-alias
|
||||
'eglot-move-to-current-column 'eglot-move-to-utf-32-linepos "29.1")
|
||||
'eglot-move-to-current-column 'eglot-move-to-utf-32-linepos "1.12")
|
||||
(define-obsolete-function-alias
|
||||
'eglot-move-to-lsp-abiding-column 'eglot-move-to-utf-16-linepos "29.1")
|
||||
'eglot-move-to-lsp-abiding-column 'eglot-move-to-utf-16-linepos "1.12")
|
||||
(define-obsolete-variable-alias
|
||||
'eglot-move-to-column-function 'eglot-move-to-linepos-function "29.1")
|
||||
'eglot-move-to-column-function 'eglot-move-to-linepos-function "1.12")
|
||||
|
||||
(defvar eglot-move-to-linepos-function #'eglot-move-to-utf-16-linepos
|
||||
"Function to move to a position within a line reported by the LSP server.
|
||||
@ -1674,9 +1673,11 @@ Doubles as an indicator of snippet support."
|
||||
(ignore-errors (delay-mode-hooks (funcall mode)))
|
||||
(font-lock-ensure)
|
||||
(goto-char (point-min))
|
||||
(while (setq match (text-property-search-forward 'invisible))
|
||||
(delete-region (prop-match-beginning match)
|
||||
(prop-match-end match)))
|
||||
(let ((inhibit-read-only t))
|
||||
(when (fboundp 'text-property-search-forward) ;; FIXME: use compat
|
||||
(while (setq match (text-property-search-forward 'invisible))
|
||||
(delete-region (prop-match-beginning match)
|
||||
(prop-match-end match)))))
|
||||
(string-trim (buffer-string))))))
|
||||
|
||||
(define-obsolete-variable-alias 'eglot-ignored-server-capabilites
|
||||
@ -1987,8 +1988,8 @@ If it is activated, also signal textDocument/didOpen."
|
||||
(when update-mode-line
|
||||
(force-mode-line-update t)))))))
|
||||
|
||||
(defun eglot-manual () "Open documentation."
|
||||
(declare (obsolete info "29.1"))
|
||||
(defun eglot-manual () "Read Eglot's manual."
|
||||
(declare (obsolete info "1.10"))
|
||||
(interactive) (info "(eglot)"))
|
||||
|
||||
(easy-menu-define eglot-menu nil "Eglot"
|
||||
@ -3235,49 +3236,55 @@ for which LSP on-type-formatting should be requested."
|
||||
:deferred :textDocument/documentHighlight)
|
||||
nil)))
|
||||
|
||||
(defun eglot--imenu-SymbolInformation (res)
|
||||
"Compute `imenu--index-alist' for RES vector of SymbolInformation."
|
||||
(mapcar
|
||||
(pcase-lambda (`(,kind . ,objs))
|
||||
(cons
|
||||
(alist-get kind eglot--symbol-kind-names "Unknown")
|
||||
(mapcan
|
||||
(pcase-lambda (`(,container . ,objs))
|
||||
(let ((elems (mapcar
|
||||
(eglot--lambda ((SymbolInformation) kind name location)
|
||||
(let ((reg (eglot--range-region
|
||||
(plist-get location :range)))
|
||||
(kind (alist-get kind eglot--symbol-kind-names)))
|
||||
(cons (propertize name
|
||||
'breadcrumb-region reg
|
||||
'breadcrumb-kind kind)
|
||||
(car reg))))
|
||||
objs)))
|
||||
(if container (list (cons container elems)) elems)))
|
||||
(seq-group-by
|
||||
(eglot--lambda ((SymbolInformation) containerName) containerName) objs))))
|
||||
(seq-group-by (eglot--lambda ((SymbolInformation) kind) kind) res)))
|
||||
|
||||
(defun eglot--imenu-DocumentSymbol (res)
|
||||
"Compute `imenu--index-alist' for RES vector of DocumentSymbol."
|
||||
(cl-labels ((dfs (&key name children range kind &allow-other-keys)
|
||||
(let* ((reg (eglot--range-region range))
|
||||
(kind (alist-get kind eglot--symbol-kind-names))
|
||||
(name (propertize name
|
||||
'breadcrumb-region reg
|
||||
'breadcrumb-kind kind)))
|
||||
(if (seq-empty-p children)
|
||||
(cons name (car reg))
|
||||
(cons name
|
||||
(mapcar (lambda (c) (apply #'dfs c)) children))))))
|
||||
(mapcar (lambda (s) (apply #'dfs s)) res)))
|
||||
|
||||
(defun eglot-imenu ()
|
||||
"Eglot's `imenu-create-index-function'.
|
||||
Returns a list as described in docstring of `imenu--index-alist'."
|
||||
(cl-labels
|
||||
((unfurl (obj)
|
||||
(eglot--dcase obj
|
||||
(((SymbolInformation)) (list obj))
|
||||
(((DocumentSymbol) name children)
|
||||
(cons obj
|
||||
(mapcar
|
||||
(lambda (c)
|
||||
(plist-put
|
||||
c :containerName
|
||||
(let ((existing (plist-get c :containerName)))
|
||||
(if existing (format "%s::%s" name existing)
|
||||
name))))
|
||||
(mapcan #'unfurl children)))))))
|
||||
(mapcar
|
||||
(pcase-lambda (`(,kind . ,objs))
|
||||
(cons
|
||||
(alist-get kind eglot--symbol-kind-names "Unknown")
|
||||
(mapcan (pcase-lambda (`(,container . ,objs))
|
||||
(let ((elems (mapcar
|
||||
(lambda (obj)
|
||||
(cons (plist-get obj :name)
|
||||
(car (eglot--range-region
|
||||
(eglot--dcase obj
|
||||
(((SymbolInformation) location)
|
||||
(plist-get location :range))
|
||||
(((DocumentSymbol) selectionRange)
|
||||
selectionRange))))))
|
||||
objs)))
|
||||
(if container (list (cons container elems)) elems)))
|
||||
(seq-group-by
|
||||
(lambda (e) (plist-get e :containerName)) objs))))
|
||||
(seq-group-by
|
||||
(lambda (obj) (plist-get obj :kind))
|
||||
(mapcan #'unfurl
|
||||
(eglot--request (eglot--current-server-or-lose)
|
||||
(let* ((res (eglot--request (eglot--current-server-or-lose)
|
||||
:textDocument/documentSymbol
|
||||
`(:textDocument
|
||||
,(eglot--TextDocumentIdentifier))
|
||||
:cancel-on-input non-essential))))))
|
||||
:cancel-on-input non-essential))
|
||||
(head (and res (elt res 0))))
|
||||
(eglot--dcase head
|
||||
(((SymbolInformation)) (eglot--imenu-SymbolInformation res))
|
||||
(((DocumentSymbol)) (eglot--imenu-DocumentSymbol res)))))
|
||||
|
||||
(cl-defun eglot--apply-text-edits (edits &optional version)
|
||||
"Apply EDITS for current buffer if at VERSION, or if it's nil."
|
||||
|
||||
@ -2591,13 +2591,12 @@ interrupted by the user."
|
||||
(if (not speedbar-stealthy-update-recurse)
|
||||
(let ((l (speedbar-initial-stealthy-functions))
|
||||
(speedbar-stealthy-update-recurse t))
|
||||
(unwind-protect
|
||||
(speedbar-with-writable
|
||||
(while (and l (funcall (car l)))
|
||||
;;(sit-for 0)
|
||||
(setq l (cdr l))))
|
||||
;;(dframe-message "Exit with %S" (car l))
|
||||
))))
|
||||
(speedbar-with-writable
|
||||
(while (and l (funcall (car l)))
|
||||
;;(sit-for 0)
|
||||
(setq l (cdr l))))
|
||||
;;(dframe-message "Exit with %S" (car l))
|
||||
)))
|
||||
|
||||
(defun speedbar-reset-scanners ()
|
||||
"Reset any variables used by functions in the stealthy list as state.
|
||||
@ -3572,38 +3571,36 @@ value is \"show\" then toggle the value of
|
||||
"For FILE, run etags and create a list of symbols extracted.
|
||||
Each symbol will be associated with its line position in FILE."
|
||||
(let ((newlist nil))
|
||||
(unwind-protect
|
||||
(save-excursion
|
||||
(if (get-buffer "*etags tmp*")
|
||||
(kill-buffer "*etags tmp*")) ;kill to clean it up
|
||||
(if (<= 1 speedbar-verbosity-level)
|
||||
(dframe-message "Fetching etags..."))
|
||||
(set-buffer (get-buffer-create "*etags tmp*"))
|
||||
(apply 'call-process speedbar-fetch-etags-command nil
|
||||
(current-buffer) nil
|
||||
(append speedbar-fetch-etags-arguments (list file)))
|
||||
(goto-char (point-min))
|
||||
(if (<= 1 speedbar-verbosity-level)
|
||||
(dframe-message "Fetching etags..."))
|
||||
(let ((expr
|
||||
(let ((exprlst speedbar-fetch-etags-parse-list)
|
||||
(ans nil))
|
||||
(while (and (not ans) exprlst)
|
||||
(if (string-match (car (car exprlst)) file)
|
||||
(setq ans (car exprlst)))
|
||||
(setq exprlst (cdr exprlst)))
|
||||
(cdr ans))))
|
||||
(if expr
|
||||
(let (tnl)
|
||||
(set-buffer (get-buffer-create "*etags tmp*"))
|
||||
(while (not (save-excursion (end-of-line) (eobp)))
|
||||
(save-excursion
|
||||
(setq tnl (speedbar-extract-one-symbol expr)))
|
||||
(if tnl (setq newlist (cons tnl newlist)))
|
||||
(forward-line 1)))
|
||||
(dframe-message
|
||||
"Sorry, no support for a file of that extension"))))
|
||||
)
|
||||
(save-excursion
|
||||
(if (get-buffer "*etags tmp*")
|
||||
(kill-buffer "*etags tmp*")) ;kill to clean it up
|
||||
(if (<= 1 speedbar-verbosity-level)
|
||||
(dframe-message "Fetching etags..."))
|
||||
(set-buffer (get-buffer-create "*etags tmp*"))
|
||||
(apply 'call-process speedbar-fetch-etags-command nil
|
||||
(current-buffer) nil
|
||||
(append speedbar-fetch-etags-arguments (list file)))
|
||||
(goto-char (point-min))
|
||||
(if (<= 1 speedbar-verbosity-level)
|
||||
(dframe-message "Fetching etags..."))
|
||||
(let ((expr
|
||||
(let ((exprlst speedbar-fetch-etags-parse-list)
|
||||
(ans nil))
|
||||
(while (and (not ans) exprlst)
|
||||
(if (string-match (car (car exprlst)) file)
|
||||
(setq ans (car exprlst)))
|
||||
(setq exprlst (cdr exprlst)))
|
||||
(cdr ans))))
|
||||
(if expr
|
||||
(let (tnl)
|
||||
(set-buffer (get-buffer-create "*etags tmp*"))
|
||||
(while (not (save-excursion (end-of-line) (eobp)))
|
||||
(save-excursion
|
||||
(setq tnl (speedbar-extract-one-symbol expr)))
|
||||
(if tnl (setq newlist (cons tnl newlist)))
|
||||
(forward-line 1)))
|
||||
(dframe-message
|
||||
"Sorry, no support for a file of that extension"))))
|
||||
(if speedbar-sort-tags
|
||||
(sort newlist (lambda (a b) (string< (car a) (car b))))
|
||||
(reverse newlist))))
|
||||
|
||||
@ -760,27 +760,27 @@ Optional EVENT is acceptable as the starting event of the stroke."
|
||||
(setq safe-to-draw-p t))
|
||||
(push (cdr (mouse-pixel-position))
|
||||
pix-locs)))
|
||||
(setq event (read--potential-mouse-event)))))
|
||||
;; protected
|
||||
;; clean up strokes buffer and then bury it.
|
||||
(when (equal (buffer-name) strokes-buffer-name)
|
||||
(subst-char-in-region (point-min) (point-max)
|
||||
strokes-character ?\s)
|
||||
(goto-char (point-min))
|
||||
(bury-buffer))))
|
||||
;; Otherwise, don't use strokes buffer and read stroke silently
|
||||
(when prompt
|
||||
(message "%s" prompt)
|
||||
(setq event (read--potential-mouse-event))
|
||||
(or (strokes-button-press-event-p event)
|
||||
(error "You must draw with the mouse")))
|
||||
(track-mouse
|
||||
(or event (setq event (read--potential-mouse-event)))
|
||||
(while (not (strokes-button-release-event-p event))
|
||||
(if (strokes-mouse-event-p event)
|
||||
(push (cdr (mouse-pixel-position))
|
||||
pix-locs))
|
||||
(setq event (read--potential-mouse-event))))
|
||||
(setq event (read--potential-mouse-event))))
|
||||
;; protected
|
||||
;; clean up strokes buffer and then bury it.
|
||||
(when (equal (buffer-name) strokes-buffer-name)
|
||||
(subst-char-in-region (point-min) (point-max)
|
||||
strokes-character ?\s)
|
||||
(goto-char (point-min))
|
||||
(bury-buffer))))
|
||||
;; Otherwise, don't use strokes buffer and read stroke silently
|
||||
(when prompt
|
||||
(message "%s" prompt)
|
||||
(setq event (read--potential-mouse-event))
|
||||
(or (strokes-button-press-event-p event)
|
||||
(error "You must draw with the mouse")))
|
||||
(track-mouse
|
||||
(or event (setq event (read--potential-mouse-event)))
|
||||
(while (not (strokes-button-release-event-p event))
|
||||
(if (strokes-mouse-event-p event)
|
||||
(push (cdr (mouse-pixel-position))
|
||||
pix-locs))
|
||||
(setq event (read--potential-mouse-event)))))
|
||||
(setq grid-locs (strokes-renormalize-to-grid (nreverse pix-locs)))
|
||||
(strokes-fill-stroke
|
||||
(strokes-eliminate-consecutive-redundancies grid-locs)))))
|
||||
|
||||
@ -1445,20 +1445,19 @@ match, the user will be asked to confirm the replacement."
|
||||
(as-words reftex-index-phrases-search-whole-words))
|
||||
(unless macro-data
|
||||
(error "No macro associated with key %c" char))
|
||||
(unwind-protect
|
||||
(let ((overlay-arrow-string "=>")
|
||||
(overlay-arrow-position
|
||||
reftex-index-phrases-marker)
|
||||
(replace-count 0))
|
||||
;; Show the overlay arrow
|
||||
(move-marker reftex-index-phrases-marker
|
||||
(match-beginning 0) (current-buffer))
|
||||
;; Start the query-replace
|
||||
(reftex-query-index-phrase-globally
|
||||
files phrase macro-fmt
|
||||
index-key repeat as-words)
|
||||
(message "%s replaced"
|
||||
(reftex-number replace-count "occurrence"))))))
|
||||
(let ((overlay-arrow-string "=>")
|
||||
(overlay-arrow-position
|
||||
reftex-index-phrases-marker)
|
||||
(replace-count 0))
|
||||
;; Show the overlay arrow
|
||||
(move-marker reftex-index-phrases-marker
|
||||
(match-beginning 0) (current-buffer))
|
||||
;; Start the query-replace
|
||||
(reftex-query-index-phrase-globally
|
||||
files phrase macro-fmt
|
||||
index-key repeat as-words)
|
||||
(message "%s replaced"
|
||||
(reftex-number replace-count "occurrence")))))
|
||||
(t (error "Cannot parse this line")))))
|
||||
|
||||
(defun reftex-index-all-phrases ()
|
||||
|
||||
@ -1935,8 +1935,8 @@ specific features."
|
||||
(if (and cell table-detect-cell-alignment)
|
||||
(table--detect-cell-alignment cell)))
|
||||
(unless (re-search-forward border end t)
|
||||
(goto-char end))))))))))
|
||||
(restore-buffer-modified-p modified-flag)))
|
||||
(goto-char end))))))
|
||||
(restore-buffer-modified-p modified-flag)))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun table-unrecognize-region (beg end)
|
||||
|
||||
@ -71,10 +71,10 @@ RUN apt-get update && \
|
||||
libdbus-1-dev libacl1-dev acl git texinfo gdb \
|
||||
&& rm -rf /var/lib/apt/lists/*
|
||||
|
||||
# Some language servers.
|
||||
# Install clangd.
|
||||
RUN apt-get update && \
|
||||
apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0 \
|
||||
clangd python3-pylsp python3-autopep8 python3-yapf \
|
||||
clangd \
|
||||
&& rm -rf /var/lib/apt/lists/*
|
||||
|
||||
COPY . /checkout
|
||||
|
||||
@ -477,9 +477,9 @@
|
||||
;;(should (= 0 (length (directory-files testdir nil "[0-9]" t -1))))
|
||||
(should (= 5 (length (directory-files testdir nil "[0-9]" t))))
|
||||
(should (= 5 (length (directory-files testdir nil "[0-9]" t 50))))
|
||||
(should-not (directory-empty-p testdir)))
|
||||
(should-not (directory-empty-p testdir))))
|
||||
|
||||
(delete-directory testdir t)))))
|
||||
(delete-directory testdir t))))
|
||||
|
||||
(ert-deftest dired-test-directory-files-and-attributes ()
|
||||
"Test for `directory-files-and-attributes'."
|
||||
|
||||
@ -577,13 +577,12 @@ This macro is used to test if macroexpansion in `should' works."
|
||||
(lambda (format-string &rest args)
|
||||
(push (apply #'format format-string args) messages))))
|
||||
(save-window-excursion
|
||||
(unwind-protect
|
||||
(let ((case-fold-search nil)
|
||||
(ert-batch-backtrace-right-margin nil)
|
||||
(ert-batch-print-level 10)
|
||||
(ert-batch-print-length 11))
|
||||
(ert-run-tests-batch
|
||||
`(member ,failing-test-1 ,failing-test-2))))))
|
||||
(let ((case-fold-search nil)
|
||||
(ert-batch-backtrace-right-margin nil)
|
||||
(ert-batch-print-level 10)
|
||||
(ert-batch-print-length 11))
|
||||
(ert-run-tests-batch
|
||||
`(member ,failing-test-1 ,failing-test-2)))))
|
||||
(let ((long-text "(different-types[ \t\n]+(1 1 1 1 1 1 1 1 1 1 1)[ \t\n]+1)))[ \t\n]*$")
|
||||
(complex-text "(different-types[ \t\n]+((:1[ \t\n]+(:2[ \t\n]+(:3[ \t\n]+(:4[ \t\n]+(:5[ \t\n]+(:6[ \t\n]+\"abc\")))))))[ \t\n]+1)))[ \t\n]*$")
|
||||
found-long
|
||||
@ -609,14 +608,13 @@ This macro is used to test if macroexpansion in `should' works."
|
||||
(lambda (format-string &rest args)
|
||||
(push (apply #'format format-string args) messages))))
|
||||
(save-window-excursion
|
||||
(unwind-protect
|
||||
(let ((case-fold-search nil)
|
||||
(ert-batch-backtrace-right-margin nil)
|
||||
(ert-batch-backtrace-line-length nil)
|
||||
(ert-batch-print-level 6)
|
||||
(ert-batch-print-length 11))
|
||||
(ert-run-tests-batch
|
||||
`(member ,failing-test-1))))))
|
||||
(let ((case-fold-search nil)
|
||||
(ert-batch-backtrace-right-margin nil)
|
||||
(ert-batch-backtrace-line-length nil)
|
||||
(ert-batch-print-level 6)
|
||||
(ert-batch-print-length 11))
|
||||
(ert-run-tests-batch
|
||||
`(member ,failing-test-1)))))
|
||||
(let ((frame "ert-fail(((should (equal complex-list 1)) :form (equal ((:1 (:2 (:3 (:4 (:5 (:6 \"abc\"))))))) 1) :value nil :explanation (different-types ((:1 (:2 (:3 (:4 (:5 (:6 \"abc\"))))))) 1)))")
|
||||
found-frame)
|
||||
(cl-loop for msg in (reverse messages)
|
||||
|
||||
@ -66,34 +66,29 @@ This fixture temporarily unsets GPG_AGENT_INFO to enable passphrase tests,
|
||||
which will neither work with gpgsm nor GnuPG 2.1 any longer, I guess.
|
||||
Actually, I'm not sure why people would want to cache passwords in Emacs
|
||||
instead of gpg-agent."
|
||||
(unwind-protect
|
||||
(let ((agent-info (getenv "GPG_AGENT_INFO"))
|
||||
(gpghome (getenv "GNUPGHOME")))
|
||||
(condition-case error
|
||||
(let ((epg-gpg-home-directory (ert-resource-directory))
|
||||
(mml-smime-use 'epg)
|
||||
;; Create debug output in empty epg-debug-buffer.
|
||||
(epg-debug t)
|
||||
(epg-debug-buffer (get-buffer-create " *epg-test*"))
|
||||
(mml-secure-fail-when-key-problem (not interactive)))
|
||||
(with-current-buffer epg-debug-buffer
|
||||
(erase-buffer))
|
||||
;; Unset GPG_AGENT_INFO to enable passphrase caching inside Emacs.
|
||||
;; Just for testing. Jens does not recommend this for daily use.
|
||||
(setenv "GPG_AGENT_INFO")
|
||||
;; Set GNUPGHOME as gpg-agent started by gpgsm does
|
||||
;; not look in the proper places otherwise, see:
|
||||
;; https://bugs.gnupg.org/gnupg/issue2126
|
||||
(setenv "GNUPGHOME" epg-gpg-home-directory)
|
||||
(unwind-protect
|
||||
(funcall body)
|
||||
(mml-sec-test--kill-gpg-agent)))
|
||||
(error
|
||||
(setenv "GPG_AGENT_INFO" agent-info)
|
||||
(setenv "GNUPGHOME" gpghome)
|
||||
(signal (car error) (cdr error))))
|
||||
(setenv "GPG_AGENT_INFO" agent-info)
|
||||
(setenv "GNUPGHOME" gpghome))))
|
||||
(let ((agent-info (getenv "GPG_AGENT_INFO"))
|
||||
(gpghome (getenv "GNUPGHOME")))
|
||||
(unwind-protect
|
||||
(let ((epg-gpg-home-directory (ert-resource-directory))
|
||||
(mml-smime-use 'epg)
|
||||
;; Create debug output in empty epg-debug-buffer.
|
||||
(epg-debug t)
|
||||
(epg-debug-buffer (get-buffer-create " *epg-test*"))
|
||||
(mml-secure-fail-when-key-problem (not interactive)))
|
||||
(with-current-buffer epg-debug-buffer
|
||||
(erase-buffer))
|
||||
;; Unset GPG_AGENT_INFO to enable passphrase caching inside Emacs.
|
||||
;; Just for testing. Jens does not recommend this for daily use.
|
||||
(setenv "GPG_AGENT_INFO")
|
||||
;; Set GNUPGHOME as gpg-agent started by gpgsm does
|
||||
;; not look in the proper places otherwise, see:
|
||||
;; https://bugs.gnupg.org/gnupg/issue2126
|
||||
(setenv "GNUPGHOME" epg-gpg-home-directory)
|
||||
(unwind-protect
|
||||
(funcall body)
|
||||
(mml-sec-test--kill-gpg-agent)))
|
||||
(setenv "GPG_AGENT_INFO" agent-info)
|
||||
(setenv "GNUPGHOME" gpghome))))
|
||||
|
||||
(defun mml-secure-test-message-setup (method to from &optional text bcc)
|
||||
"Setup a buffer with MML METHOD, TO, and FROM headers.
|
||||
|
||||
@ -104,10 +104,10 @@
|
||||
(run-hooks 'post-command-hook)
|
||||
(should (hl-line-tests-verify 257 t))
|
||||
(with-current-buffer second-buffer
|
||||
(should (hl-line-tests-verify 999 nil)))))
|
||||
(let (kill-buffer-query-functions)
|
||||
(ignore-errors (kill-buffer first-buffer))
|
||||
(ignore-errors (kill-buffer second-buffer)))))
|
||||
(should (hl-line-tests-verify 999 nil))))
|
||||
(let (kill-buffer-query-functions)
|
||||
(ignore-errors (kill-buffer first-buffer))
|
||||
(ignore-errors (kill-buffer second-buffer))))))
|
||||
|
||||
(provide 'hl-line-tests)
|
||||
|
||||
|
||||
@ -47,7 +47,6 @@
|
||||
(require 'tramp)
|
||||
(require 'ert-x) ; ert-simulate-command
|
||||
(require 'edebug)
|
||||
(require 'python) ; some tests use pylsp
|
||||
(require 'cc-mode) ; c-mode-hook
|
||||
(require 'company nil t)
|
||||
(require 'yasnippet nil t)
|
||||
@ -122,8 +121,6 @@ then restored."
|
||||
,(format "HOME=%s"
|
||||
(expand-file-name (format "~%s" (user-login-name)))))
|
||||
process-environment))
|
||||
;; Prevent "Can't guess python-indent-offset ..." messages.
|
||||
(python-indent-guess-indent-offset-verbose . nil)
|
||||
(eglot-server-initialized-hook
|
||||
(lambda (server) (push server new-servers))))
|
||||
(setq created-files (mapcan #'eglot--make-file-or-dir file-specs))
|
||||
@ -551,90 +548,101 @@ then restored."
|
||||
(should (equal (buffer-string)
|
||||
"int bar() {return 42;} int main() {return bar();}")))))
|
||||
|
||||
(defun eglot--wait-for-clangd ()
|
||||
(eglot--sniffing (:server-notifications s-notifs)
|
||||
(should (eglot--tests-connect))
|
||||
(eglot--wait-for (s-notifs 20) (&key method &allow-other-keys)
|
||||
(string= method "textDocument/publishDiagnostics"))))
|
||||
|
||||
(ert-deftest eglot-test-basic-completions ()
|
||||
"Test basic autocompletion in a python LSP."
|
||||
(skip-unless (executable-find "pylsp"))
|
||||
"Test basic autocompletion in a clangd LSP."
|
||||
(skip-unless (executable-find "clangd"))
|
||||
(eglot--with-fixture
|
||||
`(("project" . (("something.py" . "import sys\nsys.exi"))))
|
||||
`(("project" . (("coiso.c" . "#include <stdio.h>\nint main () {fprin"))))
|
||||
(with-current-buffer
|
||||
(eglot--find-file-noselect "project/something.py")
|
||||
(should (eglot--tests-connect))
|
||||
(eglot--find-file-noselect "project/coiso.c")
|
||||
(eglot--sniffing (:server-notifications s-notifs)
|
||||
(eglot--wait-for-clangd)
|
||||
(eglot--wait-for (s-notifs 20) (&key method &allow-other-keys)
|
||||
(string= method "textDocument/publishDiagnostics")))
|
||||
(goto-char (point-max))
|
||||
(completion-at-point)
|
||||
(should (looking-back "sys.exit")))))
|
||||
(message (buffer-string))
|
||||
(should (looking-back "fprintf.?")))))
|
||||
|
||||
(ert-deftest eglot-test-non-unique-completions ()
|
||||
"Test completion resulting in 'Complete, but not unique'."
|
||||
(skip-unless (executable-find "pylsp"))
|
||||
(skip-unless (executable-find "clangd"))
|
||||
(eglot--with-fixture
|
||||
'(("project" . (("something.py" . "foo=1\nfoobar=2\nfoo"))))
|
||||
`(("project" . (("coiso.c" .
|
||||
,(concat "int foo; int fooey;"
|
||||
"int main() {foo")))))
|
||||
(with-current-buffer
|
||||
(eglot--find-file-noselect "project/something.py")
|
||||
(should (eglot--tests-connect))
|
||||
(eglot--find-file-noselect "project/coiso.c")
|
||||
(eglot--wait-for-clangd)
|
||||
(goto-char (point-max))
|
||||
(completion-at-point))
|
||||
;; FIXME: `current-message' doesn't work here :-(
|
||||
(completion-at-point)
|
||||
;; FIXME: `current-message' doesn't work here :-(
|
||||
(with-current-buffer (messages-buffer)
|
||||
(save-excursion
|
||||
(goto-char (point-max))
|
||||
(forward-line -1)
|
||||
(should (looking-at "Complete, but not unique"))))))
|
||||
(should (looking-at "Complete, but not unique")))))))
|
||||
|
||||
(ert-deftest eglot-test-basic-xref ()
|
||||
"Test basic xref functionality in a python LSP."
|
||||
(skip-unless (executable-find "pylsp"))
|
||||
"Test basic xref functionality in a clangd LSP."
|
||||
(skip-unless (executable-find "clangd"))
|
||||
(eglot--with-fixture
|
||||
`(("project" . (("something.py" . "def foo(): pass\ndef bar(): foo()"))))
|
||||
`(("project" . (("coiso.c" .
|
||||
,(concat "int foo=42; int fooey;"
|
||||
"int main() {foo=82;}")))))
|
||||
(with-current-buffer
|
||||
(eglot--find-file-noselect "project/something.py")
|
||||
(eglot--find-file-noselect "project/coiso.c")
|
||||
(should (eglot--tests-connect))
|
||||
(search-forward "bar(): f")
|
||||
(search-forward "{foo")
|
||||
(call-interactively 'xref-find-definitions)
|
||||
(should (looking-at "foo(): pass")))))
|
||||
(should (looking-at "foo=42")))))
|
||||
|
||||
(defvar eglot--test-python-buffer
|
||||
(defvar eglot--test-c-buffer
|
||||
"\
|
||||
def foobarquux(a, b, c=True): pass
|
||||
def foobazquuz(d, e, f): pass
|
||||
void foobarquux(int a, int b, int c){};
|
||||
void foobazquuz(int a, int b, int f){};
|
||||
int main() {
|
||||
")
|
||||
|
||||
(declare-function yas-minor-mode nil)
|
||||
|
||||
(ert-deftest eglot-test-snippet-completions ()
|
||||
"Test simple snippet completion in a python LSP."
|
||||
(skip-unless (and (executable-find "pylsp")
|
||||
"Test simple snippet completion in a clangd LSP."
|
||||
(skip-unless (and (executable-find "clangd")
|
||||
(functionp 'yas-minor-mode)))
|
||||
(eglot--with-fixture
|
||||
`(("project" . (("something.py" . ,eglot--test-python-buffer))))
|
||||
`(("project" . (("coiso.c" . ,eglot--test-c-buffer))))
|
||||
(with-current-buffer
|
||||
(eglot--find-file-noselect "project/something.py")
|
||||
(eglot--find-file-noselect "project/coiso.c")
|
||||
(yas-minor-mode 1)
|
||||
(let ((eglot-workspace-configuration
|
||||
`((:pylsp . (:plugins (:jedi_completion (:include_params t)))))))
|
||||
(should (eglot--tests-connect)))
|
||||
(eglot--wait-for-clangd)
|
||||
(goto-char (point-max))
|
||||
(insert "foobar")
|
||||
(completion-at-point)
|
||||
(should (looking-back "foobarquux("))
|
||||
(should (looking-at "a, b)")))))
|
||||
(should (looking-at "int a, int b, int c)")))))
|
||||
|
||||
(defvar company-candidates)
|
||||
(declare-function company-mode nil)
|
||||
(declare-function company-complete nil)
|
||||
|
||||
(ert-deftest eglot-test-snippet-completions-with-company ()
|
||||
"Test simple snippet completion in a python LSP."
|
||||
(skip-unless (and (executable-find "pylsp")
|
||||
"Test simple snippet completion in a clangd LSP."
|
||||
(skip-unless (and (executable-find "clangd")
|
||||
(functionp 'yas-minor-mode)
|
||||
(functionp 'company-complete)))
|
||||
(eglot--with-fixture
|
||||
`(("project" . (("something.py" . ,eglot--test-python-buffer))))
|
||||
`(("project" . (("coiso.c" . ,eglot--test-c-buffer))))
|
||||
(with-current-buffer
|
||||
(eglot--find-file-noselect "project/something.py")
|
||||
(eglot--find-file-noselect "project/coiso.c")
|
||||
(yas-minor-mode 1)
|
||||
(let ((eglot-workspace-configuration
|
||||
`((:pylsp . (:plugins (:jedi_completion (:include_params t)))))))
|
||||
(should (eglot--tests-connect)))
|
||||
(eglot--wait-for-clangd)
|
||||
(goto-char (point-max))
|
||||
(insert "foo")
|
||||
(company-mode)
|
||||
@ -642,98 +650,63 @@ def foobazquuz(d, e, f): pass
|
||||
(should (looking-back "fooba"))
|
||||
(should (= 2 (length company-candidates)))
|
||||
;; this last one is brittle, since there it is possible that
|
||||
;; pylsp will change the representation of this candidate
|
||||
(should (member "foobazquuz(d, e, f)" company-candidates)))))
|
||||
;; clangd will change the representation of this candidate
|
||||
(should (member "foobazquuz(int a, int b, int f)" company-candidates)))))
|
||||
|
||||
(ert-deftest eglot-test-eldoc-after-completions ()
|
||||
"Test documentation echo in a python LSP."
|
||||
(skip-unless (executable-find "pylsp"))
|
||||
"Test documentation echo in a clangd LSP."
|
||||
(skip-unless (executable-find "clangd"))
|
||||
(eglot--with-fixture
|
||||
`(("project" . (("something.py" . "import sys\nsys.exi"))))
|
||||
`(("project" . (("coiso.c" . "#include <stdio.h>\nint main () {fprin"))))
|
||||
(with-current-buffer
|
||||
(eglot--find-file-noselect "project/something.py")
|
||||
(should (eglot--tests-connect))
|
||||
(eglot--find-file-noselect "project/coiso.c")
|
||||
(eglot--wait-for-clangd)
|
||||
(goto-char (point-max))
|
||||
(completion-at-point)
|
||||
(should (looking-back "sys.exit"))
|
||||
(should (string-match "^exit" (eglot--tests-force-full-eldoc))))))
|
||||
(message (buffer-string))
|
||||
(should (looking-back "fprintf(?"))
|
||||
(unless (= (char-before) ?\() (insert "()") (backward-char))
|
||||
(eglot--signal-textDocument/didChange)
|
||||
(should (string-match "^fprintf" (eglot--tests-force-full-eldoc))))))
|
||||
|
||||
(ert-deftest eglot-test-multiline-eldoc ()
|
||||
"Test if suitable amount of lines of hover info are shown."
|
||||
(skip-unless (executable-find "pylsp"))
|
||||
"Test Eldoc documentation from multiple osurces."
|
||||
(skip-unless (executable-find "clangd"))
|
||||
(eglot--with-fixture
|
||||
`(("project" . (("hover-first.py" . "from datetime import datetime"))))
|
||||
`(("project" . (("coiso.c" .
|
||||
"#include <stdio.h>\nint main () {fprintf(blergh);}"))))
|
||||
(with-current-buffer
|
||||
(eglot--find-file-noselect "project/hover-first.py")
|
||||
(should (eglot--tests-connect))
|
||||
(goto-char (point-max))
|
||||
;; one-line
|
||||
(let* ((eldoc-echo-area-use-multiline-p t)
|
||||
(captured-message (eglot--tests-force-full-eldoc)))
|
||||
(should (string-match "datetim" captured-message))
|
||||
(eglot--find-file-noselect "project/coiso.c")
|
||||
(search-forward "fprintf(ble")
|
||||
(eglot--wait-for-clangd)
|
||||
(flymake-start nil t) ;; thing brings in the "unknown identifier blergh"
|
||||
(let* ((captured-message (eglot--tests-force-full-eldoc)))
|
||||
;; check for signature and error message in the result
|
||||
(should (string-match "fprintf" captured-message))
|
||||
(should (string-match "blergh" captured-message))
|
||||
(should (cl-find ?\n captured-message))))))
|
||||
|
||||
(ert-deftest eglot-test-single-line-eldoc ()
|
||||
"Test if suitable amount of lines of hover info are shown."
|
||||
(skip-unless (executable-find "pylsp"))
|
||||
(eglot--with-fixture
|
||||
`(("project" . (("hover-first.py" . "from datetime import datetime"))))
|
||||
(with-current-buffer
|
||||
(eglot--find-file-noselect "project/hover-first.py")
|
||||
(should (eglot--tests-connect))
|
||||
(goto-char (point-max))
|
||||
;; one-line
|
||||
(let* ((eldoc-echo-area-use-multiline-p nil)
|
||||
(captured-message (eglot--tests-force-full-eldoc)))
|
||||
(should (string-match "datetim" captured-message))
|
||||
(should (not (cl-find ?\n eldoc-last-message)))))))
|
||||
|
||||
(ert-deftest eglot-test-python-autopep-formatting ()
|
||||
"Test formatting in the pylsp python LSP.
|
||||
pylsp prefers autopep over yafp, despite its README stating the contrary."
|
||||
(ert-deftest eglot-test-formatting ()
|
||||
"Test formatting in the clangd server."
|
||||
;; Beware, default autopep rules can change over time, which may
|
||||
;; affect this test.
|
||||
(skip-unless (and (executable-find "pylsp")
|
||||
(executable-find "autopep8")))
|
||||
(skip-unless (executable-find "clangd"))
|
||||
(eglot--with-fixture
|
||||
`(("project" . (("something.py" . "def a():pass\n\ndef b():pass"))))
|
||||
`(("project" . (("coiso.c" . ,(concat "#include <stdio.h>\n"
|
||||
"int main(){fprintf(blergh);}"
|
||||
"int ble{\n\nreturn 0;}")))))
|
||||
(with-current-buffer
|
||||
(eglot--find-file-noselect "project/something.py")
|
||||
(should (eglot--tests-connect))
|
||||
(eglot--find-file-noselect "project/coiso.c")
|
||||
(eglot--wait-for-clangd)
|
||||
(forward-line)
|
||||
;; Try to format just the second line
|
||||
(search-forward "b():pa")
|
||||
(eglot-format (line-beginning-position) (line-end-position))
|
||||
(should (looking-at "ss"))
|
||||
(should
|
||||
(or (string= (buffer-string) "def a():pass\n\n\ndef b(): pass\n")
|
||||
;; autopep8 2.0.0 (pycodestyle: 2.9.1)
|
||||
(string= (buffer-string) "def a():pass\n\ndef b(): pass")))
|
||||
;; now format the whole buffer
|
||||
(should (looking-at "int main() { fprintf(blergh); }"))
|
||||
;; ;; now format the whole buffer
|
||||
(eglot-format-buffer)
|
||||
(should
|
||||
(string= (buffer-string) "def a(): pass\n\n\ndef b(): pass\n")))))
|
||||
|
||||
(ert-deftest eglot-test-python-yapf-formatting ()
|
||||
"Test formatting in the pylsp python LSP."
|
||||
(skip-unless (and (executable-find "pylsp")
|
||||
(not (executable-find "autopep8"))
|
||||
(or (executable-find "yapf")
|
||||
(executable-find "yapf3"))))
|
||||
(eglot--with-fixture
|
||||
`(("project" . (("something.py" . "def a():pass\ndef b():pass"))))
|
||||
(with-current-buffer
|
||||
(eglot--find-file-noselect "project/something.py")
|
||||
(should (eglot--tests-connect))
|
||||
;; Try to format just the second line
|
||||
(search-forward "b():pa")
|
||||
(eglot-format (line-beginning-position) (line-end-position))
|
||||
(should (looking-at "ss"))
|
||||
(should
|
||||
(string= (buffer-string) "def a():pass\n\n\ndef b():\n pass\n"))
|
||||
;; now format the whole buffer
|
||||
(eglot-format-buffer)
|
||||
(should
|
||||
(string= (buffer-string) "def a():\n pass\n\n\ndef b():\n pass\n")))))
|
||||
(string= (buffer-string)
|
||||
"#include <stdio.h>\nint main() { fprintf(blergh); }\nint ble { return 0; }")))))
|
||||
|
||||
(ert-deftest eglot-test-rust-on-type-formatting ()
|
||||
"Test textDocument/onTypeFormatting against rust-analyzer."
|
||||
|
||||
@ -579,7 +579,8 @@
|
||||
(cons (mapcar (pcase-lambda (`(,evald ,func ,args ,_))
|
||||
`(,evald ,func ,@args))
|
||||
(backtrace-frames base))
|
||||
(subr-test--backtrace-frames-with-backtrace-frame base))))))
|
||||
(subr-test--backtrace-frames-with-backtrace-frame base))
|
||||
(sit-for 0))))) ; dummy unwind form
|
||||
|
||||
(defun subr-test--frames-1 (base)
|
||||
(subr-test--frames-2 base))
|
||||
|
||||
@ -536,7 +536,7 @@ https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html."
|
||||
"Verify we can compile calls to redefined primitives with
|
||||
dedicated byte-op code."
|
||||
(let (x
|
||||
(f (lambda (fn &rest args)
|
||||
(f (lambda (_fn &rest args)
|
||||
(setq comp-test-primitive-redefine-args args))))
|
||||
(advice-add #'delete-region :around f)
|
||||
(unwind-protect
|
||||
|
||||
Loading…
Reference in New Issue
Block a user