commit e8b6cc9a99374b135a3a71dabefcdf98fe2bc6e6 (HEAD, refs/remotes/origin/master) Author: João Távora Date: Mon Feb 18 20:41:09 2019 +0000 cycle-sort-function prevails in completion-all-sorted-completions * lisp/minibuffer.el (completion-all-sorted-completions): If completion table has cycle-sort-function, that prevails over other sorting strategies. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 7413be42eb..cc87ffaced 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1246,19 +1246,23 @@ scroll the window of possible completions." (setq all (delete-dups all)) (setq last (last all)) - (setq all (if sort-fun (funcall sort-fun all) - ;; Prefer shorter completions, by default. - (sort all (lambda (c1 c2) (< (length c1) (length c2)))))) - ;; Prefer recently used completions and put the default, if - ;; it exists, on top. - (when (minibufferp) - (let ((hist (symbol-value minibuffer-history-variable))) - (setq all (sort all + (cond + (sort-fun + (setq all (funcall sort-fun all))) + (t + ;; Prefer shorter completions, by default. + (setq all (sort all (lambda (c1 c2) (< (length c1) (length c2))))) + (if (minibufferp) + ;; Prefer recently used completions and put the default, if + ;; it exists, on top. + (let ((hist (symbol-value minibuffer-history-variable))) + (setq all + (sort all (lambda (c1 c2) (cond ((equal c1 minibuffer-default) t) ((equal c2 minibuffer-default) nil) (t (> (length (member c1 hist)) - (length (member c2 hist)))))))))) + (length (member c2 hist)))))))))))) ;; Cache the result. This is not just for speed, but also so that ;; repeated calls to minibuffer-force-complete can cycle through ;; all possibilities. commit 55478e4ad724fcc1194c9556b7699e6144e64971 Author: João Távora Date: Mon Feb 18 20:32:38 2019 +0000 switch-to-buffer's completion table uses its own sorting * src/minibuf.c (Finternal_complete_buffer): Add Qcycle_sort_function to completion table's metadata. (syms_of_minibuf): New symbol Qcycle_sort_function. diff --git a/src/minibuf.c b/src/minibuf.c index 321fda1ba8..b23e24c4bd 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -1801,7 +1801,9 @@ If FLAG is nil, invoke `try-completion'; if it is t, invoke else if (EQ (flag, Qlambda)) return Ftest_completion (string, Vbuffer_alist, predicate); else if (EQ (flag, Qmetadata)) - return list2 (Qmetadata, Fcons (Qcategory, Qbuffer)); + return list3 (Qmetadata, + Fcons (Qcategory, Qbuffer), + Fcons (Qcycle_sort_function, Qidentity)); else return Qnil; } @@ -1922,6 +1924,8 @@ syms_of_minibuf (void) DEFSYM (Qactivate_input_method, "activate-input-method"); DEFSYM (Qcase_fold_search, "case-fold-search"); DEFSYM (Qmetadata, "metadata"); + DEFSYM (Qcycle_sort_function, "cycle-sort-function"); + /* A frame parameter. */ DEFSYM (Qminibuffer_exit, "minibuffer-exit"); commit 37003753341e3fd524d00b6a4bd2b72c668e0c57 Merge: 3f6e4c1ce5 1a6bcc91e3 Author: Michael R. Mauger Date: Mon Feb 18 23:31:21 2019 -0500 Merge branch 'wallet' commit 1a6bcc91e3e468e5a6d3e0b121bb675b576d3362 (refs/remotes/origin/wallet) Author: Michael R. Mauger Date: Mon Feb 18 23:15:54 2019 -0500 * lisp/progmodes/sql.el: Added password wallet using `auth-source' package. (sql-auth-source-search-wallet): New function. (sql-password-wallet): New variable. (sql-password-search-wallet-function): New variable. (sql-get-login): Handle password wallet search. (sql-product-interactive): Handle password function. * test/lisp/progmodes/sql-test.el: Test wallet changes. (sql-test-login-params): New test variable. (with-sql-test-connect-harness): New macro to wrap test configuration around calls to `sql-connect'. (sql-test-connect, sql-test-connect-password-func) (sql-test-connect-wallet-server-database) (sql-test-connect-wallet-database) (sql-test-connect-wallet-server): New ERT tests. * etc/NEWS: Updated SQL Mode descriptions. diff --git a/etc/NEWS b/etc/NEWS index 0cafbaae96..253da49989 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -515,27 +515,45 @@ end. ** SQL -*** Installation of 'sql-indent' from ELPA is strongly encouraged. -This package support sophisticated rules for properly indenting SQL -statements. SQL is not like other programming languages like C, Java, -or Python where code is sparse and rules for formatting are fairly -well established. Instead SQL is more like COBOL (from which it came) -and code tends to be very dense and line ending decisions driven by -syntax and line length considerations to make readable code. -Experienced SQL developers may prefer to rely upon existing Emacs -facilities for formatting code but the 'sql-indent' package provides -facilities to aid more casual SQL developers layout queries and -complex expressions. - -*** 'sql-use-indent-support' (default t) enables SQL indention support. +*** SQL Indent Minor Mode + +SQL Mode now supports the ELPA 'sql-indent' package for assisting +sophisticated SQL indenting rules. Note, however, that SQL is not +like other programming languages like C, Java, or Python where code is +sparse and rules for formatting are fairly well established. Instead +SQL is more like COBOL (from which it came) and code tends to be very +dense and line ending decisions driven by syntax and line length +considerations to make readable code. Experienced SQL developers may +prefer to rely upon existing Emacs facilities for formatting code but +the 'sql-indent' package provides facilities to aid more casual SQL +developers layout queries and complex expressions. + +**** 'sql-use-indent-support' (default t) enables SQL indention support. The 'sql-indent' package from ELPA must be installed to get the indentation support in 'sql-mode' and 'sql-interactive-mode'. -*** 'sql-mode-hook' and 'sql-interactive-mode-hook' changed. +**** 'sql-mode-hook' and 'sql-interactive-mode-hook' changed. Both hook variables have had 'sql-indent-enable' added to their -default values. If youhave existing customizations to these variables, +default values. If you have existing customizations to these variables, you should make sure that the new default entry is included. +*** Connection Wallet + +Database passwords can now by stored in NETRC or JSON data files that +may optionally be encrypted. When establishing an interactive session +with the database via 'sql-connect' or a product specific function, +like 'sql-mysql' or 'my-postgres', the password wallet will be +searched for the password. The 'sql-product', 'sql-server', +'sql-database', and the 'sql-username' will be used to identify the +appropriate authorization. This eliminates the discouraged practice of +embedding database passwords in your Emacs initialization. + +See the `auth-source' module for complete documentation on the file +formats. By default, the wallet file is expected to be in the +`user-emacs-directory', named 'sql-wallet' or '.sql-wallet', with +'.json' (JSON) or no (NETRC) suffix. Both file formats can optionally +be encrypted with GPG by adding an additional '.gpg' suffix. + ** Term --- diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 2df62585a0..c72070b892 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -748,6 +748,126 @@ The package must be available to be loaded and activated." (when (sql-is-indent-available) (sqlind-minor-mode (if sql-use-indent-support +1 -1)))) +;; Secure Password wallet + +(require 'auth-source) + +(defun sql-auth-source-search-wallet (wallet product user server database port) + "Read auth source WALLET to locate the USER secret. +Sets `auth-sources' to WALLET and uses `auth-source-search' to locate the entry. +The DATABASE and SERVER are concatenated with a slash between them as the +host key." + (let* ((auth-sources wallet) + host + secret h-secret sd-secret) + + ;; product + (setq product (symbol-name product)) + + ;; user + (setq user (unless (string-empty-p user) user)) + + ;; port + (setq port + (when (and port (numberp port) (not (zerop port))) + (number-to-string port))) + + ;; server + (setq server (unless (string-empty-p server) server)) + + ;; database + (setq database (unless (string-empty-p database) database)) + + ;; host + (setq host (if server + (if database + (concat server "/" database) + server) + database)) + + ;; Perform search + (dolist (s (auth-source-search :max 1000)) + (when (and + ;; Is PRODUCT specified, in the enty, and they are equal + (if product + (if (plist-member s :product) + (equal (plist-get s :product) product) + t) + t) + ;; Is USER specified, in the entry, and they are equal + (if user + (if (plist-member s :user) + (equal (plist-get s :user) user) + t) + t) + ;; Is PORT specified, in the entry, and they are equal + (if port + (if (plist-member s :port) + (equal (plist-get s :port) port) + t) + t)) + ;; Is HOST specified, in the entry, and they are equal + ;; then the H-SECRET list + (if (and host + (plist-member s :host) + (equal (plist-get s :host) host)) + (push s h-secret) + ;; Are SERVER and DATABASE specified, present, and equal + ;; then the SD-SECRET list + (if (and server + (plist-member s :server) + database + (plist-member s :database) + (equal (plist-get s :server) server) + (equal (plist-get s :database) database)) + (push s sd-secret) + ;; Is SERVER specified, in the entry, and they are equal + ;; then the base SECRET list + (if (and server + (plist-member s :server) + (equal (plist-get s :server) server)) + (push s secret) + ;; Is DATABASE specified, in the entry, and they are equal + ;; then the base SECRET list + (if (and database + (plist-member s :database) + (equal (plist-get s :database) database)) + (push s secret))))))) + (setq secret (or h-secret sd-secret secret)) + + ;; If we found a single secret, return the password + (when (= 1 (length secret)) + (setq secret (car secret)) + (if (plist-member secret :secret) + (plist-get secret :secret) + nil)))) + +(defcustom sql-password-wallet + (let (wallet w) + (dolist (ext '(".json.gpg" ".gpg" ".json" "") wallet) + (unless wallet + (setq w (locate-user-emacs-file (concat "sql-wallet" ext) + (concat ".sql-wallet" ext))) + (when (file-exists-p w) + (setq wallet w))))) + "Identification of the password wallet. +See `sql-password-search-wallet-function' to understand how this value +is used to locate the password wallet." + :type `(plist-get (symbol-plist 'auth-sources) 'custom-type) + :group 'SQL + :version "27.1") + +(defvar sql-password-search-wallet-function #'sql-auth-source-search-wallet + "Function to handle the lookup of the database password. +The specified function will be called as: + (wallet-func WALLET PRODUCT USER SERVER DATABASE PORT) + +It is expected to return either a string containing the password, +a function returning the password, or nil, If you want to support +another format of password file, then implement a different +search wallet function and identify the location of the password +store with `sql-password-wallet'.") + ;; misc customization of sql.el behavior (defcustom sql-electric-stuff nil @@ -3199,6 +3319,10 @@ symbol `password', for the server if it contains the symbol `database'. The members of WHAT are processed in the order in which they are provided. +If the `sql-password-wallet' is non-nil and WHAT contains the +`password' token, then the `password' token will be pushed to the +end to be sure that all of the values can be fed to the wallet. + Each token may also be a list with the token in the car and a plist of options as the cdr. The following properties are supported: @@ -3210,6 +3334,15 @@ supported: In order to ask the user for username, password and database, call the function like this: (sql-get-login \\='user \\='password \\='database)." + + ;; Push the password to the end if we have a wallet + (when (and sql-password-wallet + (fboundp sql-password-search-wallet-function) + (member 'password what)) + (setq what (append (cl-delete 'password what) + '(password)))) + + ;; Prompt for each parameter (dolist (w what) (let ((plist (cdr-safe w))) (pcase (or (car-safe w) w) @@ -3218,7 +3351,19 @@ function like this: (sql-get-login \\='user \\='password \\='database)." ('password (setq-default sql-password - (read-passwd "Password: " nil (sql-default-value 'sql-password)))) + (if (and sql-password-wallet + (fboundp sql-password-search-wallet-function)) + (let ((password (funcall sql-password-search-wallet-function + sql-password-wallet + sql-product + sql-user + sql-server + sql-database + sql-port))) + (if password + password + (read-passwd "Password: " nil (sql-default-value 'sql-password)))) + (read-passwd "Password: " nil (sql-default-value 'sql-password))))) ('server (sql-get-login-ext 'sql-server "Server: " 'sql-server-history plist)) @@ -4481,6 +4626,10 @@ the call to \\[sql-product-interactive] with (or sql-default-directory default-directory))) + ;; The password wallet returns a function which supplies the password. + (when (functionp sql-password) + (setq sql-password (funcall sql-password))) + ;; Call the COMINT service (funcall (sql-get-product-feature product :sqli-comint-func) product diff --git a/test/lisp/progmodes/sql-tests.el b/test/lisp/progmodes/sql-tests.el index 604c02172e..a68f9319c2 100644 --- a/test/lisp/progmodes/sql-tests.el +++ b/test/lisp/progmodes/sql-tests.el @@ -53,5 +53,106 @@ (error "some error")))) (should-not (sql-postgres-list-databases)))) +(defvar sql-test-login-params nil) +(defmacro with-sql-test-connect-harness (id login-params connection expected) + "Set-up and tear-down SQL connect related test. + +Identify tests by ID. Set :sql-login dialect attribute to +LOGIN-PARAMS. Provide the CONNECTION parameters and the EXPECTED +string of values passed to the comint function for validation." + (declare (indent 2)) + `(cl-letf + ((sql-test-login-params ' ,login-params) + ((symbol-function 'sql-comint-test) + (lambda (product options &optional buf-name) + (with-current-buffer (get-buffer-create buf-name) + (insert (pp-to-string (list product options sql-user sql-password sql-server sql-database)))))) + ((symbol-function 'sql-run-test) + (lambda (&optional buffer) + (interactive "P") + (sql-product-interactive 'sqltest buffer))) + (sql-user nil) + (sql-server nil) + (sql-database nil) + (sql-product-alist + '((ansi) + (sqltest + :name "SqlTest" + :sqli-login sql-test-login-params + :sqli-comint-func sql-comint-test))) + (sql-connection-alist + '((,(format "test-%s" id) + ,@connection))) + (sql-password-wallet + (list + (make-temp-file + "sql-test-netrc" nil nil + (mapconcat #'identity + '("machine aMachine user aUserName password \"netrc-A aPassword\"" + "machine aServer user aUserName password \"netrc-B aPassword\"" + "machine aMachine server aServer user aUserName password \"netrc-C aPassword\"" + "machine aMachine database aDatabase user aUserName password \"netrc-D aPassword\"" + "machine aDatabase user aUserName password \"netrc-E aPassword\"" + "machine aMachine server aServer database aDatabase user aUserName password \"netrc-F aPassword\"" + "machine \"aServer/aDatabase\" user aUserName password \"netrc-G aPassword\"" + ) "\n"))))) + + (let* ((connection ,(format "test-%s" id)) + (buffername (format "*SQL: ERT TEST <%s>*" connection))) + (when (get-buffer buffername) + (kill-buffer buffername)) + (sql-connect connection buffername) + (should (get-buffer buffername)) + (should (string-equal (with-current-buffer buffername (buffer-string)) ,expected)) + (when (get-buffer buffername) + (kill-buffer buffername)) + (delete-file (car sql-password-wallet))))) + +(ert-deftest sql-test-connect () + "Test of basic `sql-connect'." + (with-sql-test-connect-harness 1 (user password server database) + ((sql-product 'sqltest) + (sql-user "aUserName") + (sql-password "test-1 aPassword") + (sql-server "aServer") + (sql-database "aDatabase")) + "(sqltest nil \"aUserName\" \"test-1 aPassword\" \"aServer\" \"aDatabase\")\n")) + +(ert-deftest sql-test-connect-password-func () + "Test of password function." + (with-sql-test-connect-harness 2 (user password server database) + ((sql-product 'sqltest) + (sql-user "aUserName") + (sql-password (lambda () (concat [?t ?e ?s ?t ?- ?2 ?\s + ?a ?P ?a ?s ?s ?w ?o ?r ?d]))) + (sql-server "aServer") + (sql-database "aDatabase")) + "(sqltest nil \"aUserName\" \"test-2 aPassword\" \"aServer\" \"aDatabase\")\n")) + +(ert-deftest sql-test-connect-wallet-server-database () + "Test of password function." + (with-sql-test-connect-harness 3 (user password server database) + ((sql-product 'sqltest) + (sql-user "aUserName") + (sql-server "aServer") + (sql-database "aDatabase")) + "(sqltest nil \"aUserName\" \"netrc-G aPassword\" \"aServer\" \"aDatabase\")\n")) + +(ert-deftest sql-test-connect-wallet-database () + "Test of password function." + (with-sql-test-connect-harness 4 (user password database) + ((sql-product 'sqltest) + (sql-user "aUserName") + (sql-database "aDatabase")) + "(sqltest nil \"aUserName\" \"netrc-E aPassword\" nil \"aDatabase\")\n")) + +(ert-deftest sql-test-connect-wallet-server () + "Test of password function." + (with-sql-test-connect-harness 5 (user password server) + ((sql-product 'sqltest) + (sql-user "aUserName") + (sql-server "aServer")) + "(sqltest nil \"aUserName\" \"netrc-B aPassword\" \"aServer\" nil)\n")) + (provide 'sql-tests) ;;; sql-tests.el ends here commit 3f6e4c1ce54d995b977ba762513666cb21243c2b Author: Stefan Monnier Date: Mon Feb 18 23:11:25 2019 -0500 * lisp/mh-e/mh-acros.el (mh-defstruct): Minor simplification diff --git a/lisp/mh-e/mh-acros.el b/lisp/mh-e/mh-acros.el index 893564419b..3bbf509989 100644 --- a/lisp/mh-e/mh-acros.el +++ b/lisp/mh-e/mh-acros.el @@ -143,6 +143,8 @@ check if variable `transient-mark-mode' is active." ;;;###mh-autoload (defmacro mh-defstruct (name-spec &rest fields) + ;; FIXME: Use `cl-defstruct' instead: shouldn't emit warnings any + ;; more nor depend on run-time CL functions. "Replacement for `defstruct' from the \"cl\" package. The `defstruct' in the \"cl\" library produces compiler warnings, and generates code that uses functions present in \"cl\" at @@ -160,15 +162,17 @@ more details." (constructor (or (and (consp name-spec) (cadr (assoc :constructor (cdr name-spec)))) (intern (format "make-%s" struct-name)))) - (field-names (mapcar #'(lambda (x) (if (atom x) x (car x))) fields)) - (field-init-forms (mapcar #'(lambda (x) (and (consp x) (cadr x))) - fields)) + (fields (mapcar (lambda (x) + (if (atom x) + (list x nil) + (list (car x) (cadr x)))) + fields)) + (field-names (mapcar #'car fields)) (struct (gensym "S")) (x (gensym "X")) (y (gensym "Y"))) `(progn - (defun* ,constructor (&key ,@(mapcar* #'(lambda (x y) (list x y)) - field-names field-init-forms)) + (defun* ,constructor (&key ,@fields) (list (quote ,struct-name) ,@field-names)) (defun ,predicate (arg) (and (consp arg) (eq (car arg) (quote ,struct-name)))) commit a755dc13abd7b4d344ef40a76262059ddae3e4ce Author: Stefan Monnier Date: Mon Feb 18 22:49:30 2019 -0500 * lisp/erc/erc.el (erc-version-string): Remove, unused diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 876e1ffceb..697e26b794 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -62,9 +62,6 @@ ;;; History: ;; -(defconst erc-version-string (format "\C-bERC\C-b (IRC client for Emacs %s)" emacs-version) - "ERC version. This is used by function `erc-version'.") - ;;; Code: (load "erc-loaddefs" nil t) commit ed1e805af7d4892e7354e8c9e2246d5017d4ff52 Author: Michael R. Mauger Date: Mon Feb 18 21:51:09 2019 -0500 * lisp/progmodes/sql.el defensive programming (sql-statement-regexp): if 'ansi' dialect is not defined, use "select" (sql-interactive-mode): establish process sentinel iff there is a process. Default values for :prompt-regexp and :prompt-length. (sql-product-interactive): only check process status iff there is a process. diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 6ad221295c..2df62585a0 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -2929,7 +2929,7 @@ displayed." ;;; Motion Functions (defun sql-statement-regexp (prod) - (let* ((ansi-stmt (sql-get-product-feature 'ansi :statement)) + (let* ((ansi-stmt (or (sql-get-product-feature 'ansi :statement) "select")) (prod-stmt (sql-get-product-feature prod :statement))) (concat "^\\<" (if prod-stmt @@ -4193,7 +4193,8 @@ you entered, right above the output it created. (setq local-abbrev-table sql-mode-abbrev-table) (setq abbrev-all-caps 1) ;; Exiting the process will call sql-stop. - (set-process-sentinel (get-buffer-process (current-buffer)) 'sql-stop) + (let ((proc (get-buffer-process (current-buffer)))) + (when proc (set-process-sentinel proc 'sql-stop))) ;; Save the connection and login params (set (make-local-variable 'sql-user) sql-user) (set (make-local-variable 'sql-database) sql-database) @@ -4211,7 +4212,7 @@ you entered, right above the output it created. (sql-make-alternate-buffer-name)) ;; User stuff. Initialize before the hook. (set (make-local-variable 'sql-prompt-regexp) - (sql-get-product-feature sql-product :prompt-regexp)) + (or (sql-get-product-feature sql-product :prompt-regexp) "^")) (set (make-local-variable 'sql-prompt-length) (sql-get-product-feature sql-product :prompt-length)) (set (make-local-variable 'sql-prompt-cont-regexp) @@ -4230,7 +4231,7 @@ you entered, right above the output it created. (concat "\\(" sql-prompt-regexp "\\|" sql-prompt-cont-regexp "\\)") sql-prompt-regexp)) - (setq left-margin sql-prompt-length) + (setq left-margin (or sql-prompt-length 0)) ;; Install input sender (set (make-local-variable 'comint-input-sender) 'sql-input-sender) ;; People wanting a different history file for each @@ -4522,7 +4523,8 @@ the call to \\[sql-product-interactive] with (let ((proc (get-buffer-process new-sqli-buffer)) (secs sql-login-delay) (step 0.3)) - (while (and (memq (process-status proc) '(open run)) + (while (and proc + (memq (process-status proc) '(open run)) (or (accept-process-output proc step) (<= 0.0 (setq secs (- secs step)))) (progn (goto-char (point-max)) commit e66d5a1c4528681ba6b3465faaa197a5701763cb Author: Stefan Monnier Date: Mon Feb 18 19:00:44 2019 -0500 * lisp/elec-pair.el: Do modify+undo more carefully (electric-pair-inhibit-if-helps-balance): Use the undo system instead of undoing by hand. diff --git a/lisp/elec-pair.el b/lisp/elec-pair.el index b5ec492930..3be09d87b4 100644 --- a/lisp/elec-pair.el +++ b/lisp/elec-pair.el @@ -429,20 +429,25 @@ some list calculations, finally restoring the situation as if nothing happened." (pcase (electric-pair-syntax-info char) (`(,syntax ,pair ,_ ,s-or-c) - (unwind-protect - (progn - (delete-char -1) - (cond ((eq ?\( syntax) - (let* ((pair-data - (electric-pair--balance-info 1 s-or-c)) - (outermost (cdr pair-data))) - (cond ((car outermost) - nil) - (t - (eq (cdr outermost) pair))))) - ((eq syntax ?\") - (electric-pair--unbalanced-strings-p char)))) - (insert char))))) + (catch 'done + ;; FIXME: modify+undo is *very* tricky business. We used to + ;; use `delete-char' followed by `insert', but this changed the + ;; position some markers. The real fix would be to compute the + ;; result without having to modify the buffer at all. + (atomic-change-group + (delete-char -1) + (throw + 'done + (cond ((eq ?\( syntax) + (let* ((pair-data + (electric-pair--balance-info 1 s-or-c)) + (outermost (cdr pair-data))) + (cond ((car outermost) + nil) + (t + (eq (cdr outermost) pair))))) + ((eq syntax ?\") + (electric-pair--unbalanced-strings-p char))))))))) (defun electric-pair-skip-if-helps-balance (char) "Return non-nil if skipping CHAR would benefit parentheses' balance. commit a812ed215ce0a7a53f51dd5aa51de720917d2ff0 Author: Paul Eggert Date: Mon Feb 18 14:51:26 2019 -0800 Speed up cl-list-length * lisp/emacs-lisp/cl-extra.el (cl-list-length): Use ‘length’ to do the real work; this is simpler and uses a better algorithm. diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 99b55ad6b7..a2400a0ba3 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -594,10 +594,10 @@ too large if positive or too small if negative)." ;;;###autoload (defun cl-list-length (x) "Return the length of list X. Return nil if list is circular." - (let ((n 0) (fast x) (slow x)) - (while (and (cdr fast) (not (and (eq fast slow) (> n 0)))) - (setq n (+ n 2) fast (cdr (cdr fast)) slow (cdr slow))) - (if fast (if (cdr fast) nil (1+ n)) n))) + (cl-check-type x list) + (condition-case nil + (length x) + (circular-list))) ;;;###autoload (defun cl-tailp (sublist list) commit 5d46862440af7957ea617e42d6c1c6ee4c46ba3e Author: Paul Eggert Date: Mon Feb 18 14:42:45 2019 -0800 Minor profiler improvements * src/profiler.c (evict_lower_half, record_backtrace) (setup_cpu_timer, cmpfn_profiler, hashfn_profiler): Assume C99. Use bool for boolean. (timer_getoverrun): Remove; simplify use to not need it. (Fprofiler_cpu_start): Any negative return from setup_cpu_timer fails. (Fprofiler_cpu_stop): Simplify initialization. diff --git a/src/profiler.c b/src/profiler.c index 293e52633a..2aa5f34574 100644 --- a/src/profiler.c +++ b/src/profiler.c @@ -118,9 +118,8 @@ static void evict_lower_half (log_t *log) { ptrdiff_t size = ASIZE (log->key_and_value) / 2; EMACS_INT median = approximate_median (log, 0, size); - ptrdiff_t i; - for (i = 0; i < size; i++) + for (ptrdiff_t i = 0; i < size; i++) /* Evict not only values smaller but also values equal to the median, so as to make sure we evict something no matter what. */ if (XFIXNUM (HASH_VALUE (log, i)) <= median) @@ -148,17 +147,14 @@ static void evict_lower_half (log_t *log) static void record_backtrace (log_t *log, EMACS_INT count) { - Lisp_Object backtrace; - ptrdiff_t index; - if (log->next_free < 0) /* FIXME: transfer the evicted counts to a special entry rather than dropping them on the floor. */ evict_lower_half (log); - index = log->next_free; + ptrdiff_t index = log->next_free; /* Get a "working memory" vector. */ - backtrace = HASH_KEY (log, index); + Lisp_Object backtrace = HASH_KEY (log, index); get_backtrace (backtrace); { /* We basically do a `gethash+puthash' here, except that we have to be @@ -232,13 +228,6 @@ static EMACS_INT current_sampling_interval; /* Signal handler for sampling profiler. */ -/* timer_getoverrun is not implemented on Cygwin prior to - cygwin-3.0.0, but the following seems to be good enough for - profiling. */ -#if defined CYGWIN && !defined HAVE_TIMER_GETOVERRUN -#define timer_getoverrun(x) 0 -#endif - static void handle_profiler_signal (int signal) { @@ -253,7 +242,7 @@ handle_profiler_signal (int signal) else { EMACS_INT count = 1; -#ifdef HAVE_ITIMERSPEC +#if defined HAVE_ITIMERSPEC && defined HAVE_TIMER_GETOVERRUN if (profiler_timer_ok) { int overruns = timer_getoverrun (profiler_timer); @@ -275,9 +264,6 @@ deliver_profiler_signal (int signal) static int setup_cpu_timer (Lisp_Object sampling_interval) { - struct sigaction action; - struct itimerval timer; - struct timespec interval; int billion = 1000000000; if (! RANGED_FIXNUMP (1, sampling_interval, @@ -288,8 +274,10 @@ setup_cpu_timer (Lisp_Object sampling_interval) return -1; current_sampling_interval = XFIXNUM (sampling_interval); - interval = make_timespec (current_sampling_interval / billion, - current_sampling_interval % billion); + struct timespec interval + = make_timespec (current_sampling_interval / billion, + current_sampling_interval % billion); + struct sigaction action; emacs_sigaction_init (&action, deliver_profiler_signal); sigaction (SIGPROF, &action, 0); @@ -309,16 +297,15 @@ setup_cpu_timer (Lisp_Object sampling_interval) #endif CLOCK_REALTIME }; - int i; struct sigevent sigev; sigev.sigev_value.sival_ptr = &profiler_timer; sigev.sigev_signo = SIGPROF; sigev.sigev_notify = SIGEV_SIGNAL; - for (i = 0; i < ARRAYELTS (system_clock); i++) + for (int i = 0; i < ARRAYELTS (system_clock); i++) if (timer_create (system_clock[i], &sigev, &profiler_timer) == 0) { - profiler_timer_ok = 1; + profiler_timer_ok = true; break; } } @@ -333,6 +320,7 @@ setup_cpu_timer (Lisp_Object sampling_interval) #endif #ifdef HAVE_SETITIMER + struct itimerval timer; timer.it_value = timer.it_interval = make_timeval (interval); if (setitimer (ITIMER_PROF, &timer, 0) == 0) return SETITIMER_RUNNING; @@ -359,7 +347,7 @@ See also `profiler-log-size' and `profiler-max-stack-depth'. */) } int status = setup_cpu_timer (sampling_interval); - if (status == -1) + if (status < 0) { profiler_cpu_running = NOT_RUNNING; error ("Invalid sampling interval"); @@ -388,8 +376,7 @@ Return non-nil if the profiler was running. */) #ifdef HAVE_ITIMERSPEC case TIMER_SETTIME_RUNNING: { - struct itimerspec disable; - memset (&disable, 0, sizeof disable); + struct itimerspec disable = { 0, }; timer_settime (profiler_timer, 0, &disable, 0); } break; @@ -398,8 +385,7 @@ Return non-nil if the profiler was running. */) #ifdef HAVE_SETITIMER case SETITIMER_RUNNING: { - struct itimerval disable; - memset (&disable, 0, sizeof disable); + struct itimerval disable = { 0, }; setitimer (ITIMER_PROF, &disable, 0); } break; @@ -551,10 +537,10 @@ cmpfn_profiler (struct hash_table_test *t, { if (VECTORP (bt1) && VECTORP (bt2)) { - ptrdiff_t i, l = ASIZE (bt1); + ptrdiff_t l = ASIZE (bt1); if (l != ASIZE (bt2)) return false; - for (i = 0; i < l; i++) + for (ptrdiff_t i = 0; i < l; i++) if (NILP (Ffunction_equal (AREF (bt1, i), AREF (bt2, i)))) return false; return true; @@ -569,8 +555,8 @@ hashfn_profiler (struct hash_table_test *ht, Lisp_Object bt) if (VECTORP (bt)) { EMACS_UINT hash = 0; - ptrdiff_t i, l = ASIZE (bt); - for (i = 0; i < l; i++) + ptrdiff_t l = ASIZE (bt); + for (ptrdiff_t i = 0; i < l; i++) { Lisp_Object f = AREF (bt, i); EMACS_UINT hash1 commit e6f8ddbb3b8f99c73b2be66bb1e691d4757c3b12 Author: Stefan Monnier Date: Mon Feb 18 13:16:57 2019 -0500 * lisp/emacs-lisp/cl-lib.el (cl-endp): Move to cl-seq.el Use 'cl-check-type'. diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index 60c52c26ca..3a9280fae6 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -365,13 +365,6 @@ SEQ, this is like `mapcar'. With several, it is like the Common Lisp (cl--defalias 'cl-second 'cadr) (cl--defalias 'cl-rest 'cdr) -(defun cl-endp (x) - "Return true if X is the empty list; false if it is a cons. -Signal an error if X is not a list." - (if (listp x) - (null x) - (signal 'wrong-type-argument (list 'listp x)))) - (cl--defalias 'cl-third 'cl-caddr "Return the third element of the list X.") (cl--defalias 'cl-fourth 'cl-cadddr "Return the fourth element of the list X.") diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el index 31ad811185..3eb6ea16da 100644 --- a/lisp/emacs-lisp/cl-seq.el +++ b/lisp/emacs-lisp/cl-seq.el @@ -112,6 +112,13 @@ (defvar cl-if) (defvar cl-if-not) (defvar cl-key) +;;;###autoload +(defun cl-endp (x) + "Return true if X is the empty list; false if it is a cons. +Signal an error if X is not a list." + (cl-check-type x list) + (null x)) + ;;;###autoload (defun cl-reduce (cl-func cl-seq &rest cl-keys) "Reduce two-argument FUNCTION across SEQ. commit eccfdaff5b52e1fadbaf2fbbb6c1366a7addf377 Author: Ken Brown Date: Sun Feb 17 12:10:26 2019 -0500 Use 'timer_getoverrun' on Cygwin when possible * configure.ac: Add a check for the 'timer_getoverrun' function. * src/profiler.c [CYGWIN] : Define 'timer_getoverrun' as a macro only on versions of Cygwin where it is not already defined as a function. diff --git a/configure.ac b/configure.ac index 58579008f3..c26eb6d1e8 100644 --- a/configure.ac +++ b/configure.ac @@ -4126,7 +4126,7 @@ getrusage get_current_dir_name \ lrand48 random rint trunc \ select getpagesize setlocale newlocale \ getrlimit setrlimit shutdown \ -pthread_sigmask strsignal setitimer \ +pthread_sigmask strsignal setitimer timer_getoverrun \ sendto recvfrom getsockname getifaddrs freeifaddrs \ gai_strerror sync \ getpwent endpwent getgrent endgrent \ diff --git a/src/profiler.c b/src/profiler.c index 15a0eef0d3..293e52633a 100644 --- a/src/profiler.c +++ b/src/profiler.c @@ -232,9 +232,10 @@ static EMACS_INT current_sampling_interval; /* Signal handler for sampling profiler. */ -/* timer_getoverrun is not implemented on Cygwin, but the following - seems to be good enough for profiling. */ -#ifdef CYGWIN +/* timer_getoverrun is not implemented on Cygwin prior to + cygwin-3.0.0, but the following seems to be good enough for + profiling. */ +#if defined CYGWIN && !defined HAVE_TIMER_GETOVERRUN #define timer_getoverrun(x) 0 #endif commit 2ede38ce4bf336c573450c61a2e9a41fb7ebe1be Author: Stefan Monnier Date: Mon Feb 18 09:43:59 2019 -0500 * lisp/vc/smerge-mode.el (smerge-change-buffer-confirm): New var (smerge-vc-next-conflict): Obey it. Save buffer before going to the next. Don't emit message when vc-find-conflicted-file can't find other conflicted file. * lisp/vc/vc-hooks.el: Use lexical-binding. * lisp/vc/vc.el: Remove redundant :groups. (vc-find-conflicted-file): Autoload. diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el index ffca78ba8a..02cee44a3a 100644 --- a/lisp/vc/smerge-mode.el +++ b/lisp/vc/smerge-mode.el @@ -1432,19 +1432,39 @@ If no conflict maker is found, turn off `smerge-mode'." (smerge-next)) (error (smerge-auto-leave)))) -(require 'vc) +(defcustom smerge-change-buffer-confirm t + "If non-nil, request confirmation before moving to another buffer." + :type 'boolean) (defun smerge-vc-next-conflict () - "Tries to go to next conflict in current file, otherwise tries -to open next conflicted file version-control-system wise" + "Go to next conflict, possibly in another file. +First tries to go to the next conflict in the current buffer, and if not +found, uses VC to try and find the next file with conflict." (interactive) (let ((buffer (current-buffer))) - (when (not (smerge-goto-next-conflict)) - (vc-find-conflicted-file) - (if (eq buffer (current-buffer)) - (message "No conflicts found") - (goto-char 0) - (smerge-goto-next-conflict))))) + (condition-case nil + ;; FIXME: Try again from BOB before moving to the next file. + (smerge-next) + (error + (if (and (or smerge-change-buffer-confirm + (and (buffer-modified-p) buffer-file-name)) + (not (or (eq last-command this-command) + (eq ?\r last-command-event)))) ;Called via M-x!? + ;; FIXME: Don't emit this message if `vc-find-conflicted-file' won't + ;; go to another file anyway (because there are no more conflicted + ;; files). + (message (if (buffer-modified-p) + "No more conflicts here. Repeat to save and go to next buffer" + "No more conflicts here. Repeat to go to next buffer")) + (if (and (buffer-modified-p) buffer-file-name) + (save-buffer)) + (vc-find-conflicted-file) + (if (eq buffer (current-buffer)) + ;; Do nothing: presumably `vc-find-conflicted-file' already + ;; emitted a message explaining there aren't any more conflicts. + nil + (goto-char (point-min)) + (smerge-next))))))) (provide 'smerge-mode) diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index 42622818fc..7dd7346fe8 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -1,4 +1,4 @@ -;;; vc-hooks.el --- resident support for version-control +;;; vc-hooks.el --- resident support for version-control -*- lexical-binding:t -*- ;; Copyright (C) 1992-1996, 1998-2019 Free Software Foundation, Inc. @@ -173,9 +173,9 @@ Otherwise, not displayed." (make-variable-buffer-local 'vc-mode) (put 'vc-mode 'permanent-local t) -;;; We signal this error when we try to do something a VC backend -;;; doesn't support. Two arguments: the method that's not supported -;;; and the backend +;; We signal this error when we try to do something a VC backend +;; doesn't support. Two arguments: the method that's not supported +;; and the backend (define-error 'vc-not-supported "VC method not implemented for backend") (defun vc-mode (&optional _arg) @@ -243,12 +243,12 @@ if that doesn't exist either, return nil." "Call for BACKEND the implementation of FUNCTION-NAME with the given ARGS. Calls - (apply \\='vc-BACKEND-FUN ARGS) + (apply #\\='vc-BACKEND-FUN ARGS) if vc-BACKEND-FUN exists (after trying to find it in vc-BACKEND.el) and else calls - (apply \\='vc-default-FUN BACKEND ARGS) + (apply #\\='vc-default-FUN BACKEND ARGS) It is usually called via the `vc-call' macro." (let ((f (assoc function-name (get backend 'vc-functions)))) @@ -603,7 +603,7 @@ a regexp for matching all such backup files, regardless of the version." "Delete all existing automatic version backups for FILE." (condition-case nil (mapc - 'delete-file + #'delete-file (directory-files (or (file-name-directory file) default-directory) t (vc-version-backup-file-name file nil nil t))) ;; Don't fail when the directory doesn't exist. @@ -811,7 +811,7 @@ In the latter case, VC mode is deactivated for this buffer." (when buffer-file-name (vc-file-clearprops buffer-file-name) ;; FIXME: Why use a hook? Why pass it buffer-file-name? - (add-hook 'vc-mode-line-hook 'vc-mode-line nil t) + (add-hook 'vc-mode-line-hook #'vc-mode-line nil t) (let (backend) (cond ((setq backend (with-demoted-errors (vc-backend buffer-file-name))) @@ -862,13 +862,13 @@ In the latter case, VC mode is deactivated for this buffer." ))))))))) (add-hook 'find-file-hook #'vc-refresh-state) -(define-obsolete-function-alias 'vc-find-file-hook 'vc-refresh-state "25.1") +(define-obsolete-function-alias 'vc-find-file-hook #'vc-refresh-state "25.1") (defun vc-kill-buffer-hook () "Discard VC info about a file when we kill its buffer." (when buffer-file-name (vc-file-clearprops buffer-file-name))) -(add-hook 'kill-buffer-hook 'vc-kill-buffer-hook) +(add-hook 'kill-buffer-hook #'vc-kill-buffer-hook) ;; Now arrange for (autoloaded) bindings of the main package. ;; Bindings for this have to go in the global map, as we'll often diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index a5c866d750..aae21ec45a 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -736,8 +736,7 @@ These are passed to the checkin program by \\[vc-checkin]." (string :tag "Argument String") (repeat :tag "Argument List" :value ("") - string)) - :group 'vc) + string))) (defcustom vc-checkout-switches nil "A string or list of strings specifying extra switches for checkout. @@ -746,8 +745,7 @@ These are passed to the checkout program by \\[vc-checkout]." (string :tag "Argument String") (repeat :tag "Argument List" :value ("") - string)) - :group 'vc) + string))) (defcustom vc-register-switches nil "A string or list of strings; extra switches for registering a file. @@ -756,8 +754,7 @@ These are passed to the checkin program by \\[vc-register]." (string :tag "Argument String") (repeat :tag "Argument List" :value ("") - string)) - :group 'vc) + string))) (defcustom vc-diff-switches nil "A string or list of strings specifying switches for diff under VC. @@ -772,7 +769,6 @@ not specific to any particular backend." (const :tag "None" t) (string :tag "Argument String") (repeat :tag "Argument List" :value ("") string)) - :group 'vc :version "21.1") (defcustom vc-annotate-switches nil @@ -792,15 +788,13 @@ for the backend you use." (const :tag "None" t) (string :tag "Argument String") (repeat :tag "Argument List" :value ("") string)) - :group 'vc :version "25.1") (defcustom vc-log-show-limit 2000 "Limit the number of items shown by the VC log commands. Zero means unlimited. Not all VC backends are able to support this feature." - :type 'integer - :group 'vc) + :type 'integer) (defcustom vc-allow-async-revert nil "Specifies whether the diff during \\[vc-revert] may be asynchronous. @@ -808,7 +802,6 @@ Enabling this option means that you can confirm a revert operation even if the local changes in the file have not been found and displayed yet." :type '(choice (const :tag "No" nil) (const :tag "Yes" t)) - :group 'vc :version "22.1") ;;;###autoload @@ -816,7 +809,6 @@ if the local changes in the file have not been found and displayed yet." "Normal hook (list of functions) run after checking out a file. See `run-hooks'." :type 'hook - :group 'vc :version "21.1") ;;;###autoload @@ -824,26 +816,22 @@ See `run-hooks'." "Normal hook (list of functions) run after commit or file checkin. See also `log-edit-done-hook'." :type 'hook - :options '(log-edit-comment-to-change-log) - :group 'vc) + :options '(log-edit-comment-to-change-log)) ;;;###autoload (defcustom vc-before-checkin-hook nil "Normal hook (list of functions) run before a commit or a file checkin. See `run-hooks'." - :type 'hook - :group 'vc) + :type 'hook) (defcustom vc-retrieve-tag-hook nil "Normal hook (list of functions) run after retrieving a tag." :type 'hook - :group 'vc :version "27.1") (defcustom vc-revert-show-diff t "If non-nil, `vc-revert' shows a `vc-diff' buffer before querying." :type 'boolean - :group 'vc :version "24.1") ;; Header-insertion hair @@ -856,8 +844,7 @@ A %s in the template is replaced with the first string associated with the file's version control type in `vc-BACKEND-header'." :type '(repeat (cons :format "%v" (regexp :tag "File Type") - (string :tag "Header String"))) - :group 'vc) + (string :tag "Header String")))) (defcustom vc-comment-alist '((nroff-mode ".\\\"" "")) @@ -868,13 +855,11 @@ is sensitive to blank lines." :type '(repeat (list :format "%v" (symbol :tag "Mode") (string :tag "Comment Start") - (string :tag "Comment End"))) - :group 'vc) + (string :tag "Comment End")))) (defcustom vc-find-revision-no-save nil "If non-nil, `vc-find-revision' doesn't write the created buffer to file." :type 'boolean - :group 'vc :version "27.1") @@ -940,7 +925,7 @@ use." ;; 'create-repo method. (completing-read (format "%s is not in a version controlled directory.\nUse VC backend: " file) - (mapcar 'symbol-name possible-backends) nil t))) + (mapcar #'symbol-name possible-backends) nil t))) (repo-dir (let ((def-dir (file-name-directory file))) ;; read the directory where to create the @@ -1109,7 +1094,7 @@ BEWARE: this function may change the current buffer." (defun vc-read-backend (prompt) (intern - (completing-read prompt (mapcar 'symbol-name vc-handled-backends) + (completing-read prompt (mapcar #'symbol-name vc-handled-backends) nil 'require-match))) ;; Here's the major entry point. @@ -1367,7 +1352,7 @@ first backend that could register the file is used." (set-buffer-modified-p t)) (vc-buffer-sync))))) (message "Registering %s... " files) - (mapc 'vc-file-clearprops files) + (mapc #'vc-file-clearprops files) (vc-call-backend backend 'register files comment) (mapc (lambda (file) @@ -1569,7 +1554,7 @@ Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'." ;; not a well-defined concept for filesets. (progn (vc-call-backend backend 'checkin files comment rev) - (mapc 'vc-delete-automatic-version-backups files)) + (mapc #'vc-delete-automatic-version-backups files)) `((vc-state . up-to-date) (vc-checkout-time . ,(file-attribute-modification-time (file-attributes file))) @@ -1727,7 +1712,7 @@ Return t if the buffer had changes, nil otherwise." (error "No revisions of %s exist" file) ;; We regard this as "changed". ;; Diff it against /dev/null. - (apply 'vc-do-command buffer + (apply #'vc-do-command buffer (if async 'async 1) "diff" file (append (vc-switches nil 'diff) '("/dev/null")))))) (setq files (nreverse filtered)))) @@ -2172,6 +2157,7 @@ changes from the current branch." ;; `default-next-file' variable for its default file (M-n), and ;; we could then set it upon mark-resolve, so C-x C-s C-x C-f M-n would ;; automatically offer the next conflicted file. +;;;###autoload (defun vc-find-conflicted-file () "Visit the next conflicted file in the current project." (interactive) @@ -2772,7 +2758,8 @@ If called interactively, read FILE, defaulting to the current buffer's file name if it's under version control." (interactive (list (read-file-name "VC delete file: " nil (when (vc-backend buffer-file-name) - buffer-file-name) t))) + buffer-file-name) + t))) (setq file (expand-file-name file)) (let ((buf (get-file-buffer file)) (backend (vc-backend file))) commit 2eecaa28972320a1b8886ac8cde353c2a2f4aa44 Author: Konstantin Kharlamov Date: Mon Feb 18 09:15:08 2019 -0500 * lisp/vc/smerge-mode.el (smerge-vc-next-conflict): New command Copyright-paperwork-exempt: yes diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el index 569797e18d..ffca78ba8a 100644 --- a/lisp/vc/smerge-mode.el +++ b/lisp/vc/smerge-mode.el @@ -1432,6 +1432,20 @@ If no conflict maker is found, turn off `smerge-mode'." (smerge-next)) (error (smerge-auto-leave)))) +(require 'vc) + +(defun smerge-vc-next-conflict () + "Tries to go to next conflict in current file, otherwise tries +to open next conflicted file version-control-system wise" + (interactive) + (let ((buffer (current-buffer))) + (when (not (smerge-goto-next-conflict)) + (vc-find-conflicted-file) + (if (eq buffer (current-buffer)) + (message "No conflicts found") + (goto-char 0) + (smerge-goto-next-conflict))))) + (provide 'smerge-mode) ;;; smerge-mode.el ends here commit b05702d7eb803dbf536e4b589bb80838150559a3 Author: Michael Albinus Date: Mon Feb 18 10:54:45 2019 +0100 Increase timeout on emba for Tramp * test/lisp/net/tramp-tests.el (tramp--test-shell-command-to-string-asynchronously): Increase timeout on emba. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index dccef81b7b..3eb424c62d 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -4113,7 +4113,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." "Like `shell-command-to-string', but for asynchronous processes." (with-temp-buffer (async-shell-command command (current-buffer)) - (with-timeout (10 (tramp--test-timeout-handler)) + (with-timeout + ((if (getenv "EMACS_EMBA_CI") 30 10) (tramp--test-timeout-handler)) (while (accept-process-output (get-buffer-process (current-buffer)) nil nil t))) (buffer-substring-no-properties (point-min) (point-max))))