[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] scratch/replace-region-contents e5c99a1: Merge branch 'mas
|
From: |
Tassilo Horn |
|
Subject: |
[Emacs-diffs] scratch/replace-region-contents e5c99a1: Merge branch 'master' into scratch/replace-region-contents |
|
Date: |
Wed, 20 Feb 2019 10:59:15 -0500 (EST) |
branch: scratch/replace-region-contents
commit e5c99a1757c281953257ac2548fb77702af75c86
Merge: bfa10b7 ae77728
Author: Tassilo Horn <address@hidden>
Commit: Tassilo Horn <address@hidden>
Merge branch 'master' into scratch/replace-region-contents
---
.dir-locals.el | 2 +-
configure.ac | 2 +-
etc/NEWS | 48 ++++++---
lisp/arc-mode.el | 2 +-
lisp/elec-pair.el | 33 +++---
lisp/emacs-lisp/cl-extra.el | 8 +-
lisp/emacs-lisp/cl-lib.el | 7 --
lisp/emacs-lisp/cl-seq.el | 7 ++
lisp/emacs-lisp/easy-mmode.el | 4 +-
lisp/erc/erc.el | 3 -
lisp/json.el | 2 +-
lisp/mh-e/mh-acros.el | 14 ++-
lisp/minibuffer.el | 22 ++--
lisp/net/tramp-adb.el | 7 +-
lisp/net/tramp-archive.el | 6 +-
lisp/net/tramp-gvfs.el | 2 +-
lisp/net/tramp-rclone.el | 2 +-
lisp/net/tramp-sh.el | 5 +-
lisp/net/tramp-smb.el | 5 +-
lisp/net/tramp-sudoedit.el | 2 +-
lisp/net/tramp.el | 11 ++
lisp/progmodes/cc-engine.el | 58 +++++++++--
lisp/progmodes/cc-mode.el | 2 +-
lisp/progmodes/cc-vars.el | 4 +
lisp/progmodes/sql.el | 193 ++++++++++++++++++++++++++++++-----
lisp/tar-mode.el | 23 +----
lisp/time.el | 2 +-
lisp/vc/smerge-mode.el | 34 ++++++
lisp/vc/vc-hooks.el | 20 ++--
lisp/vc/vc.el | 45 +++-----
lisp/window.el | 34 +++---
src/fns.c | 3 +-
src/minibuf.c | 6 +-
src/profiler.c | 49 ++++-----
test/lisp/net/tramp-archive-tests.el | 21 +++-
test/lisp/net/tramp-tests.el | 29 ++++--
test/lisp/progmodes/sql-tests.el | 101 ++++++++++++++++++
37 files changed, 592 insertions(+), 226 deletions(-)
diff --git a/.dir-locals.el b/.dir-locals.el
index 96473a7..9cd3992 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -2,7 +2,7 @@
(sentence-end-double-space . t)
(fill-column . 70)))
(c-mode . ((c-file-style . "GNU")
- (c-noise-macro-names . ("UNINIT" "CALLBACK" "ALIGN_STACK"))
+ (c-noise-macro-names . ("INLINE" "ATTRIBUTE_NO_SANITIZE_UNDEFINED"
"UNINIT" "CALLBACK" "ALIGN_STACK"))
(electric-quote-comment . nil)
(electric-quote-string . nil)))
(objc-mode . ((c-file-style . "GNU")
diff --git a/configure.ac b/configure.ac
index 5857900..c26eb6d 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/etc/NEWS b/etc/NEWS
index 0cafbaa..253da49 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/arc-mode.el b/lisp/arc-mode.el
index 2b5b616..8de0103 100644
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -967,8 +967,8 @@ using `make-temp-file', and the generated name is returned."
;; Don't re-compress this data just before decompressing it.
(jka-compr-inhibit t))
(write-region (point-min) (point-max) tmpfile nil 'quiet))
- (set-buffer-multibyte t)
(erase-buffer)
+ (set-buffer-multibyte t)
(insert-file-contents tmpfile))
(delete-file tmpfile)))))
diff --git a/lisp/elec-pair.el b/lisp/elec-pair.el
index b5ec492..3be09d8 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.
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index 99b55ad..a2400a0 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)
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
index 3756b52..3a9280f 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 '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 31ad811..3eb6ea1 100644
--- a/lisp/emacs-lisp/cl-seq.el
+++ b/lisp/emacs-lisp/cl-seq.el
@@ -113,6 +113,13 @@
(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.
\nKeywords supported: :start :end :from-end :initial-value :key
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index 07a594f..0cb9a6f 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -624,9 +624,7 @@ BODY is executed after moving to the destination location."
(when-narrowed
(lambda (body)
(if (null narrowfun) body
- `(let ((was-narrowed
- (prog1 (or (< (- (point-max) (point-min)) (buffer-size)))
- (widen))))
+ `(let ((was-narrowed (prog1 (buffer-narrowed-p) (widen))))
,body
(when was-narrowed (funcall #',narrowfun)))))))
(unless name (setq name base-name))
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 876e1ff..697e26b 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)
diff --git a/lisp/json.el b/lisp/json.el
index 455444c..cc0a6fd 100644
--- a/lisp/json.el
+++ b/lisp/json.el
@@ -760,7 +760,7 @@ With prefix argument MINIMIZE, minimize it instead."
(defun json-pretty-print-buffer-ordered (&optional minimize)
"Pretty-print current buffer with object keys ordered.
With prefix argument MINIMIZE, minimize it instead."
- (interactive)
+ (interactive "P")
(let ((json-encoding-object-sort-predicate 'string<))
(json-pretty-print-buffer minimize)))
diff --git a/lisp/mh-e/mh-acros.el b/lisp/mh-e/mh-acros.el
index 8935644..3bbf509 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))))
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 7413be4..cc87ffa 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.
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 4fba4e1..1ba8d62 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -88,7 +88,7 @@ It is used for TCP/IP devices."
;;;###tramp-autoload
(defconst tramp-adb-file-name-handler-alist
- '((access-file . ignore)
+ '((access-file . tramp-handle-access-file)
(add-name-to-file . tramp-handle-add-name-to-file)
;; `byte-compiler-base-file-name' performed by default handler.
;; `copy-directory' performed by default handler.
@@ -1314,7 +1314,10 @@ connection if a previous connection has died for some
reason."
(current-time-string)))))
(tramp-message
vec 6 "%s" (mapconcat 'identity (process-command p) " "))
- ;; Wait for initial prompt.
+ ;; Wait for initial prompt. On some devices, it needs an
+ ;; initial RET, in order to get it.
+ (sleep-for 0.1)
+ (tramp-send-string vec tramp-rsh-end-of-line)
(tramp-adb-wait-for-output p 30)
(unless (process-live-p p)
(tramp-error vec 'file-error "Terminated!"))
diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el
index f975ccf..db9aec0 100644
--- a/lisp/net/tramp-archive.el
+++ b/lisp/net/tramp-archive.el
@@ -209,7 +209,7 @@ It must be supported by libarchive(3).")
;; New handlers should be added here.
;;;###tramp-autoload
(defconst tramp-archive-file-name-handler-alist
- '((access-file . ignore)
+ '((access-file . tramp-archive-handle-access-file)
(add-name-to-file . tramp-archive-handle-not-implemented)
;; `byte-compiler-base-file-name' performed by default handler.
;; `copy-directory' performed by default handler.
@@ -531,6 +531,10 @@ offered."
;; File name primitives.
+(defun tramp-archive-handle-access-file (filename string)
+ "Like `access-file' for Tramp files."
+ (access-file (tramp-archive-gvfs-file-name filename) string))
+
(defun tramp-archive-handle-copy-file
(filename newname &optional ok-if-already-exists keep-date
preserve-uid-gid preserve-extended-attributes)
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index bc45acd..ccbb522 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -523,7 +523,7 @@ It has been changed in GVFS 1.14.")
;; New handlers should be added here.
;;;###tramp-autoload
(defconst tramp-gvfs-file-name-handler-alist
- '((access-file . ignore)
+ '((access-file . tramp-handle-access-file)
(add-name-to-file . tramp-handle-add-name-to-file)
;; `byte-compiler-base-file-name' performed by default handler.
;; `copy-directory' performed by default handler.
diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el
index 3a0e002..698296b 100644
--- a/lisp/net/tramp-rclone.el
+++ b/lisp/net/tramp-rclone.el
@@ -66,7 +66,7 @@
;; New handlers should be added here.
;;;###tramp-autoload
(defconst tramp-rclone-file-name-handler-alist
- '((access-file . ignore)
+ '((access-file . tramp-handle-access-file)
(add-name-to-file . tramp-handle-add-name-to-file)
;; `byte-compiler-base-file-name' performed by default handler.
;; `copy-directory' performed by default handler.
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 404fae9..49bc9bf 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -940,7 +940,7 @@ of command line.")
;; New handlers should be added here.
;;;###tramp-autoload
(defconst tramp-sh-file-name-handler-alist
- '(;; `access-file' performed by default handler.
+ '((access-file . tramp-handle-access-file)
(add-name-to-file . tramp-sh-handle-add-name-to-file)
;; `byte-compiler-base-file-name' performed by default handler.
(copy-directory . tramp-sh-handle-copy-directory)
@@ -2574,6 +2574,9 @@ The method used must be an out-of-band method."
"Like `insert-directory' for Tramp files."
(setq filename (expand-file-name filename))
(unless switches (setq switches ""))
+ ;; Check, whether directory is accessible.
+ (unless wildcard
+ (access-file filename "Reading directory"))
(with-parsed-tramp-file-name filename nil
(if (and (featurep 'ls-lisp)
(not (symbol-value 'ls-lisp-use-insert-directory-program)))
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index fb9073b..f57c76c 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -214,7 +214,7 @@ See `tramp-actions-before-shell' for more info.")
;; New handlers should be added here.
;;;###tramp-autoload
(defconst tramp-smb-file-name-handler-alist
- '(;; `access-file' performed by default handler.
+ '((access-file . tramp-handle-access-file)
(add-name-to-file . tramp-smb-handle-add-name-to-file)
;; `byte-compiler-base-file-name' performed by default handler.
(copy-directory . tramp-smb-handle-copy-directory)
@@ -994,6 +994,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
;; Called from `dired-add-entry'.
(setq filename (file-name-as-directory filename))
(setq filename (directory-file-name filename)))
+ ;; Check, whether directory is accessible.
+ (unless wildcard
+ (access-file filename "Reading directory"))
(with-parsed-tramp-file-name filename nil
(with-tramp-progress-reporter v 0 (format "Opening directory %s" filename)
(save-match-data
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index 04b0beb..60eb212 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -63,7 +63,7 @@ See `tramp-actions-before-shell' for more info.")
;;;###tramp-autoload
(defconst tramp-sudoedit-file-name-handler-alist
- '((access-file . ignore)
+ '((access-file . tramp-handle-access-file)
(add-name-to-file . tramp-sudoedit-handle-add-name-to-file)
(byte-compiler-base-file-name . ignore)
;; `copy-directory' performed by default handler.
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index d000bbe..efe7503 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -2310,6 +2310,7 @@ ARGS are the arguments OPERATION has been called with."
(defmacro tramp-condition-case-unless-debug
(var bodyform &rest handlers)
"Like `condition-case-unless-debug' but `tramp-debug-on-error'."
+ (declare (debug condition-case) (indent 2))
`(let ((debug-on-error tramp-debug-on-error))
(condition-case-unless-debug ,var ,bodyform ,@handlers)))
@@ -3060,6 +3061,13 @@ User is always nil."
(defvar tramp-handle-write-region-hook nil
"Normal hook to be run at the end of `tramp-*-handle-write-region'.")
+(defun tramp-handle-access-file (filename string)
+ "Like `access-file' for Tramp files."
+ (unless (file-readable-p filename)
+ (tramp-error
+ (tramp-dissect-file-name filename) tramp-file-missing
+ "%s: No such file or directory %s" string filename)))
+
(defun tramp-handle-add-name-to-file
(filename newname &optional ok-if-already-exists)
"Like `add-name-to-file' for Tramp files."
@@ -3439,6 +3447,9 @@ User is always nil."
(when (and (zerop (length (file-name-nondirectory filename)))
(not full-directory-p))
(setq switches (concat switches "F")))
+ ;; Check, whether directory is accessible.
+ (unless wildcard
+ (access-file filename "Reading directory"))
(with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-progress-reporter v 0 (format "Opening directory %s" filename)
(require 'ls-lisp)
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index 071efbc..27ce302 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -1732,6 +1732,7 @@ comment at the start of cc-engine.el for more info."
(put-text-property beg end 'c-is-sws t)
,@(when (facep 'c-debug-is-sws-face)
'((c-debug-add-face beg end 'c-debug-is-sws-face)))))
+(def-edebug-spec c-put-is-sws t)
(defmacro c-put-in-sws (beg end)
;; This macro does a hidden buffer change.
@@ -1739,6 +1740,7 @@ comment at the start of cc-engine.el for more info."
(put-text-property beg end 'c-in-sws t)
,@(when (facep 'c-debug-is-sws-face)
'((c-debug-add-face beg end 'c-debug-in-sws-face)))))
+(def-edebug-spec c-put-in-sws t)
(defmacro c-remove-is-sws (beg end)
;; This macro does a hidden buffer change.
@@ -1746,6 +1748,7 @@ comment at the start of cc-engine.el for more info."
(remove-text-properties beg end '(c-is-sws nil))
,@(when (facep 'c-debug-is-sws-face)
'((c-debug-remove-face beg end 'c-debug-is-sws-face)))))
+(def-edebug-spec c-remove-is-sws t)
(defmacro c-remove-in-sws (beg end)
;; This macro does a hidden buffer change.
@@ -1753,6 +1756,7 @@ comment at the start of cc-engine.el for more info."
(remove-text-properties beg end '(c-in-sws nil))
,@(when (facep 'c-debug-is-sws-face)
'((c-debug-remove-face beg end 'c-debug-in-sws-face)))))
+(def-edebug-spec c-remove-in-sws t)
(defmacro c-remove-is-and-in-sws (beg end)
;; This macro does a hidden buffer change.
@@ -1761,6 +1765,7 @@ comment at the start of cc-engine.el for more info."
,@(when (facep 'c-debug-is-sws-face)
'((c-debug-remove-face beg end 'c-debug-is-sws-face)
(c-debug-remove-face beg end 'c-debug-in-sws-face)))))
+(def-edebug-spec c-remove-is-and-in-sws t)
;; The type of literal position `end' is in a `before-change-functions'
;; function - one of `c', `c++', `pound', or nil (but NOT `string').
@@ -1769,12 +1774,14 @@ comment at the start of cc-engine.el for more info."
;; enclosing END, if any, else nil.
(defvar c-sws-lit-limits nil)
-(defun c-invalidate-sws-region-before (end)
- ;; Called from c-before-change. END is the end of the change region, the
- ;; standard parameter given to all before-change-functions.
+(defun c-invalidate-sws-region-before (beg end)
+ ;; Called from c-before-change. BEG and END are the bounds of the change
+ ;; region, the standard parameters given to all before-change-functions.
;;
- ;; Note whether END is inside a comment or CPP construct, and if so note its
- ;; bounds in `c-sws-lit-limits' and type in `c-sws-lit-type'.
+ ;; Note whether END is inside a comment, CPP construct, or noise macro, and
+ ;; if so note its bounds in `c-sws-lit-limits' and type in `c-sws-lit-type'.
+ (setq c-sws-lit-type nil
+ c-sws-lit-limits nil)
(save-excursion
(goto-char end)
(let* ((limits (c-literal-limits))
@@ -1787,8 +1794,19 @@ comment at the start of cc-engine.el for more info."
(setq c-sws-lit-type 'pound
c-sws-lit-limits (cons (point)
(progn (c-end-of-macro) (point)))))
- (t (setq c-sws-lit-type nil
- c-sws-lit-limits nil))))))
+ ((progn (skip-syntax-backward "w_")
+ (looking-at c-noise-macro-name-re))
+ (setq c-sws-lit-type 'noise
+ c-sws-lit-limits (cons (match-beginning 1) (match-end 1))))
+ (t))))
+ (save-excursion
+ (goto-char beg)
+ (skip-syntax-backward "w_")
+ (when (looking-at c-noise-macro-name-re)
+ (setq c-sws-lit-type 'noise)
+ (if (consp c-sws-lit-limits)
+ (setcar c-sws-lit-limits (match-beginning 1))
+ (setq c-sws-lit-limits (cons (match-beginning 1) (match-end 1)))))))
(defun c-invalidate-sws-region-after-del (beg end old-len)
;; Text has been deleted, OLD-LEN characters of it starting from position
@@ -1797,7 +1815,6 @@ comment at the start of cc-engine.el for more info."
;; deletion deleted or "damaged" its opening delimiter. If so, return the
;; current position of where the construct ended, otherwise return nil.
(when c-sws-lit-limits
- (setcdr c-sws-lit-limits (- (cdr c-sws-lit-limits) old-len))
(if (and (< beg (+ (car c-sws-lit-limits) 2)) ; A lazy assumption that
; comment delimiters are 2
; chars long.
@@ -1815,9 +1832,9 @@ comment at the start of cc-engine.el for more info."
;; or `c-is-sws' text properties inside this literal. If there are, return
;; the buffer position of the end of the literal, else return nil.
(save-excursion
+ (goto-char end)
(let* ((limits (c-literal-limits))
(lit-type (c-literal-type limits)))
- (goto-char end)
(when (and (not (memq lit-type '(c c++)))
(c-beginning-of-macro))
(setq lit-type 'pound
@@ -1841,6 +1858,10 @@ comment at the start of cc-engine.el for more info."
;; properties right after they're added.
;;
;; This function does hidden buffer changes.
+ (when c-sws-lit-limits
+ (setcar c-sws-lit-limits (min beg (car c-sws-lit-limits)))
+ (setcdr c-sws-lit-limits
+ (max end (- (+ (cdr c-sws-lit-limits) (- end beg)) old-len))))
(let ((del-end
(and (> old-len 0)
(c-invalidate-sws-region-after-del beg end old-len)))
@@ -1860,6 +1881,10 @@ comment at the start of cc-engine.el for more info."
(when (and (eolp) (not (eobp)))
(setq end (1+ (point)))))
+ (when (eq c-sws-lit-type 'noise)
+ (setq beg (car c-sws-lit-limits)
+ end (cdr c-sws-lit-limits))) ; This last setting may be redundant.
+
(when (and (= beg end)
(get-text-property beg 'c-in-sws)
(> beg (point-min))
@@ -1879,6 +1904,7 @@ comment at the start of cc-engine.el for more info."
(setq end (max (or del-end end)
(or ins-end end)
+ (or (cdr c-sws-lit-limits) end)
end))
(c-debug-sws-msg "c-invalidate-sws-region-after [%s..%s]" beg end)
@@ -2147,7 +2173,8 @@ comment at the start of cc-engine.el for more info."
;; Try to find a rung position in the simple ws preceding point, so that
;; we can get a cache hit even if the last bit of the simple ws has
;; changed recently.
- (setq simple-ws-beg (point))
+ (setq simple-ws-beg (or (match-end 1) ; Noise macro
+ (match-end 0))) ; c-syntactic-ws-end
(skip-chars-backward " \t\n\r\f\v")
(if (setq rung-is-marked (text-property-any
(point) (min (1+ rung-pos) (point-max))
@@ -8672,7 +8699,16 @@ comment at the start of cc-engine.el for more info."
(not (and (c-major-mode-is 'c-mode)
(not got-prefix)
(or (eq context 'top) make-top)
- (eq (char-after) ?\)))))
+ (eq (char-after) ?\))
+ (or (memq at-type '(nil maybe))
+ (not got-identifier)
+ (save-excursion
+ (goto-char after-paren-pos)
+ (c-forward-syntactic-ws)
+ ;; Prevent the symbol being recorded as a type.
+ (let (c-record-type-identifiers)
+ (not (memq (c-forward-type)
+ '(nil maybe)))))))))
(if (eq (char-after) ?\))
(when (> paren-depth 0)
(setq paren-depth (1- paren-depth))
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index a2ad07f..6718813 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -1623,7 +1623,7 @@ Note that this is a strict tail, so won't match, e.g.
\"0x....\".")
;; Are we coalescing two tokens together, e.g. "fo o" -> "foo"?
(when (< beg end)
(c-unfind-coalesced-tokens beg end))
- (c-invalidate-sws-region-before end)
+ (c-invalidate-sws-region-before beg end)
;; Are we (potentially) disrupting the syntactic context which
;; makes a type a type? E.g. by inserting stuff after "foo" in
;; "foo bar;", or before "foo" in "typedef foo *bar;"?
diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el
index 66960b6..8953488 100644
--- a/lisp/progmodes/cc-vars.el
+++ b/lisp/progmodes/cc-vars.el
@@ -1649,7 +1649,9 @@ white space either before or after the operator, but not
both."
;; Initialize the next two to a regexp which never matches.
(defvar c-noise-macro-with-parens-name-re "a\\`")
+(make-variable-buffer-local 'c-noise-macro-with-parens-name-re)
(defvar c-noise-macro-name-re "a\\`")
+(make-variable-buffer-local 'c-noise-macro-name-re)
(defcustom c-noise-macro-names nil
"A list of names of macros which expand to nothing, or compiler extensions
@@ -1664,6 +1666,7 @@ this implicitly by reinitializing C/C++/Objc Mode on any
buffer)."
:type '(repeat :tag "List of names" string)
:group 'c)
(put 'c-noise-macro-names 'safe-local-variable #'c-string-list-p)
+(make-variable-buffer-local 'c-noise-macro-names)
(defcustom c-noise-macro-with-parens-names nil
"A list of names of macros \(or compiler extensions like \"__attribute__\")
@@ -1673,6 +1676,7 @@ These are recognized by CC Mode only in declarations."
:type '(repeat :tag "List of names (possibly empty)" string)
:group 'c)
(put 'c-noise-macro-with-parens-names 'safe-local-variable #'c-string-list-p)
+(make-variable-buffer-local 'c-noise-macro-with-parens-names)
(defun c-make-noise-macro-regexps ()
;; Convert `c-noise-macro-names' and `c-noise-macro-with-parens-names' into
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el
index 6ad2212..9bae3d8 100644
--- a/lisp/progmodes/sql.el
+++ b/lisp/progmodes/sql.el
@@ -237,6 +237,7 @@
(require 'custom)
(require 'thingatpt)
(require 'view)
+(eval-when-compile (require 'subr-x)) ; string-empty-p
(defvar font-lock-keyword-face)
(defvar font-lock-set-defaults)
@@ -738,16 +739,131 @@ The package must be available to be loaded and
activated."
:type 'booleanp
:version "27.1")
-(defun sql-is-indent-available ()
- "Check if sql-indent module is available."
- (when (locate-library "sql-indent")
- (fboundp 'sqlind-minor-mode)))
-
(defun sql-indent-enable ()
"Enable `sqlind-minor-mode' if available and requested."
- (when (sql-is-indent-available)
+ (when (fboundp 'sqlind-minor-mode)
(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
@@ -804,7 +920,7 @@ Globally should be set to nil; it will be non-nil in
`sql-mode',
(defvaralias 'sql-pop-to-buffer-after-send-region
'sql-display-sqli-buffer-function)
-(defcustom sql-display-sqli-buffer-function 'display-buffer
+(defcustom sql-display-sqli-buffer-function #'display-buffer
"Function to be called to display a SQLi buffer after `sql-send-*'.
When set to a function, it will be called to display the buffer.
@@ -2929,7 +3045,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
@@ -3199,6 +3315,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 +3330,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 +3347,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))
@@ -3535,8 +3676,8 @@ Allows the suppression of continuation prompts.")
;; Count how many newlines in the string
(setq sql-output-newline-count
- (apply #'+ (mapcar (lambda (ch)
- (if (eq ch ?\n) 1 0)) string)))
+ (apply #'+ (mapcar (lambda (ch) (if (eq ch ?\n) 1 0))
+ string)))
;; Send the string
(comint-simple-send proc string)))
@@ -4086,7 +4227,7 @@ must tell Emacs. Here's how to do that in your init file:
;; Set syntax and font-face highlighting
;; Catch changes to sql-product and highlight accordingly
(sql-set-product (or sql-product 'ansi)) ; Fixes bug#13591
- (add-hook 'hack-local-variables-hook 'sql-highlight-product t t))
+ (add-hook 'hack-local-variables-hook #'sql-highlight-product t t))
@@ -4094,7 +4235,7 @@ must tell Emacs. Here's how to do that in your init file:
(put 'sql-interactive-mode 'mode-class 'special)
(put 'sql-interactive-mode 'custom-mode-group 'SQL)
-
+;; FIXME: Why not use `define-derived-mode'?
(defun sql-interactive-mode ()
"Major mode to use a SQL interpreter interactively.
@@ -4156,13 +4297,15 @@ certain length.
\(add-hook \\='sql-interactive-mode-hook
(function (lambda ()
- (setq comint-output-filter-functions \\='comint-truncate-buffer))))
+ (setq comint-output-filter-functions #\\='comint-truncate-buffer))))
Here is another example. It will always put point back to the statement
you entered, right above the output it created.
\(setq comint-output-filter-functions
(function (lambda (STR) (comint-show-output))))"
+ ;; FIXME: The doc above uses `setq' on `comint-output-filter-functions',
+ ;; whereas hooks should be manipulated with things like `add/remove-hook'.
(delay-mode-hooks (comint-mode))
;; Get the `sql-product' for this interactive session.
@@ -4193,7 +4336,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 +4355,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)
@@ -4219,7 +4363,7 @@ you entered, right above the output it created.
(make-local-variable 'sql-output-newline-count)
(make-local-variable 'sql-preoutput-hold)
(add-hook 'comint-preoutput-filter-functions
- 'sql-interactive-remove-continuation-prompt nil t)
+ #'sql-interactive-remove-continuation-prompt nil t)
(make-local-variable 'sql-input-ring-separator)
(make-local-variable 'sql-input-ring-file-name)
;; Run the mode hook (along with comint's hooks).
@@ -4230,7 +4374,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
@@ -4268,8 +4412,7 @@ Sentinels will always get the two parameters PROCESS and
EVENT."
"Read a connection name."
(let ((completion-ignore-case t))
(completing-read prompt
- (mapcar (lambda (c) (car c))
- sql-connection-alist)
+ (mapcar #'car sql-connection-alist)
nil t initial 'sql-connection-history default)))
;;;###autoload
@@ -4480,6 +4623,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
@@ -4522,7 +4669,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))
@@ -5226,8 +5374,7 @@ The default comes from `process-coding-system-alist' and
your might try undecided-dos as a coding system. If this doesn't help,
Try to set `comint-output-filter-functions' like this:
-\(setq comint-output-filter-functions (append comint-output-filter-functions
- \\='(comint-strip-ctrl-m)))
+\(add-hook 'comint-output-filter-functions #\\='comint-strip-ctrl-m 'append)
\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
(interactive "P")
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el
index c5382d3..599da9a 100644
--- a/lisp/tar-mode.el
+++ b/lisp/tar-mode.el
@@ -95,6 +95,7 @@
;;; Code:
(eval-when-compile (require 'cl-lib))
+(require 'arc-mode)
(defgroup tar nil
"Simple editing of tar files."
@@ -852,26 +853,6 @@ actually appear on disk when you save the tar-file's
buffer."
(goto-char (posn-point (event-end event)))
(tar-extract))
-(defun tar--try-jka-compr ()
- (when (and auto-compression-mode
- (jka-compr-get-compression-info buffer-file-name))
- (let* ((basename (file-name-nondirectory buffer-file-name))
- (tmpname (if (string-match ":\\([^:]+\\)\\'" basename)
- (match-string 1 basename) basename))
- (tmpfile (make-temp-file (file-name-sans-extension tmpname)
- nil
- (file-name-extension tmpname 'period))))
- (unwind-protect
- (progn
- (let ((coding-system-for-write 'no-conversion)
- ;; Don't re-compress this data just before decompressing it.
- (jka-compr-inhibit t))
- (write-region (point-min) (point-max) tmpfile nil 'quiet))
- (set-buffer-multibyte t)
- (erase-buffer)
- (insert-file-contents tmpfile))
- (delete-file tmpfile)))))
-
(defun tar-file-name-handler (op &rest args)
"Helper function for `tar-extract'."
(or (eq op 'file-exists-p)
@@ -951,7 +932,7 @@ actually appear on disk when you save the tar-file's
buffer."
(setq buffer-file-name new-buffer-file-name)
(setq buffer-file-truename
(abbreviate-file-name buffer-file-name))
- (tar--try-jka-compr) ;Pretty ugly hack :-(
+ (archive-try-jka-compr) ;Pretty ugly hack :-(
;; Force buffer-file-coding-system to what
;; decode-coding-region actually used.
(set-buffer-file-coding-system last-coding-system-used t)
diff --git a/lisp/time.el b/lisp/time.el
index d95f708..9084217 100644
--- a/lisp/time.el
+++ b/lisp/time.el
@@ -582,7 +582,7 @@ For example, the Unix uptime command format is \"%D,
%z%2h:%.2m\"."
"Return a string giving the duration of the Emacs initialization."
(interactive)
(let ((str
- (format "%.1f seconds"
+ (format "%s seconds"
(float-time
(time-subtract after-init-time before-init-time)))))
(if (called-interactively-p 'interactive)
diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el
index 569797e..02cee44 100644
--- a/lisp/vc/smerge-mode.el
+++ b/lisp/vc/smerge-mode.el
@@ -1432,6 +1432,40 @@ If no conflict maker is found, turn off `smerge-mode'."
(smerge-next))
(error (smerge-auto-leave))))
+(defcustom smerge-change-buffer-confirm t
+ "If non-nil, request confirmation before moving to another buffer."
+ :type 'boolean)
+
+(defun smerge-vc-next-conflict ()
+ "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)))
+ (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)
;;; smerge-mode.el ends here
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el
index 4262281..7dd7346 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 a5c866d..aae21ec 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)))
diff --git a/lisp/window.el b/lisp/window.el
index 19f8469..80828bb 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -571,23 +571,25 @@ FRAME.
Optional argument MINIBUF t means run FUN on FRAME's minibuffer
window even if it isn't active. MINIBUF nil or omitted means run
-FUN on FRAME's minibuffer window only if it's active. In both
-cases the minibuffer window must be part of FRAME. MINIBUF
+FUN on FRAME's minibuffer window only if it's active. In either
+case the minibuffer window must be part of FRAME. MINIBUF
neither nil nor t means never run FUN on the minibuffer window.
This function performs a pre-order, depth-first traversal of the
window tree. If FUN changes the window tree, the result is
unpredictable."
- (setq frame (window-normalize-frame frame))
- (walk-window-tree-1 fun (frame-root-window frame) any)
- (when (memq minibuf '(nil t))
+ (let ((root (frame-root-window frame))
+ (mini (minibuffer-window frame)))
+ (setq frame (window-normalize-frame frame))
+ (unless (eq root mini)
+ (walk-window-tree-1 fun root any))
;; Run FUN on FRAME's minibuffer window if requested.
- (let ((minibuffer-window (minibuffer-window frame)))
- (when (and (window-live-p minibuffer-window)
- (eq (window-frame minibuffer-window) frame)
- (or (eq minibuf t)
- (minibuffer-window-active-p minibuffer-window)))
- (funcall fun minibuffer-window)))))
+ (when (and (window-live-p mini)
+ (eq (window-frame mini) frame)
+ (or (eq minibuf t)
+ (and (not minibuf)
+ (minibuffer-window-active-p mini))))
+ (funcall fun mini))))
(defun walk-window-subtree (fun &optional window any)
"Run function FUN on the subtree of windows rooted at WINDOW.
@@ -2773,7 +2775,7 @@ shall be resized horizontally."
(unless (= (window-new-pixel window)
(window-size window horizontal t))
(throw 'apply t)))
- frame t)
+ frame t t)
nil))
(defun window-resize (window delta &optional horizontal ignore pixelwise)
@@ -3393,7 +3395,8 @@ may happen when the FRAME is not large enough to
accommodate it."
(when (> delta 0)
(if (window-resizable-p window delta horizontal nil t)
(window-resize window delta horizontal nil t)
- (setq value nil))))))
+ (setq value nil)))))
+ nil nil 'nomini)
value))
(defun adjust-window-trailing-edge (window delta &optional horizontal
pixelwise)
@@ -4171,7 +4174,8 @@ any window whose `no-delete-other-windows' parameter is
non-nil."
(and (not (window-parameter other 'window-side))
(window-parameter
other 'no-delete-other-windows)))
- (throw 'tag nil))))
+ (throw 'tag nil)))
+ nil nil 'nomini)
t)
(setq main (window-main-window frame)))
(t
@@ -6655,7 +6659,7 @@ split."
(unless (or (eq w window)
(window-dedicated-p w))
(throw 'done nil)))
- frame)
+ frame nil 'nomini)
t)))
(not (window-minibuffer-p window))
(let ((split-height-threshold 0))
diff --git a/src/fns.c b/src/fns.c
index 95bafae..d55158e 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -91,8 +91,7 @@ See Info node `(elisp)Random Numbers' for more details. */)
/* Random data-structure functions. */
-/* Return the length of LIST. Signal an error if LIST is not a proper
- list or if the length does not fit into a fixnum or into ptrdiff_t. */
+/* Return LIST's length. Signal an error if LIST is not a proper list. */
ptrdiff_t
list_length (Lisp_Object list)
diff --git a/src/minibuf.c b/src/minibuf.c
index 321fda1..b23e24c 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");
diff --git a/src/profiler.c b/src/profiler.c
index 15a0eef..2aa5f34 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,12 +228,6 @@ 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
-#define timer_getoverrun(x) 0
-#endif
-
static void
handle_profiler_signal (int signal)
{
@@ -252,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);
@@ -274,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,
@@ -287,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);
@@ -308,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;
}
}
@@ -332,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;
@@ -358,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");
@@ -387,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;
@@ -397,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;
@@ -550,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;
@@ -568,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
diff --git a/test/lisp/net/tramp-archive-tests.el
b/test/lisp/net/tramp-archive-tests.el
index 1d9de39..9f06ab1 100644
--- a/test/lisp/net/tramp-archive-tests.el
+++ b/test/lisp/net/tramp-archive-tests.el
@@ -570,26 +570,35 @@ This checks also `file-name-as-directory',
`file-name-directory',
(format
"\\(.+ %s\\( ->.+\\)?\n\\)\\{%d\\}"
(regexp-opt (directory-files tramp-archive-test-archive))
- (length (directory-files tramp-archive-test-archive))))))))
+ (length (directory-files tramp-archive-test-archive)))))))
+
+ ;; Check error case.
+ (with-temp-buffer
+ (should-error
+ (insert-directory
+ (expand-file-name "baz" tramp-archive-test-archive) nil)
+ :type tramp-file-missing)))
;; Cleanup.
(tramp-archive-cleanup-hash))))
(ert-deftest tramp-archive-test18-file-attributes ()
"Check `file-attributes'.
-This tests also `file-readable-p' and `file-regular-p'."
+This tests also `access-file', `file-readable-p' and `file-regular-p'."
:tags '(:expensive-test)
(skip-unless tramp-archive-enabled)
(let ((tmp-name1 (expand-file-name "foo.txt" tramp-archive-test-archive))
(tmp-name2 (expand-file-name "foo.lnk" tramp-archive-test-archive))
(tmp-name3 (expand-file-name "bar" tramp-archive-test-archive))
+ (tmp-name4 (expand-file-name "baz" tramp-archive-test-archive))
attr)
(unwind-protect
(progn
(should (file-exists-p tmp-name1))
(should (file-readable-p tmp-name1))
(should (file-regular-p tmp-name1))
+ (should-not (access-file tmp-name1 "error"))
;; We do not test inodes and device numbers.
(setq attr (file-attributes tmp-name1))
@@ -622,7 +631,13 @@ This tests also `file-readable-p' and `file-regular-p'."
(should (file-readable-p tmp-name3))
(should-not (file-regular-p tmp-name3))
(setq attr (file-attributes tmp-name3))
- (should (eq (car attr) t)))
+ (should (eq (car attr) t))
+ (should-not (access-file tmp-name3 "error"))
+
+ ;; Check error case.
+ (should-error
+ (access-file tmp-name4 "error")
+ :type tramp-file-missing))
;; Cleanup.
(tramp-archive-cleanup-hash))))
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index dccef81..3afe9ad 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -2730,7 +2730,14 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(format
"\\(.+ %s\\( ->.+\\)?\n\\)\\{%d\\}"
(regexp-opt (directory-files tmp-name1))
- (length (directory-files tmp-name1))))))))
+ (length (directory-files tmp-name1)))))))
+
+ ;; Check error case. We do not check for the error type,
+ ;; because ls-lisp returns `file-error', and native Tramp
+ ;; returns `file-missing'.
+ (delete-directory tmp-name1 'recursive)
+ (with-temp-buffer
+ (should-error (insert-directory tmp-name1 nil))))
;; Cleanup.
(ignore-errors (delete-directory tmp-name1 'recursive))))))
@@ -2856,8 +2863,8 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(ert-deftest tramp-test18-file-attributes ()
"Check `file-attributes'.
-This tests also `file-readable-p', `file-regular-p' and
-`file-ownership-preserved-p'."
+This tests also `access-file', `file-readable-p',
+`file-regular-p' and `file-ownership-preserved-p'."
(skip-unless (tramp--test-enabled))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
@@ -2878,6 +2885,9 @@ This tests also `file-readable-p', `file-regular-p' and
attr)
(unwind-protect
(progn
+ (should-error
+ (access-file tmp-name1 "error")
+ :type tramp-file-missing)
;; `file-ownership-preserved-p' should return t for
;; non-existing files. It is implemented only in tramp-sh.el.
(when (tramp--test-sh-p)
@@ -2886,6 +2896,7 @@ This tests also `file-readable-p', `file-regular-p' and
(should (file-exists-p tmp-name1))
(should (file-readable-p tmp-name1))
(should (file-regular-p tmp-name1))
+ (should-not (access-file tmp-name1 "error"))
(when (tramp--test-sh-p)
(should (file-ownership-preserved-p tmp-name1 'group)))
@@ -2910,11 +2921,15 @@ This tests also `file-readable-p', `file-regular-p' and
(should (stringp (nth 3 attr))) ;; Gid.
(tramp--test-ignore-make-symbolic-link-error
+ (should-error
+ (access-file tmp-name2 "error")
+ :type tramp-file-missing)
(when (tramp--test-sh-p)
(should (file-ownership-preserved-p tmp-name2 'group)))
(make-symbolic-link tmp-name1 tmp-name2)
(should (file-exists-p tmp-name2))
(should (file-symlink-p tmp-name2))
+ (should-not (access-file tmp-name2 "error"))
(when (tramp--test-sh-p)
(should (file-ownership-preserved-p tmp-name2 'group)))
(setq attr (file-attributes tmp-name2))
@@ -2953,6 +2968,7 @@ This tests also `file-readable-p', `file-regular-p' and
(should (file-exists-p tmp-name1))
(should (file-readable-p tmp-name1))
(should-not (file-regular-p tmp-name1))
+ (should-not (access-file tmp-name1 ""))
(when (tramp--test-sh-p)
(should (file-ownership-preserved-p tmp-name1 'group)))
(setq attr (file-attributes tmp-name1))
@@ -4113,7 +4129,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))))
@@ -5589,8 +5606,8 @@ Since it unloads Tramp, it shall be the last test to run."
;; * Fix `tramp-test06-directory-file-name' for `ftp'.
;; * Investigate, why `tramp-test11-copy-file' and `tramp-test12-rename-file'
;; do not work properly for `nextcloud'.
-;; * Fix `tramp-test29-start-file-process' on MS Windows (`process-send-eof'?).
-;; * Fix `tramp-test31-interrupt-process', timeout doesn't work reliably.
+;; * Fix `tramp-test29-start-file-process' and
+;; `tramp-test30-make-process' on MS Windows (`process-send-eof'?).
;; * Fix Bug#16928 in `tramp-test43-asynchronous-requests'.
(provide 'tramp-tests)
diff --git a/test/lisp/progmodes/sql-tests.el b/test/lisp/progmodes/sql-tests.el
index 604c021..a68f931 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