aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp')
-rw-r--r--lisp/emacs-lisp/autoload.el88
-rw-r--r--lisp/emacs-lisp/pcase.el1
-rw-r--r--lisp/emacs-lisp/radix-tree.el188
-rw-r--r--lisp/gnus/message.el32
-rw-r--r--lisp/gnus/mml.el61
-rw-r--r--lisp/mail/rmail.el23
-rw-r--r--lisp/net/tramp-adb.el32
-rw-r--r--lisp/net/tramp-gvfs.el455
-rw-r--r--lisp/net/tramp-sh.el263
-rw-r--r--lisp/net/tramp-smb.el37
-rw-r--r--lisp/net/tramp.el37
-rw-r--r--lisp/progmodes/cc-engine.el64
-rw-r--r--lisp/progmodes/cc-langs.el13
-rw-r--r--lisp/progmodes/cc-mode.el103
-rw-r--r--lisp/recentf.el1
-rw-r--r--lisp/simple.el8
-rw-r--r--lisp/wid-edit.el8
17 files changed, 842 insertions, 572 deletions
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index 11316f1d9d6..424b8e31936 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -500,41 +500,26 @@ Return non-nil in the case where no autoloads were added at point."
500 (let ((generated-autoload-file buffer-file-name)) 500 (let ((generated-autoload-file buffer-file-name))
501 (autoload-generate-file-autoloads file (current-buffer)))) 501 (autoload-generate-file-autoloads file (current-buffer))))
502 502
503(defun autoload--split-prefixes-1 (strs)
504 (let ((prefixes ()))
505 (dolist (str strs)
506 (string-match "\\`[^-:/_]*[-:/_]*" str)
507 (let* ((prefix (match-string 0 str))
508 (tail (substring str (match-end 0)))
509 (cell (assoc prefix prefixes)))
510 (cond
511 ((null cell) (push (list prefix tail) prefixes))
512 ((equal (cadr cell) tail) nil)
513 (t (setcdr cell (cons tail (cdr cell)))))))
514 prefixes))
515
516(defvar autoload-compute-prefixes t 503(defvar autoload-compute-prefixes t
517 "If non-nil, autoload will add code to register the prefixes used in a file. 504 "If non-nil, autoload will add code to register the prefixes used in a file.
518Standard prefixes won't be registered anyway. I.e. if a file \"foo.el\" defines 505Standard prefixes won't be registered anyway. I.e. if a file \"foo.el\" defines
519variables or functions that use \"foo-\" as prefix, that will not be registered. 506variables or functions that use \"foo-\" as prefix, that will not be registered.
520But all other prefixes will be included.") 507But all other prefixes will be included.")
521 508
522(defconst autoload-defs-autoload-max-size 5 509(defconst autoload-def-prefixes-max-entries 5
523 "Target length of the list of definition prefixes per file. 510 "Target length of the list of definition prefixes per file.
524If set too small, the prefixes will be too generic (i.e. they'll use little 511If set too small, the prefixes will be too generic (i.e. they'll use little
525memory, we'll end up looking in too many files when we need a particular 512memory, we'll end up looking in too many files when we need a particular
526prefix), and if set too large, they will be too specific (i.e. they will 513prefix), and if set too large, they will be too specific (i.e. they will
527cost more memory use).") 514cost more memory use).")
528 515
529(defvar autoload-popular-prefixes nil) 516(defconst autoload-def-prefixes-max-length 12
517 "Target size of definition prefixes.
518Don't try to split prefixes that are already longer than that.")
519
520(require 'radix-tree)
530 521
531(defun autoload--make-defs-autoload (defs file) 522(defun autoload--make-defs-autoload (defs file)
532 ;; FIXME: avoid redundant entries. E.g. opascal currently has
533 ;; "opascal-" "opascal--literal-start-re" "opascal--syntax-propertize"
534 ;; where only the first one should be kept.
535 ;; FIXME: Avoid keeping too-long-prefixes. E.g. ob-scheme currently has
536 ;; "org-babel-scheme-" "org-babel-default-header-args:scheme"
537 ;; "org-babel-expand-body:scheme" "org-babel-execute:scheme".
538 523
539 ;; Remove the defs that obey the rule that file foo.el (or 524 ;; Remove the defs that obey the rule that file foo.el (or
540 ;; foo-mode.el) uses "foo-" as prefix. 525 ;; foo-mode.el) uses "foo-" as prefix.
@@ -548,39 +533,32 @@ cost more memory use).")
548 533
549 ;; Then compute a small set of prefixes that cover all the 534 ;; Then compute a small set of prefixes that cover all the
550 ;; remaining definitions. 535 ;; remaining definitions.
551 (let ((prefixes (autoload--split-prefixes-1 defs)) 536 (let* ((tree (let ((tree radix-tree-empty))
552 (again t)) 537 (dolist (def defs)
553 ;; (message "Initial prefixes %s : %S" file (mapcar #'car prefixes)) 538 (setq tree (radix-tree-insert tree def t)))
554 (while again 539 tree))
555 (setq again nil) 540 (prefixes (list (cons "" tree))))
556 (let ((newprefixes 541 (while
557 (sort 542 (let ((newprefixes nil)
558 (mapcar (lambda (cell) 543 (changes nil))
559 (cons cell 544 (dolist (pair prefixes)
560 (autoload--split-prefixes-1 (cdr cell)))) 545 (let ((prefix (car pair)))
561 prefixes) 546 (if (or (> (length prefix) autoload-def-prefixes-max-length)
562 (lambda (x y) (< (length (cdr x)) (length (cdr y))))))) 547 (radix-tree-lookup (cdr pair) ""))
563 (setq prefixes nil) 548 ;; No point splitting it any further.
564 (while newprefixes 549 (push pair newprefixes)
565 (let ((x (pop newprefixes))) 550 (setq changes t)
566 (if (or (equal '("") (cdar x)) 551 (radix-tree-iter-subtrees
567 (and (cddr x) 552 (cdr pair) (lambda (sprefix subtree)
568 (not (member (caar x) 553 (push (cons (concat prefix sprefix) subtree)
569 autoload-popular-prefixes)) 554 newprefixes))))))
570 (> (+ (length prefixes) (length newprefixes) 555 (and changes
571 (length (cdr x))) 556 (or (and (null (cdr prefixes)) (equal "" (caar prefixes)))
572 autoload-defs-autoload-max-size))) 557 (<= (length newprefixes)
573 ;; Nothing to split or would split too deep. 558 autoload-def-prefixes-max-entries))
574 (push (car x) prefixes) 559 (setq prefixes newprefixes)
575 ;; (message "Expand %S to %S" (caar x) (cdr x)) 560 (< (length prefixes) autoload-def-prefixes-max-entries))))
576 (setq again t) 561
577 (setq prefixes
578 (nconc (mapcar (lambda (cell)
579 (cons (concat (caar x)
580 (car cell))
581 (cdr cell)))
582 (cdr x))
583 prefixes)))))))
584 ;; (message "Final prefixes %s : %S" file (mapcar #'car prefixes)) 562 ;; (message "Final prefixes %s : %S" file (mapcar #'car prefixes))
585 (when prefixes 563 (when prefixes
586 `(if (fboundp 'register-definition-prefixes) 564 `(if (fboundp 'register-definition-prefixes)
@@ -989,7 +967,7 @@ write its autoloads into the specified file instead."
989 t files-re)) 967 t files-re))
990 dirs))) 968 dirs)))
991 (done ()) ;Files processed; to remove duplicates. 969 (done ()) ;Files processed; to remove duplicates.
992 (changed nil) ;Non-nil if some change occured. 970 (changed nil) ;Non-nil if some change occurred.
993 (last-time) 971 (last-time)
994 ;; Files with no autoload cookies or whose autoloads go to other 972 ;; Files with no autoload cookies or whose autoloads go to other
995 ;; files because of file-local autoload-generated-file settings. 973 ;; files because of file-local autoload-generated-file settings.
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 7e164c0fe5c..0b8dddfacc9 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -509,6 +509,7 @@ MATCH is the pattern that needs to be matched, of the form:
509 (numberp . stringp) 509 (numberp . stringp)
510 (numberp . byte-code-function-p) 510 (numberp . byte-code-function-p)
511 (consp . arrayp) 511 (consp . arrayp)
512 (consp . atom)
512 (consp . vectorp) 513 (consp . vectorp)
513 (consp . stringp) 514 (consp . stringp)
514 (consp . byte-code-function-p) 515 (consp . byte-code-function-p)
diff --git a/lisp/emacs-lisp/radix-tree.el b/lisp/emacs-lisp/radix-tree.el
new file mode 100644
index 00000000000..d4b5cd211e4
--- /dev/null
+++ b/lisp/emacs-lisp/radix-tree.el
@@ -0,0 +1,188 @@
1;;; radix-tree.el --- A simple library of radix trees -*- lexical-binding: t; -*-
2
3;; Copyright (C) 2016 Free Software Foundation, Inc.
4
5;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
6;; Keywords:
7
8;; This file is part of GNU Emacs.
9
10;; GNU Emacs is free software: you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
12;; the Free Software Foundation, either version 3 of the License, or
13;; (at your option) any later version.
14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
21;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
22
23;;; Commentary:
24
25;; There are many different options for how to represent radix trees
26;; in Elisp. Here I chose a very simple one. A radix-tree can be either:
27;; - a node, of the form ((PREFIX . PTREE) . RTREE) where PREFIX is a string
28;; meaning that everything that starts with PREFIX is in PTREE,
29;; and everything else in RTREE. It also has the property that
30;; everything that starts with the first letter of PREFIX but not with
31;; that whole PREFIX is not in RTREE (i.e. is not in the tree at all).
32;; - anything else is taken as the value to associate with the empty string.
33;; So every node is basically an (improper) alist where each mapping applies
34;; to a different leading letter.
35;;
36;; The main downside of this representation is that the lookup operation
37;; is slower because each level of the tree is an alist rather than some kind
38;; of array, so every level's lookup is O(N) rather than O(1). We could easily
39;; solve this by using char-tables instead of alists, but that would make every
40;; level take up a lot more memory, and it would make the resulting
41;; data structure harder to read (by a human) when printed out.
42
43;;; Code:
44
45(defun radix-tree--insert (tree key val i)
46 (pcase tree
47 (`((,prefix . ,ptree) . ,rtree)
48 (let* ((ni (+ i (length prefix)))
49 (cmp (compare-strings prefix nil nil key i ni)))
50 (if (eq t cmp)
51 (let ((nptree (radix-tree--insert ptree key val ni)))
52 `((,prefix . ,nptree) . ,rtree))
53 (let ((n (if (< cmp 0) (- -1 cmp) (- cmp 1))))
54 (if (zerop n)
55 (let ((nrtree (radix-tree--insert rtree key val i)))
56 `((,prefix . ,ptree) . ,nrtree))
57 (let* ((nprefix (substring prefix 0 n))
58 (kprefix (substring key (+ i n)))
59 (pprefix (substring prefix n))
60 (ktree (if (equal kprefix "") val
61 `((,kprefix . ,val)))))
62 `((,nprefix
63 . ((,pprefix . ,ptree) . ,ktree))
64 . ,rtree)))))))
65 (_
66 (if (= (length key) i) val
67 (let ((prefix (substring key i)))
68 `((,prefix . ,val) . ,tree))))))
69
70(defun radix-tree--remove (tree key i)
71 (pcase tree
72 (`((,prefix . ,ptree) . ,rtree)
73 (let* ((ni (+ i (length prefix)))
74 (cmp (compare-strings prefix nil nil key i ni)))
75 (if (eq t cmp)
76 (pcase (radix-tree--remove ptree key ni)
77 (`nil rtree)
78 (`((,pprefix . ,pptree))
79 `((,(concat prefix pprefix) . ,pptree) . ,rtree))
80 (nptree `((,prefix . ,nptree) . ,rtree)))
81 (let ((n (if (< cmp 0) (- -1 cmp) (- cmp 1))))
82 (if (zerop n)
83 (let ((nrtree (radix-tree--remove rtree key i)))
84 `((,prefix . ,ptree) . ,nrtree))
85 tree)))))
86 (_
87 (if (= (length key) i) nil tree))))
88
89
90(defun radix-tree--lookup (tree string i)
91 (pcase tree
92 (`((,prefix . ,ptree) . ,rtree)
93 (let* ((ni (+ i (length prefix)))
94 (cmp (compare-strings prefix nil nil string i ni)))
95 (if (eq t cmp)
96 (radix-tree--lookup ptree string ni)
97 (let ((n (if (< cmp 0) (- -1 cmp) (- cmp 1))))
98 (if (zerop n)
99 (radix-tree--lookup rtree string i)
100 (+ i n))))))
101 (val
102 (if (and val (equal (length string) i))
103 (if (integerp val) `(t . ,val) val)
104 i))))
105
106(defun radix-tree--subtree (tree string i)
107 (if (equal (length string) i) tree
108 (pcase tree
109 (`((,prefix . ,ptree) . ,rtree)
110 (let* ((ni (+ i (length prefix)))
111 (cmp (compare-strings prefix nil nil string i ni)))
112 (if (eq t cmp)
113 (radix-tree--subtree ptree string ni)
114 (let ((n (if (< cmp 0) (- -1 cmp) (- cmp 1))))
115 (cond
116 ((zerop n) (radix-tree--subtree rtree string i))
117 ((equal (+ n i) (length string))
118 (let ((nprefix (substring prefix n)))
119 `((,nprefix . ,ptree))))
120 (t nil))))))
121 (_ nil))))
122
123;;; Entry points
124
125(defconst radix-tree-empty nil
126 "The empty radix-tree.")
127
128(defun radix-tree-insert (tree key val)
129 "Insert a mapping from KEY to VAL in radix TREE."
130 (when (consp val) (setq val `(t . ,val)))
131 (if val (radix-tree--insert tree key val 0)
132 (radix-tree--remove tree key 0)))
133
134(defun radix-tree-lookup (tree key)
135 "Return the value associated to KEY in radix TREE.
136If not found, return nil."
137 (pcase (radix-tree--lookup tree key 0)
138 (`(t . ,val) val)
139 ((pred numberp) nil)
140 (val val)))
141
142(defun radix-tree-subtree (tree string)
143 "Return the subtree of TREE rooted at the prefix STRING."
144 (radix-tree--subtree tree string 0))
145
146(eval-and-compile
147 (pcase-defmacro radix-tree-leaf (vpat)
148 ;; FIXME: We'd like to use a negative pattern (not consp), but pcase
149 ;; doesn't support it. Using `atom' works but generates sub-optimal code.
150 `(or `(t . ,,vpat) (and (pred atom) ,vpat))))
151
152(defun radix-tree-iter-subtrees (tree fun)
153 "Apply FUN to every immediate subtree of radix TREE.
154FUN is called with two arguments: PREFIX and SUBTREE.
155You can test if SUBTREE is a leaf (and extract its value) with the
156pcase pattern (radix-tree-leaf PAT)."
157 (while tree
158 (pcase tree
159 (`((,prefix . ,ptree) . ,rtree)
160 (funcall fun prefix ptree)
161 (setq tree rtree))
162 (_ (funcall fun "" tree)
163 (setq tree nil)))))
164
165(defun radix-tree-iter-mappings (tree fun &optional prefix)
166 "Apply FUN to every mapping in TREE.
167FUN is called with two arguments: KEY and VAL.
168PREFIX is only used internally."
169 (radix-tree-iter-subtrees
170 tree
171 (lambda (p s)
172 (let ((nprefix (concat prefix p)))
173 (pcase s
174 ((radix-tree-leaf v) (funcall fun nprefix v))
175 (_ (radix-tree-iter-mappings s fun nprefix)))))))
176
177;; (defun radix-tree->alist (tree)
178;; (let ((al nil))
179;; (radix-tree-iter-mappings tree (lambda (p v) (push (cons p v) al)))
180;; al))
181
182(defun radix-tree-count (tree)
183 (let ((i 0))
184 (radix-tree-iter-mappings tree (lambda (_ _) (setq i (1+ i))))
185 i))
186
187(provide 'radix-tree)
188;;; radix-tree.el ends here
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 1ca7c5cafef..03ce789e9eb 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -4545,7 +4545,7 @@ This function could be useful in `message-setup-hook'."
4545 (setq message-options options) 4545 (setq message-options options)
4546 ;; Avoid copying text props (except hard newlines). 4546 ;; Avoid copying text props (except hard newlines).
4547 (insert (with-current-buffer mailbuf 4547 (insert (with-current-buffer mailbuf
4548 (mml-buffer-substring-no-properties-except-hard-newlines 4548 (mml-buffer-substring-no-properties-except-some
4549 (point-min) (point-max)))) 4549 (point-min) (point-max))))
4550 ;; Remove some headers. 4550 ;; Remove some headers.
4551 (message-encode-message-body) 4551 (message-encode-message-body)
@@ -4909,7 +4909,7 @@ Otherwise, generate and save a value for `canlock-password' first."
4909 ;; Avoid copying text props (except hard newlines). 4909 ;; Avoid copying text props (except hard newlines).
4910 (insert 4910 (insert
4911 (with-current-buffer messbuf 4911 (with-current-buffer messbuf
4912 (mml-buffer-substring-no-properties-except-hard-newlines 4912 (mml-buffer-substring-no-properties-except-some
4913 (point-min) (point-max)))) 4913 (point-min) (point-max))))
4914 (message-encode-message-body) 4914 (message-encode-message-body)
4915 ;; Remove some headers. 4915 ;; Remove some headers.
@@ -8386,30 +8386,32 @@ Used in `message-simplify-recipients'."
8386(defun message-toggle-image-thumbnails () 8386(defun message-toggle-image-thumbnails ()
8387 "For any included image files, insert a thumbnail of that image." 8387 "For any included image files, insert a thumbnail of that image."
8388 (interactive) 8388 (interactive)
8389 (let ((overlays (overlays-in (point-min) (point-max))) 8389 (let ((displayed nil))
8390 (displayed nil)) 8390 (save-excursion
8391 (while overlays 8391 (goto-char (point-min))
8392 (let ((overlay (car overlays))) 8392 (while (not (eobp))
8393 (when (overlay-get overlay 'put-image) 8393 (when-let ((props (get-text-property (point) 'display)))
8394 (delete-overlay overlay) 8394 (when (and (consp props)
8395 (setq displayed t))) 8395 (eq (car props) 'image))
8396 (setq overlays (cdr overlays))) 8396 (put-text-property (point) (1+ (point)) 'display nil)
8397 (setq displayed t)))))
8397 (unless displayed 8398 (unless displayed
8398 (save-excursion 8399 (save-excursion
8399 (goto-char (point-min)) 8400 (goto-char (point-min))
8400 (while (re-search-forward "<img.*src=\"\\([^\"]+\\)" nil t) 8401 (while (re-search-forward "<img.*src=\"\\([^\"]+\\).*>" nil t)
8401 (let ((file (match-string 1)) 8402 (let ((string (match-string 0))
8403 (file (match-string 1))
8402 (edges (window-inside-pixel-edges 8404 (edges (window-inside-pixel-edges
8403 (get-buffer-window (current-buffer))))) 8405 (get-buffer-window (current-buffer)))))
8404 (put-image 8406 (delete-region (match-beginning 0) (match-end 0))
8407 (insert-image
8405 (create-image 8408 (create-image
8406 file 'imagemagick nil 8409 file 'imagemagick nil
8407 :max-width (truncate 8410 :max-width (truncate
8408 (* 0.7 (- (nth 2 edges) (nth 0 edges)))) 8411 (* 0.7 (- (nth 2 edges) (nth 0 edges))))
8409 :max-height (truncate 8412 :max-height (truncate
8410 (* 0.5 (- (nth 3 edges) (nth 1 edges))))) 8413 (* 0.5 (- (nth 3 edges) (nth 1 edges)))))
8411 (match-beginning 0) 8414 string)))))))
8412 " ")))))))
8413 8415
8414(provide 'message) 8416(provide 'message)
8415 8417
diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el
index 97cc87d06e3..eae4c61be82 100644
--- a/lisp/gnus/mml.el
+++ b/lisp/gnus/mml.el
@@ -413,12 +413,21 @@ A message part needs to be split into %d charset parts. Really send? "
413 (setq contents (append (list (cons 'tag-location orig-point)) contents)) 413 (setq contents (append (list (cons 'tag-location orig-point)) contents))
414 (cons (intern name) (nreverse contents)))) 414 (cons (intern name) (nreverse contents))))
415 415
416(defun mml-buffer-substring-no-properties-except-hard-newlines (start end) 416(defun mml-buffer-substring-no-properties-except-some (start end)
417 (let ((str (buffer-substring-no-properties start end)) 417 (let ((str (buffer-substring-no-properties start end))
418 (bufstart start) tmp) 418 (bufstart start)
419 (while (setq tmp (text-property-any start end 'hard 't)) 419 tmp)
420 (set-text-properties (- tmp bufstart) (- tmp bufstart -1) 420 ;; Copy over all hard newlines.
421 '(hard t) str) 421 (while (setq tmp (text-property-any start end 'hard t))
422 (put-text-property (- tmp bufstart) (- tmp bufstart -1)
423 'hard t str)
424 (setq start (1+ tmp)))
425 ;; Copy over all `display' properties (which are usually images).
426 (setq start bufstart)
427 (while (setq tmp (text-property-not-all start end 'display nil))
428 (put-text-property (- tmp bufstart) (- tmp bufstart -1)
429 'display (get-text-property tmp 'display)
430 str)
422 (setq start (1+ tmp))) 431 (setq start (1+ tmp)))
423 str)) 432 str))
424 433
@@ -435,21 +444,21 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
435 (if (re-search-forward "<#\\(/\\)?mml." nil t) 444 (if (re-search-forward "<#\\(/\\)?mml." nil t)
436 (setq count (+ count (if (match-beginning 1) -1 1))) 445 (setq count (+ count (if (match-beginning 1) -1 1)))
437 (goto-char (point-max)))) 446 (goto-char (point-max))))
438 (mml-buffer-substring-no-properties-except-hard-newlines 447 (mml-buffer-substring-no-properties-except-some
439 beg (if (> count 0) 448 beg (if (> count 0)
440 (point) 449 (point)
441 (match-beginning 0)))) 450 (match-beginning 0))))
442 (if (re-search-forward 451 (if (re-search-forward
443 "<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)." nil t) 452 "<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)." nil t)
444 (prog1 453 (prog1
445 (mml-buffer-substring-no-properties-except-hard-newlines 454 (mml-buffer-substring-no-properties-except-some
446 beg (match-beginning 0)) 455 beg (match-beginning 0))
447 (if (or (not (match-beginning 1)) 456 (if (or (not (match-beginning 1))
448 (equal (match-string 2) "multipart")) 457 (equal (match-string 2) "multipart"))
449 (goto-char (match-beginning 0)) 458 (goto-char (match-beginning 0))
450 (when (looking-at "[ \t]*\n") 459 (when (looking-at "[ \t]*\n")
451 (forward-line 1)))) 460 (forward-line 1))))
452 (mml-buffer-substring-no-properties-except-hard-newlines 461 (mml-buffer-substring-no-properties-except-some
453 beg (goto-char (point-max))))))) 462 beg (goto-char (point-max)))))))
454 463
455(defvar mml-boundary nil) 464(defvar mml-boundary nil)
@@ -514,7 +523,9 @@ be \"related\" or \"alternate\"."
514 (when (search-forward (url-filename parsed) end t) 523 (when (search-forward (url-filename parsed) end t)
515 (let ((cid (format "fsf.%d" cid))) 524 (let ((cid (format "fsf.%d" cid)))
516 (replace-match (concat "cid:" cid) t t) 525 (replace-match (concat "cid:" cid) t t)
517 (push (list cid (url-filename parsed)) new-parts)) 526 (push (list cid (url-filename parsed)
527 (get-text-property start 'display))
528 new-parts))
518 (setq cid (1+ cid))))))) 529 (setq cid (1+ cid)))))))
519 ;; We have local images that we want to include. 530 ;; We have local images that we want to include.
520 (if (not new-parts) 531 (if (not new-parts)
@@ -527,11 +538,41 @@ be \"related\" or \"alternate\"."
527 (setq cont 538 (setq cont
528 (nconc cont 539 (nconc cont
529 (list `(part (type . "image/png") 540 (list `(part (type . "image/png")
530 (filename . ,(nth 1 new-part)) 541 ,@(mml--possibly-alter-image
542 (nth 1 new-part)
543 (nth 2 new-part))
531 (id . ,(concat "<" (nth 0 new-part) 544 (id . ,(concat "<" (nth 0 new-part)
532 ">"))))))) 545 ">")))))))
533 cont)))) 546 cont))))
534 547
548(defun mml--possibly-alter-image (file-name image)
549 (if (or (null image)
550 (not (consp image))
551 (not (eq (car image) 'image))
552 (not (image-property image :rotation))
553 (not (executable-find "exiftool")))
554 `((filename . ,file-name))
555 `((filename . ,file-name)
556 (buffer
557 .
558 ,(with-current-buffer (mml-generate-new-buffer " *mml rotation*")
559 (set-buffer-multibyte nil)
560 (call-process "exiftool"
561 file-name
562 (list (current-buffer) nil)
563 nil
564 (format "-Orientation#=%d"
565 (cl-case (truncate
566 (image-property image :rotation))
567 (0 0)
568 (90 6)
569 (180 3)
570 (270 8)
571 (otherwise 0)))
572 "-o" "-"
573 "-")
574 (current-buffer))))))
575
535(defun mml-generate-mime-1 (cont) 576(defun mml-generate-mime-1 (cont)
536 (let ((mm-use-ultra-safe-encoding 577 (let ((mm-use-ultra-safe-encoding
537 (or mm-use-ultra-safe-encoding (assq 'sign cont)))) 578 (or mm-use-ultra-safe-encoding (assq 'sign cont))))
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index 734155e217d..e9882253c70 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -1818,9 +1818,21 @@ not be a new one). It returns non-nil if it got any new messages."
1818 ;; Read in the contents of the inbox files, renaming them as 1818 ;; Read in the contents of the inbox files, renaming them as
1819 ;; necessary, and adding to the list of files to delete 1819 ;; necessary, and adding to the list of files to delete
1820 ;; eventually. 1820 ;; eventually.
1821 (if file-name 1821 (unwind-protect
1822 (rmail-insert-inbox-text files nil) 1822 (progn
1823 (setq delete-files (rmail-insert-inbox-text files t))) 1823 ;; Set modified now to lock the file, so that we don't
1824 ;; encounter locking problems later in the middle of
1825 ;; reading the mail.
1826 (set-buffer-modified-p t)
1827 (if file-name
1828 (rmail-insert-inbox-text files nil)
1829 (setq delete-files (rmail-insert-inbox-text files t))))
1830 ;; If there was no new mail, or we aborted before actually
1831 ;; trying to get any, mark buffer unmodified. Otherwise the
1832 ;; buffer is correctly marked modified and the file locked
1833 ;; until we save out the new mail.
1834 (if (= (point-min) (point-max))
1835 (set-buffer-modified-p nil)))
1824 ;; Scan the new text and convert each message to 1836 ;; Scan the new text and convert each message to
1825 ;; Rmail/mbox format. 1837 ;; Rmail/mbox format.
1826 (goto-char (point-min)) 1838 (goto-char (point-min))
@@ -1969,11 +1981,6 @@ Value is the size of the newly read mail after conversion."
1969 size)) 1981 size))
1970 1982
1971(defun rmail-insert-inbox-text (files renamep) 1983(defun rmail-insert-inbox-text (files renamep)
1972 ;; Detect a locked file now, so that we avoid moving mail
1973 ;; out of the real inbox file. (That could scare people.)
1974 (or (memq (file-locked-p buffer-file-name) '(nil t))
1975 (error "RMAIL file %s is locked"
1976 (file-name-nondirectory buffer-file-name)))
1977 (let (file tofile delete-files popmail got-password password) 1984 (let (file tofile delete-files popmail got-password password)
1978 (while files 1985 (while files
1979 ;; Handle remote mailbox names specially; don't expand as filenames 1986 ;; Handle remote mailbox names specially; don't expand as filenames
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 5940b713958..1281dbbd72d 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -535,7 +535,7 @@ Emacs dired can't find files."
535 "Like `file-name-all-completions' for Tramp files." 535 "Like `file-name-all-completions' for Tramp files."
536 (all-completions 536 (all-completions
537 filename 537 filename
538 (with-parsed-tramp-file-name directory nil 538 (with-parsed-tramp-file-name (expand-file-name directory) nil
539 (with-tramp-file-property v localname "file-name-all-completions" 539 (with-tramp-file-property v localname "file-name-all-completions"
540 (save-match-data 540 (save-match-data
541 (tramp-adb-send-command 541 (tramp-adb-send-command
@@ -934,20 +934,22 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
934 (unless (stringp program) 934 (unless (stringp program)
935 (tramp-error v 'file-error "PROGRAM must be a string")) 935 (tramp-error v 'file-error "PROGRAM must be a string"))
936 936
937 (let ((command 937 (let* ((buffer
938 (format "cd %s; %s" 938 (if buffer
939 (tramp-shell-quote-argument localname) 939 (get-buffer-create buffer)
940 (mapconcat 'tramp-shell-quote-argument 940 ;; BUFFER can be nil. We use a temporary buffer.
941 (cons program args) " "))) 941 (generate-new-buffer tramp-temp-buffer-name)))
942 (tramp-process-connection-type 942 (command
943 (or (null program) tramp-process-connection-type)) 943 (format "cd %s; %s"
944 (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer))) 944 (tramp-shell-quote-argument localname)
945 (name1 name) 945 (mapconcat 'tramp-shell-quote-argument
946 (i 0)) 946 (cons program args) " ")))
947 947 (tramp-process-connection-type
948 (unless buffer 948 (or (null program) tramp-process-connection-type))
949 ;; BUFFER can be nil. We use a temporary buffer. 949 (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
950 (setq buffer (generate-new-buffer tramp-temp-buffer-name))) 950 (name1 name)
951 (i 0))
952
951 (while (get-process name1) 953 (while (get-process name1)
952 ;; NAME must be unique as process name. 954 ;; NAME must be unique as process name.
953 (setq i (1+ i) 955 (setq i (1+ i)
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 098d40e7cc0..ac390e5d5a6 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -407,6 +407,42 @@ Every entry is a list (NAME ADDRESS).")
407(defconst tramp-hal-interface-device "org.freedesktop.Hal.Device" 407(defconst tramp-hal-interface-device "org.freedesktop.Hal.Device"
408 "The device interface of the HAL daemon.") 408 "The device interface of the HAL daemon.")
409 409
410(defconst tramp-gvfs-file-attributes
411 '("type"
412 "standard::display-name"
413 ;; We don't need this one. It is used as delimiter in case the
414 ;; display name contains spaces, which is hard to parse.
415 "standard::icon"
416 "standard::symlink-target"
417 "unix::nlink"
418 "unix::uid"
419 "owner::user"
420 "unix::gid"
421 "owner::group"
422 "time::access"
423 "time::modified"
424 "time::changed"
425 "standard::size"
426 "unix::mode"
427 "access::can-read"
428 "access::can-write"
429 "access::can-execute"
430 "unix::inode"
431 "unix::device")
432 "GVFS file attributes.")
433
434(defconst tramp-gvfs-file-attributes-with-gvfs-ls-regexp
435 (concat "[[:blank:]]"
436 (regexp-opt tramp-gvfs-file-attributes t)
437 "=\\([^[:blank:]]+\\)")
438 "Regexp to parse GVFS file attributes with `gvfs-ls'.")
439
440(defconst tramp-gvfs-file-attributes-with-gvfs-info-regexp
441 (concat "^[[:blank:]]*"
442 (regexp-opt tramp-gvfs-file-attributes t)
443 ":[[:blank:]]+\\(.*\\)$")
444 "Regexp to parse GVFS file attributes with `gvfs-info'.")
445
410 446
411;; New handlers should be added here. 447;; New handlers should be added here.
412(defconst tramp-gvfs-file-name-handler-alist 448(defconst tramp-gvfs-file-name-handler-alist
@@ -784,127 +820,185 @@ file names."
784 (tramp-run-real-handler 820 (tramp-run-real-handler
785 'expand-file-name (list localname)))))) 821 'expand-file-name (list localname))))))
786 822
787(defun tramp-gvfs-handle-file-attributes (filename &optional id-format) 823(defun tramp-gvfs-get-directory-attributes (directory)
788 "Like `file-attributes' for Tramp files." 824 "Return GVFS attributes association list of all files in DIRECTORY."
789 (unless id-format (setq id-format 'integer))
790 (ignore-errors 825 (ignore-errors
791 ;; Don't modify `last-coding-system-used' by accident. 826 ;; Don't modify `last-coding-system-used' by accident.
792 (let ((last-coding-system-used last-coding-system-used) 827 (let ((last-coding-system-used last-coding-system-used)
793 (process-environment (cons "LC_MESSAGES=C" process-environment)) 828 result)
794 dirp res-symlink-target res-numlinks res-uid res-gid res-access 829 (with-parsed-tramp-file-name directory nil
795 res-mod res-change res-size res-filemodes res-inode res-device) 830 (with-tramp-file-property v localname "directory-gvfs-attributes"
831 (tramp-message v 5 "directory gvfs attributes: %s" localname)
832 ;; Send command.
833 (tramp-gvfs-send-command
834 v "gvfs-ls" "-h" "-n" "-a"
835 (mapconcat 'identity tramp-gvfs-file-attributes ",")
836 (tramp-gvfs-url-file-name directory))
837 ;; Parse output ...
838 (with-current-buffer (tramp-get-connection-buffer v)
839 (goto-char (point-min))
840 (while (re-search-forward
841 (concat "^\\(.+\\)[[:blank:]]"
842 "\\([[:digit:]]+\\)[[:blank:]]"
843 "(\\(.+\\))[[:blank:]]"
844 "standard::display-name=\\(.+\\)[[:blank:]]"
845 "standard::icon=")
846 (point-at-eol) t)
847 (let ((item (list (cons "standard::display-name" (match-string 4))
848 (cons "type" (match-string 3))
849 (cons "standard::size" (match-string 2))
850 (match-string 1))))
851 (while (re-search-forward
852 tramp-gvfs-file-attributes-with-gvfs-ls-regexp
853 (point-at-eol) t)
854 (push (cons (match-string 1) (match-string 2)) item))
855 (push (nreverse item) result))
856 (forward-line)))
857 result)))))
858
859(defun tramp-gvfs-get-root-attributes (filename)
860 "Return GVFS attributes association list of FILENAME."
861 (ignore-errors
862 ;; Don't modify `last-coding-system-used' by accident.
863 (let ((last-coding-system-used last-coding-system-used)
864 result)
796 (with-parsed-tramp-file-name filename nil 865 (with-parsed-tramp-file-name filename nil
797 (with-tramp-file-property 866 (with-tramp-file-property v localname "file-gvfs-attributes"
798 v localname (format "file-attributes-%s" id-format) 867 (tramp-message v 5 "file gvfs attributes: %s" localname)
799 (tramp-message v 5 "file attributes: %s" localname) 868 ;; Send command.
800 (tramp-gvfs-send-command 869 (tramp-gvfs-send-command
801 v "gvfs-info" (tramp-gvfs-url-file-name filename)) 870 v "gvfs-info" (tramp-gvfs-url-file-name filename))
802 ;; Parse output ... 871 ;; Parse output ...
803 (with-current-buffer (tramp-get-connection-buffer v) 872 (with-current-buffer (tramp-get-connection-buffer v)
804 (goto-char (point-min)) 873 (goto-char (point-min))
805 (when (re-search-forward "attributes:" nil t) 874 (while (re-search-forward
806 ;; ... directory or symlink 875 tramp-gvfs-file-attributes-with-gvfs-info-regexp nil t)
807 (goto-char (point-min)) 876 (push (cons (match-string 1) (match-string 2)) result))
808 (setq dirp (if (re-search-forward "type: directory" nil t) t)) 877 result))))))
809 (goto-char (point-min)) 878
810 (setq res-symlink-target 879(defun tramp-gvfs-get-file-attributes (filename)
811 (if (re-search-forward 880 "Return GVFS attributes association list of FILENAME."
812 "standard::symlink-target: \\(.+\\)$" nil t) 881 (setq filename (directory-file-name (expand-file-name filename)))
813 (match-string 1))) 882 (with-parsed-tramp-file-name filename nil
814 ;; ... number links 883 (if (or
815 (goto-char (point-min)) 884 (and (string-match "^\\(afp\\|smb\\)$" method)
816 (setq res-numlinks 885 (string-match "^/?\\([^/]+\\)$" localname))
817 (if (re-search-forward "unix::nlink: \\([0-9]+\\)" nil t) 886 (string-equal localname "/"))
818 (string-to-number (match-string 1)) 0)) 887 (tramp-gvfs-get-root-attributes filename)
819 ;; ... uid and gid 888 (assoc
820 (goto-char (point-min)) 889 (file-name-nondirectory filename)
821 (setq res-uid 890 (tramp-gvfs-get-directory-attributes (file-name-directory filename))))))
822 (if (eq id-format 'integer) 891
823 (if (re-search-forward "unix::uid: \\([0-9]+\\)" nil t) 892(defun tramp-gvfs-handle-file-attributes (filename &optional id-format)
824 (string-to-number (match-string 1)) 893 "Like `file-attributes' for Tramp files."
825 -1) 894 (unless id-format (setq id-format 'integer))
826 (if (re-search-forward "owner::user: \\(.+\\)$" nil t) 895 (ignore-errors
827 (match-string 1) 896 (let ((attributes (tramp-gvfs-get-file-attributes filename))
828 "UNKNOWN"))) 897 dirp res-symlink-target res-numlinks res-uid res-gid res-access
829 (setq res-gid 898 res-mod res-change res-size res-filemodes res-inode res-device)
830 (if (eq id-format 'integer) 899 (when attributes
831 (if (re-search-forward "unix::gid: \\([0-9]+\\)" nil t) 900 ;; ... directory or symlink
832 (string-to-number (match-string 1)) 901 (setq dirp (if (equal "directory" (cdr (assoc "type" attributes))) t))
833 -1) 902 (setq res-symlink-target
834 (if (re-search-forward "owner::group: \\(.+\\)$" nil t) 903 (cdr (assoc "standard::symlink-target" attributes)))
835 (match-string 1) 904 ;; ... number links
836 "UNKNOWN"))) 905 (setq res-numlinks
837 ;; ... last access, modification and change time 906 (string-to-number
838 (goto-char (point-min)) 907 (or (cdr (assoc "unix::nlink" attributes)) "0")))
839 (setq res-access 908 ;; ... uid and gid
840 (if (re-search-forward "time::access: \\([0-9]+\\)" nil t) 909 (setq res-uid
841 (seconds-to-time (string-to-number (match-string 1))) 910 (if (eq id-format 'integer)
842 '(0 0))) 911 (string-to-number
843 (goto-char (point-min)) 912 (or (cdr (assoc "unix::uid" attributes))
844 (setq res-mod 913 (format "%s" tramp-unknown-id-integer)))
845 (if (re-search-forward "time::modified: \\([0-9]+\\)" nil t) 914 (or (cdr (assoc "owner::user" attributes))
846 (seconds-to-time (string-to-number (match-string 1))) 915 (cdr (assoc "unix::uid" attributes))
847 '(0 0))) 916 tramp-unknown-id-string)))
848 (goto-char (point-min)) 917 (setq res-gid
849 (setq res-change 918 (if (eq id-format 'integer)
850 (if (re-search-forward "time::changed: \\([0-9]+\\)" nil t) 919 (string-to-number
851 (seconds-to-time (string-to-number (match-string 1))) 920 (or (cdr (assoc "unix::gid" attributes))
852 '(0 0))) 921 (format "%s" tramp-unknown-id-integer)))
853 ;; ... size 922 (or (cdr (assoc "owner::group" attributes))
854 (goto-char (point-min)) 923 (cdr (assoc "unix::gid" attributes))
855 (setq res-size 924 tramp-unknown-id-string)))
856 (if (re-search-forward "standard::size: \\([0-9]+\\)" nil t) 925 ;; ... last access, modification and change time
857 (string-to-number (match-string 1)) 0)) 926 (setq res-access
858 ;; ... file mode flags 927 (seconds-to-time
859 (goto-char (point-min)) 928 (string-to-number
860 (setq res-filemodes 929 (or (cdr (assoc "time::access" attributes)) "0"))))
861 (if (re-search-forward "unix::mode: \\([0-9]+\\)" nil t) 930 (setq res-mod
862 (tramp-file-mode-from-int 931 (seconds-to-time
863 (string-to-number (match-string 1))) 932 (string-to-number
864 (if dirp "drwx------" "-rwx------"))) 933 (or (cdr (assoc "time::modified" attributes)) "0"))))
865 ;; ... inode and device 934 (setq res-change
866 (goto-char (point-min)) 935 (seconds-to-time
867 (setq res-inode 936 (string-to-number
868 (if (re-search-forward "unix::inode: \\([0-9]+\\)" nil t) 937 (or (cdr (assoc "time::changed" attributes)) "0"))))
869 (string-to-number (match-string 1)) 938 ;; ... size
870 (tramp-get-inode v))) 939 (setq res-size
871 (goto-char (point-min)) 940 (string-to-number
872 (setq res-device 941 (or (cdr (assoc "standard::size" attributes)) "0")))
873 (if (re-search-forward "unix::device: \\([0-9]+\\)" nil t) 942 ;; ... file mode flags
874 (string-to-number (match-string 1)) 943 (setq res-filemodes
875 (tramp-get-device v))) 944 (let ((n (cdr (assoc "unix::mode" attributes))))
876 945 (if n
877 ;; Return data gathered. 946 (tramp-file-mode-from-int (string-to-number n))
878 (list 947 (format
879 ;; 0. t for directory, string (name linked to) for 948 "%s%s%s%s------"
880 ;; symbolic link, or nil. 949 (if dirp "d" "-")
881 (or dirp res-symlink-target) 950 (if (equal (cdr (assoc "access::can-read" attributes))
882 ;; 1. Number of links to file. 951 "FALSE")
883 res-numlinks 952 "-" "r")
884 ;; 2. File uid. 953 (if (equal (cdr (assoc "access::can-write" attributes))
885 res-uid 954 "FALSE")
886 ;; 3. File gid. 955 "-" "w")
887 res-gid 956 (if (equal (cdr (assoc "access::can-execute" attributes))
888 ;; 4. Last access time, as a list of integers. 957 "FALSE")
889 ;; 5. Last modification time, likewise. 958 "-" "x")))))
890 ;; 6. Last status change time, likewise. 959 ;; ... inode and device
891 res-access res-mod res-change 960 (setq res-inode
892 ;; 7. Size in bytes (-1, if number is out of range). 961 (let ((n (cdr (assoc "unix::inode" attributes))))
893 res-size 962 (if n
894 ;; 8. File modes. 963 (string-to-number n)
895 res-filemodes 964 (tramp-get-inode (tramp-dissect-file-name filename)))))
896 ;; 9. t if file's gid would change if file were deleted 965 (setq res-device
897 ;; and recreated. 966 (let ((n (cdr (assoc "unix::device" attributes))))
898 nil 967 (if n
899 ;; 10. Inode number. 968 (string-to-number n)
900 res-inode 969 (tramp-get-device (tramp-dissect-file-name filename)))))
901 ;; 11. Device number. 970
902 res-device 971 ;; Return data gathered.
903 )))))))) 972 (list
973 ;; 0. t for directory, string (name linked to) for
974 ;; symbolic link, or nil.
975 (or dirp res-symlink-target)
976 ;; 1. Number of links to file.
977 res-numlinks
978 ;; 2. File uid.
979 res-uid
980 ;; 3. File gid.
981 res-gid
982 ;; 4. Last access time, as a list of integers.
983 ;; 5. Last modification time, likewise.
984 ;; 6. Last status change time, likewise.
985 res-access res-mod res-change
986 ;; 7. Size in bytes (-1, if number is out of range).
987 res-size
988 ;; 8. File modes.
989 res-filemodes
990 ;; 9. t if file's gid would change if file were deleted
991 ;; and recreated.
992 nil
993 ;; 10. Inode number.
994 res-inode
995 ;; 11. Device number.
996 res-device
997 )))))
904 998
905(defun tramp-gvfs-handle-file-directory-p (filename) 999(defun tramp-gvfs-handle-file-directory-p (filename)
906 "Like `file-directory-p' for Tramp files." 1000 "Like `file-directory-p' for Tramp files."
907 (eq t (car (file-attributes filename)))) 1001 (eq t (car (file-attributes (file-truename filename)))))
908 1002
909(defun tramp-gvfs-handle-file-executable-p (filename) 1003(defun tramp-gvfs-handle-file-executable-p (filename)
910 "Like `file-executable-p' for Tramp files." 1004 "Like `file-executable-p' for Tramp files."
@@ -926,73 +1020,21 @@ file names."
926(defun tramp-gvfs-handle-file-name-all-completions (filename directory) 1020(defun tramp-gvfs-handle-file-name-all-completions (filename directory)
927 "Like `file-name-all-completions' for Tramp files." 1021 "Like `file-name-all-completions' for Tramp files."
928 (unless (save-match-data (string-match "/" filename)) 1022 (unless (save-match-data (string-match "/" filename))
929 (with-parsed-tramp-file-name (expand-file-name directory) nil 1023 (all-completions
930 1024 filename
931 (all-completions 1025 (with-parsed-tramp-file-name (expand-file-name directory) nil
932 filename 1026 (with-tramp-file-property v localname "file-name-all-completions"
933 (mapcar 1027 (let ((result '("./" "../"))
934 'list
935 (or
936 ;; Try cache entries for filename, filename with last
937 ;; character removed, filename with last two characters
938 ;; removed, ..., and finally the empty string - all
939 ;; concatenated to the local directory name.
940 (let ((remote-file-name-inhibit-cache
941 (or remote-file-name-inhibit-cache
942 tramp-completion-reread-directory-timeout)))
943
944 ;; This is inefficient for very long filenames, pity
945 ;; `reduce' is not available...
946 (car
947 (apply
948 'append
949 (mapcar
950 (lambda (x)
951 (let ((cache-hit
952 (tramp-get-file-property
953 v
954 (concat localname (substring filename 0 x))
955 "file-name-all-completions"
956 nil)))
957 (when cache-hit (list cache-hit))))
958 ;; We cannot use a length of 0, because file properties
959 ;; for "foo" and "foo/" are identical.
960 (number-sequence (length filename) 1 -1)))))
961
962 ;; Cache expired or no matching cache entry found so we need
963 ;; to perform a remote operation.
964 (let ((result '("." ".."))
965 entry) 1028 entry)
966 ;; Get a list of directories and files. 1029 ;; Get a list of directories and files.
967 (tramp-gvfs-send-command 1030 (dolist (item (tramp-gvfs-get-directory-attributes directory) result)
968 v "gvfs-ls" "-h" (tramp-gvfs-url-file-name directory)) 1031 (setq entry
969 1032 (or ;; Use display-name if available (google-drive).
970 ;; Now grab the output. 1033 ;(cdr (assoc "standard::display-name" item))
971 (with-temp-buffer 1034 (car item)))
972 (insert-buffer-substring (tramp-get-connection-buffer v)) 1035 (if (string-equal (cdr (assoc "type" item)) "directory")
973 (goto-char (point-max)) 1036 (push (file-name-as-directory entry) result)
974 (while (zerop (forward-line -1)) 1037 (push entry result)))))))))
975 (setq entry (buffer-substring (point) (point-at-eol)))
976 (when (string-match filename entry)
977 (if (file-directory-p (expand-file-name entry directory))
978 (push (concat entry "/") result)
979 (push entry result)))))
980
981 ;; Because the remote op went through OK we know the
982 ;; directory we `cd'-ed to exists.
983 (tramp-set-file-property v localname "file-exists-p" t)
984
985 ;; Because the remote op went through OK we know every
986 ;; file listed by `ls' exists.
987 (mapc (lambda (entry)
988 (tramp-set-file-property
989 v (concat localname entry) "file-exists-p" t))
990 result)
991
992 ;; Store result in the cache.
993 (tramp-set-file-property
994 v (concat localname filename)
995 "file-name-all-completions" result))))))))
996 1038
997(defun tramp-gvfs-handle-file-notify-add-watch (file-name flags _callback) 1039(defun tramp-gvfs-handle-file-notify-add-watch (file-name flags _callback)
998 "Like `file-notify-add-watch' for Tramp files." 1040 "Like `file-notify-add-watch' for Tramp files."
@@ -1528,7 +1570,7 @@ connection if a previous connection has died for some reason."
1528 (let ((p (make-network-process 1570 (let ((p (make-network-process
1529 :name (tramp-buffer-name vec) 1571 :name (tramp-buffer-name vec)
1530 :buffer (tramp-get-connection-buffer vec) 1572 :buffer (tramp-get-connection-buffer vec)
1531 :server t :host 'local :service t))) 1573 :server t :host 'local :service t :noquery t)))
1532 (set-process-query-on-exit-flag p nil))) 1574 (set-process-query-on-exit-flag p nil)))
1533 1575
1534 (unless (tramp-gvfs-connection-mounted-p vec) 1576 (unless (tramp-gvfs-connection-mounted-p vec)
@@ -1635,10 +1677,17 @@ connection if a previous connection has died for some reason."
1635 "Send the COMMAND with its ARGS to connection VEC. 1677 "Send the COMMAND with its ARGS to connection VEC.
1636COMMAND is usually a command from the gvfs-* utilities. 1678COMMAND is usually a command from the gvfs-* utilities.
1637`call-process' is applied, and it returns t if the return code is zero." 1679`call-process' is applied, and it returns t if the return code is zero."
1638 (with-current-buffer (tramp-get-connection-buffer vec) 1680 (let* ((locale (tramp-get-local-locale vec))
1639 (tramp-gvfs-maybe-open-connection vec) 1681 (process-environment
1640 (erase-buffer) 1682 (append
1641 (zerop (apply 'tramp-call-process vec command nil t nil args)))) 1683 `(,(format "LANG=%s" locale)
1684 ,(format "LANGUAGE=%s" locale)
1685 ,(format "LC_ALL=%s" locale))
1686 process-environment)))
1687 (with-current-buffer (tramp-get-connection-buffer vec)
1688 (tramp-gvfs-maybe-open-connection vec)
1689 (erase-buffer)
1690 (zerop (apply 'tramp-call-process vec command nil t nil args)))))
1642 1691
1643 1692
1644;; D-Bus BLUEZ functions. 1693;; D-Bus BLUEZ functions.
@@ -1772,35 +1821,37 @@ This uses \"avahi-browse\" in case D-Bus is not enabled in Avahi."
1772 1821
1773;; Add completion functions for AFP, DAV, DAVS, SFTP and SMB methods. 1822;; Add completion functions for AFP, DAV, DAVS, SFTP and SMB methods.
1774(when tramp-gvfs-enabled 1823(when tramp-gvfs-enabled
1775 (zeroconf-init tramp-gvfs-zeroconf-domain) 1824 ;; Suppress D-Bus error messages.
1776 (if (zeroconf-list-service-types) 1825 (let (tramp-gvfs-dbus-event-vector)
1777 (progn 1826 (zeroconf-init tramp-gvfs-zeroconf-domain)
1827 (if (zeroconf-list-service-types)
1828 (progn
1829 (tramp-set-completion-function
1830 "afp" '((tramp-zeroconf-parse-device-names "_afpovertcp._tcp")))
1831 (tramp-set-completion-function
1832 "dav" '((tramp-zeroconf-parse-device-names "_webdav._tcp")))
1833 (tramp-set-completion-function
1834 "davs" '((tramp-zeroconf-parse-device-names "_webdav._tcp")))
1835 (tramp-set-completion-function
1836 "sftp" '((tramp-zeroconf-parse-device-names "_ssh._tcp")
1837 (tramp-zeroconf-parse-device-names "_workstation._tcp")))
1838 (when (member "smb" tramp-gvfs-methods)
1839 (tramp-set-completion-function
1840 "smb" '((tramp-zeroconf-parse-device-names "_smb._tcp")))))
1841
1842 (when (executable-find "avahi-browse")
1778 (tramp-set-completion-function 1843 (tramp-set-completion-function
1779 "afp" '((tramp-zeroconf-parse-device-names "_afpovertcp._tcp"))) 1844 "afp" '((tramp-gvfs-parse-device-names "_afpovertcp._tcp")))
1780 (tramp-set-completion-function 1845 (tramp-set-completion-function
1781 "dav" '((tramp-zeroconf-parse-device-names "_webdav._tcp"))) 1846 "dav" '((tramp-gvfs-parse-device-names "_webdav._tcp")))
1782 (tramp-set-completion-function 1847 (tramp-set-completion-function
1783 "davs" '((tramp-zeroconf-parse-device-names "_webdav._tcp"))) 1848 "davs" '((tramp-gvfs-parse-device-names "_webdav._tcp")))
1784 (tramp-set-completion-function 1849 (tramp-set-completion-function
1785 "sftp" '((tramp-zeroconf-parse-device-names "_ssh._tcp") 1850 "sftp" '((tramp-gvfs-parse-device-names "_ssh._tcp")
1786 (tramp-zeroconf-parse-device-names "_workstation._tcp"))) 1851 (tramp-gvfs-parse-device-names "_workstation._tcp")))
1787 (when (member "smb" tramp-gvfs-methods) 1852 (when (member "smb" tramp-gvfs-methods)
1788 (tramp-set-completion-function 1853 (tramp-set-completion-function
1789 "smb" '((tramp-zeroconf-parse-device-names "_smb._tcp"))))) 1854 "smb" '((tramp-gvfs-parse-device-names "_smb._tcp"))))))))
1790
1791 (when (executable-find "avahi-browse")
1792 (tramp-set-completion-function
1793 "afp" '((tramp-gvfs-parse-device-names "_afpovertcp._tcp")))
1794 (tramp-set-completion-function
1795 "dav" '((tramp-gvfs-parse-device-names "_webdav._tcp")))
1796 (tramp-set-completion-function
1797 "davs" '((tramp-gvfs-parse-device-names "_webdav._tcp")))
1798 (tramp-set-completion-function
1799 "sftp" '((tramp-gvfs-parse-device-names "_ssh._tcp")
1800 (tramp-gvfs-parse-device-names "_workstation._tcp")))
1801 (when (member "smb" tramp-gvfs-methods)
1802 (tramp-set-completion-function
1803 "smb" '((tramp-gvfs-parse-device-names "_smb._tcp")))))))
1804 1855
1805 1856
1806;; D-Bus SYNCE functions. 1857;; D-Bus SYNCE functions.
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 14c6f949853..e9f78b7d1ce 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -84,8 +84,12 @@ e.g. \"$HOME/.sh_history\"."
84 (string :tag "Redirect to a file"))) 84 (string :tag "Redirect to a file")))
85 85
86;;;###tramp-autoload 86;;;###tramp-autoload
87(defconst tramp-color-escape-sequence-regexp "\e[[;0-9]+m" 87(defconst tramp-display-escape-sequence-regexp "\e[[;0-9]+m"
88 "Escape sequences produced by the \"ls\" command.") 88 "Terminal control escape sequences for display attributes.")
89
90;;;###tramp-autoload
91(defconst tramp-device-escape-sequence-regexp "\e[[0-9]+n"
92 "Terminal control escape sequences for device status.")
89 93
90;; ksh on OpenBSD 4.5 requires that $PS1 contains a `#' character for 94;; ksh on OpenBSD 4.5 requires that $PS1 contains a `#' character for
91;; root users. It uses the `$' character for other users. In order 95;; root users. It uses the `$' character for other users. In order
@@ -658,29 +662,19 @@ Escape sequence %s is replaced with name of Perl binary.
658This string is passed to `format', so percent characters need to be doubled.") 662This string is passed to `format', so percent characters need to be doubled.")
659 663
660(defconst tramp-perl-file-name-all-completions 664(defconst tramp-perl-file-name-all-completions
661 "%s -e 'sub case { 665 "%s -e '
662 my $str = shift;
663 if ($ARGV[2]) {
664 return lc($str);
665 }
666 else {
667 return $str;
668 }
669}
670opendir(d, $ARGV[0]) || die(\"$ARGV[0]: $!\\nfail\\n\"); 666opendir(d, $ARGV[0]) || die(\"$ARGV[0]: $!\\nfail\\n\");
671@files = readdir(d); closedir(d); 667@files = readdir(d); closedir(d);
672foreach $f (@files) { 668foreach $f (@files) {
673 if (case(substr($f, 0, length($ARGV[1]))) eq case($ARGV[1])) { 669 if (-d \"$ARGV[0]/$f\") {
674 if (-d \"$ARGV[0]/$f\") { 670 print \"$f/\\n\";
675 print \"$f/\\n\"; 671 }
676 } 672 else {
677 else { 673 print \"$f\\n\";
678 print \"$f\\n\";
679 }
680 } 674 }
681} 675}
682print \"ok\\n\" 676print \"ok\\n\"
683' \"$1\" \"$2\" \"$3\" 2>/dev/null" 677' \"$1\" 2>/dev/null"
684 "Perl script to produce output suitable for use with 678 "Perl script to produce output suitable for use with
685`file-name-all-completions' on the remote file system. Escape 679`file-name-all-completions' on the remote file system. Escape
686sequence %s is replaced with name of Perl binary. This string is 680sequence %s is replaced with name of Perl binary. This string is
@@ -1339,8 +1333,10 @@ target of the symlink differ."
1339 (setq res-gid (read (current-buffer))) 1333 (setq res-gid (read (current-buffer)))
1340 (if (eq id-format 'integer) 1334 (if (eq id-format 'integer)
1341 (progn 1335 (progn
1342 (unless (numberp res-uid) (setq res-uid -1)) 1336 (unless (numberp res-uid)
1343 (unless (numberp res-gid) (setq res-gid -1))) 1337 (setq res-uid tramp-unknown-id-integer))
1338 (unless (numberp res-gid)
1339 (setq res-gid tramp-unknown-id-integer)))
1344 (progn 1340 (progn
1345 (unless (stringp res-uid) (setq res-uid (symbol-name res-uid))) 1341 (unless (stringp res-uid) (setq res-uid (symbol-name res-uid)))
1346 (unless (stringp res-gid) (setq res-gid (symbol-name res-gid))))) 1342 (unless (stringp res-gid) (setq res-gid (symbol-name res-gid)))))
@@ -1862,135 +1858,63 @@ be non-negative integers."
1862(defun tramp-sh-handle-file-name-all-completions (filename directory) 1858(defun tramp-sh-handle-file-name-all-completions (filename directory)
1863 "Like `file-name-all-completions' for Tramp files." 1859 "Like `file-name-all-completions' for Tramp files."
1864 (unless (save-match-data (string-match "/" filename)) 1860 (unless (save-match-data (string-match "/" filename))
1865 (with-parsed-tramp-file-name (expand-file-name directory) nil 1861 (all-completions
1862 filename
1863 (with-parsed-tramp-file-name (expand-file-name directory) nil
1864 (with-tramp-file-property v localname "file-name-all-completions"
1865 (let (result)
1866 ;; Get a list of directories and files, including reliably
1867 ;; tagging the directories with a trailing "/". Because I
1868 ;; rock. --daniel@danann.net
1869 (tramp-send-command
1870 v
1871 (if (tramp-get-remote-perl v)
1872 (progn
1873 (tramp-maybe-send-script
1874 v tramp-perl-file-name-all-completions
1875 "tramp_perl_file_name_all_completions")
1876 (format "tramp_perl_file_name_all_completions %s"
1877 (tramp-shell-quote-argument localname)))
1878
1879 (format (concat
1880 "(cd %s 2>&1 && %s -a 2>/dev/null"
1881 " | while IFS= read f; do"
1882 " if %s -d \"$f\" 2>/dev/null;"
1883 " then \\echo \"$f/\"; else \\echo \"$f\"; fi; done"
1884 " && \\echo ok) || \\echo fail")
1885 (tramp-shell-quote-argument localname)
1886 (tramp-get-ls-command v)
1887 (tramp-get-test-command v))))
1866 1888
1867 (all-completions 1889 ;; Now grab the output.
1868 filename 1890 (with-current-buffer (tramp-get-buffer v)
1869 (mapcar 1891 (goto-char (point-max))
1870 'list 1892
1871 (or 1893 ;; Check result code, found in last line of output.
1872 ;; Try cache entries for `filename', `filename' with last 1894 (forward-line -1)
1873 ;; character removed, `filename' with last two characters 1895 (if (looking-at "^fail$")
1874 ;; removed, ..., and finally the empty string - all 1896 (progn
1875 ;; concatenated to the local directory name. 1897 ;; Grab error message from line before last line
1876 (let ((remote-file-name-inhibit-cache 1898 ;; (it was put there by `cd 2>&1').
1877 (or remote-file-name-inhibit-cache 1899 (forward-line -1)
1878 tramp-completion-reread-directory-timeout))) 1900 (tramp-error
1879 1901 v 'file-error
1880 ;; This is inefficient for very long file names, pity 1902 "tramp-sh-handle-file-name-all-completions: %s"
1881 ;; `reduce' is not available... 1903 (buffer-substring (point) (point-at-eol))))
1882 (car 1904 ;; For peace of mind, if buffer doesn't end in `fail'
1883 (apply 1905 ;; then it should end in `ok'. If neither are in the
1884 'append 1906 ;; buffer something went seriously wrong on the remote
1885 (mapcar 1907 ;; side.
1886 (lambda (x) 1908 (unless (looking-at "^ok$")
1887 (let ((cache-hit 1909 (tramp-error
1888 (tramp-get-file-property 1910 v 'file-error
1889 v 1911 "\
1890 (concat localname (substring filename 0 x))
1891 "file-name-all-completions"
1892 nil)))
1893 (when cache-hit (list cache-hit))))
1894 ;; We cannot use a length of 0, because file properties
1895 ;; for "foo" and "foo/" are identical.
1896 (number-sequence (length filename) 1 -1)))))
1897
1898 ;; Cache expired or no matching cache entry found so we need
1899 ;; to perform a remote operation.
1900 (let (result)
1901 ;; Get a list of directories and files, including reliably
1902 ;; tagging the directories with a trailing '/'. Because I
1903 ;; rock. --daniel@danann.net
1904
1905 ;; Changed to perform `cd' in the same remote op and only
1906 ;; get entries starting with `filename'. Capture any `cd'
1907 ;; error messages. Ensure any `cd' and `echo' aliases are
1908 ;; ignored.
1909 (tramp-send-command
1910 v
1911 (if (tramp-get-remote-perl v)
1912 (progn
1913 (tramp-maybe-send-script
1914 v tramp-perl-file-name-all-completions
1915 "tramp_perl_file_name_all_completions")
1916 (format "tramp_perl_file_name_all_completions %s %s %d"
1917 (tramp-shell-quote-argument localname)
1918 (tramp-shell-quote-argument filename)
1919 (if read-file-name-completion-ignore-case 1 0)))
1920
1921 (format (concat
1922 "(cd %s 2>&1 && (%s -a %s 2>/dev/null"
1923 ;; `ls' with wildcard might fail with `Argument
1924 ;; list too long' error in some corner cases; if
1925 ;; `ls' fails after `cd' succeeded, chances are
1926 ;; that's the case, so let's retry without
1927 ;; wildcard. This will return "too many" entries
1928 ;; but that isn't harmful.
1929 " || %s -a 2>/dev/null)"
1930 " | while IFS= read f; do"
1931 " if %s -d \"$f\" 2>/dev/null;"
1932 " then \\echo \"$f/\"; else \\echo \"$f\"; fi; done"
1933 " && \\echo ok) || \\echo fail")
1934 (tramp-shell-quote-argument localname)
1935 (tramp-get-ls-command v)
1936 ;; When `filename' is empty, just `ls' without
1937 ;; `filename' argument is more efficient than `ls *'
1938 ;; for very large directories and might avoid the
1939 ;; `Argument list too long' error.
1940 ;;
1941 ;; With and only with wildcard, we need to add
1942 ;; `-d' to prevent `ls' from descending into
1943 ;; sub-directories.
1944 (if (zerop (length filename))
1945 "."
1946 (format "-d %s*" (tramp-shell-quote-argument filename)))
1947 (tramp-get-ls-command v)
1948 (tramp-get-test-command v))))
1949
1950 ;; Now grab the output.
1951 (with-current-buffer (tramp-get-buffer v)
1952 (goto-char (point-max))
1953
1954 ;; Check result code, found in last line of output.
1955 (forward-line -1)
1956 (if (looking-at "^fail$")
1957 (progn
1958 ;; Grab error message from line before last line
1959 ;; (it was put there by `cd 2>&1').
1960 (forward-line -1)
1961 (tramp-error
1962 v 'file-error
1963 "tramp-sh-handle-file-name-all-completions: %s"
1964 (buffer-substring (point) (point-at-eol))))
1965 ;; For peace of mind, if buffer doesn't end in `fail'
1966 ;; then it should end in `ok'. If neither are in the
1967 ;; buffer something went seriously wrong on the remote
1968 ;; side.
1969 (unless (looking-at "^ok$")
1970 (tramp-error
1971 v 'file-error
1972 "\
1973tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'" 1912tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'"
1974 (tramp-shell-quote-argument localname) (buffer-string)))) 1913 (tramp-shell-quote-argument localname) (buffer-string))))
1975
1976 (while (zerop (forward-line -1))
1977 (push (buffer-substring (point) (point-at-eol)) result)))
1978
1979 ;; Because the remote op went through OK we know the
1980 ;; directory we `cd'-ed to exists.
1981 (tramp-set-file-property v localname "file-exists-p" t)
1982
1983 ;; Because the remote op went through OK we know every
1984 ;; file listed by `ls' exists.
1985 (mapc (lambda (entry)
1986 (tramp-set-file-property
1987 v (concat localname entry) "file-exists-p" t))
1988 result)
1989 1914
1990 ;; Store result in the cache. 1915 (while (zerop (forward-line -1))
1991 (tramp-set-file-property 1916 (push (buffer-substring (point) (point-at-eol)) result)))
1992 v (concat localname filename) 1917 result))))))
1993 "file-name-all-completions" result))))))))
1994 1918
1995;; cp, mv and ln 1919;; cp, mv and ln
1996 1920
@@ -2836,7 +2760,8 @@ The method used must be an out-of-band method."
2836 (unless 2760 (unless
2837 (string-match "color" (tramp-get-connection-property v "ls" "")) 2761 (string-match "color" (tramp-get-connection-property v "ls" ""))
2838 (goto-char beg) 2762 (goto-char beg)
2839 (while (re-search-forward tramp-color-escape-sequence-regexp nil t) 2763 (while
2764 (re-search-forward tramp-display-escape-sequence-regexp nil t)
2840 (replace-match ""))) 2765 (replace-match "")))
2841 2766
2842 ;; Decode the output, it could be multibyte. 2767 ;; Decode the output, it could be multibyte.
@@ -2934,7 +2859,12 @@ the result will be a local, non-Tramp, file name."
2934(defun tramp-sh-handle-start-file-process (name buffer program &rest args) 2859(defun tramp-sh-handle-start-file-process (name buffer program &rest args)
2935 "Like `start-file-process' for Tramp files." 2860 "Like `start-file-process' for Tramp files."
2936 (with-parsed-tramp-file-name (expand-file-name default-directory) nil 2861 (with-parsed-tramp-file-name (expand-file-name default-directory) nil
2937 (let* (;; When PROGRAM matches "*sh", and the first arg is "-c", 2862 (let* ((buffer
2863 (if buffer
2864 (get-buffer-create buffer)
2865 ;; BUFFER can be nil. We use a temporary buffer.
2866 (generate-new-buffer tramp-temp-buffer-name)))
2867 ;; When PROGRAM matches "*sh", and the first arg is "-c",
2938 ;; it might be that the arguments exceed the command line 2868 ;; it might be that the arguments exceed the command line
2939 ;; length. Therefore, we modify the command. 2869 ;; length. Therefore, we modify the command.
2940 (heredoc (and (stringp program) 2870 (heredoc (and (stringp program)
@@ -2992,9 +2922,6 @@ the result will be a local, non-Tramp, file name."
2992 ;; `eshell' and friends. 2922 ;; `eshell' and friends.
2993 (tramp-current-connection nil)) 2923 (tramp-current-connection nil))
2994 2924
2995 (unless buffer
2996 ;; BUFFER can be nil. We use a temporary buffer.
2997 (setq buffer (generate-new-buffer tramp-temp-buffer-name)))
2998 (while (get-process name1) 2925 (while (get-process name1)
2999 ;; NAME must be unique as process name. 2926 ;; NAME must be unique as process name.
3000 (setq i (1+ i) 2927 (setq i (1+ i)
@@ -4030,7 +3957,7 @@ file exists and nonzero exit status otherwise."
4030 shell) 3957 shell)
4031 (setq shell 3958 (setq shell
4032 (with-tramp-connection-property vec "remote-shell" 3959 (with-tramp-connection-property vec "remote-shell"
4033 ;; CCC: "root" does not exist always, see QNAP 459. 3960 ;; CCC: "root" does not exist always, see my QNAP TS-459.
4034 ;; Which check could we apply instead? 3961 ;; Which check could we apply instead?
4035 (tramp-send-command vec "echo ~root" t) 3962 (tramp-send-command vec "echo ~root" t)
4036 (if (or (string-match "^~root$" (buffer-string)) 3963 (if (or (string-match "^~root$" (buffer-string))
@@ -4790,7 +4717,7 @@ connection if a previous connection has died for some reason."
4790 (options (tramp-ssh-controlmaster-options vec)) 4717 (options (tramp-ssh-controlmaster-options vec))
4791 (process-connection-type tramp-process-connection-type) 4718 (process-connection-type tramp-process-connection-type)
4792 (process-adaptive-read-buffering nil) 4719 (process-adaptive-read-buffering nil)
4793 ;; There are unfortune settings for "cmdproxy" on 4720 ;; There are unfortunate settings for "cmdproxy" on
4794 ;; W32 systems. 4721 ;; W32 systems.
4795 (process-coding-system-alist nil) 4722 (process-coding-system-alist nil)
4796 (coding-system-for-read nil) 4723 (coding-system-for-read nil)
@@ -5000,7 +4927,12 @@ function waits for output unless NOOUTPUT is set."
5000 (with-current-buffer (process-buffer proc) 4927 (with-current-buffer (process-buffer proc)
5001 (let* (;; Initially, `tramp-end-of-output' is "#$ ". There might 4928 (let* (;; Initially, `tramp-end-of-output' is "#$ ". There might
5002 ;; be leading escape sequences, which must be ignored. 4929 ;; be leading escape sequences, which must be ignored.
5003 (regexp (format "[^#$\n]*%s\r?$" (regexp-quote tramp-end-of-output))) 4930 ;; Busyboxes built with the EDITING_ASK_TERMINAL config
4931 ;; option send also escape sequences, which must be
4932 ;; ignored.
4933 (regexp (format "[^#$\n]*%s\\(%s\\)?\r?$"
4934 (regexp-quote tramp-end-of-output)
4935 tramp-device-escape-sequence-regexp))
5004 ;; Sometimes, the commands do not return a newline but a 4936 ;; Sometimes, the commands do not return a newline but a
5005 ;; null byte before the shell prompt, for example "git 4937 ;; null byte before the shell prompt, for example "git
5006 ;; ls-files -c -z ...". 4938 ;; ls-files -c -z ...".
@@ -5103,16 +5035,17 @@ Return ATTR."
5103 (when attr 5035 (when attr
5104 ;; Remove color escape sequences from symlink. 5036 ;; Remove color escape sequences from symlink.
5105 (when (stringp (car attr)) 5037 (when (stringp (car attr))
5106 (while (string-match tramp-color-escape-sequence-regexp (car attr)) 5038 (while (string-match tramp-display-escape-sequence-regexp (car attr))
5107 (setcar attr (replace-match "" nil nil (car attr))))) 5039 (setcar attr (replace-match "" nil nil (car attr)))))
5108 ;; Convert uid and gid. Use -1 as indication of unusable value. 5040 ;; Convert uid and gid. Use `tramp-unknown-id-integer' as
5041 ;; indication of unusable value.
5109 (when (and (numberp (nth 2 attr)) (< (nth 2 attr) 0)) 5042 (when (and (numberp (nth 2 attr)) (< (nth 2 attr) 0))
5110 (setcar (nthcdr 2 attr) -1)) 5043 (setcar (nthcdr 2 attr) tramp-unknown-id-integer))
5111 (when (and (floatp (nth 2 attr)) 5044 (when (and (floatp (nth 2 attr))
5112 (<= (nth 2 attr) most-positive-fixnum)) 5045 (<= (nth 2 attr) most-positive-fixnum))
5113 (setcar (nthcdr 2 attr) (round (nth 2 attr)))) 5046 (setcar (nthcdr 2 attr) (round (nth 2 attr))))
5114 (when (and (numberp (nth 3 attr)) (< (nth 3 attr) 0)) 5047 (when (and (numberp (nth 3 attr)) (< (nth 3 attr) 0))
5115 (setcar (nthcdr 3 attr) -1)) 5048 (setcar (nthcdr 3 attr) tramp-unknown-id-integer))
5116 (when (and (floatp (nth 3 attr)) 5049 (when (and (floatp (nth 3 attr))
5117 (<= (nth 3 attr) most-positive-fixnum)) 5050 (<= (nth 3 attr) most-positive-fixnum))
5118 (setcar (nthcdr 3 attr) (round (nth 3 attr)))) 5051 (setcar (nthcdr 3 attr) (round (nth 3 attr))))
@@ -5556,8 +5489,10 @@ Return ATTR."
5556 (tramp-get-remote-uid-with-python vec id-format)))))) 5489 (tramp-get-remote-uid-with-python vec id-format))))))
5557 ;; Ensure there is a valid result. 5490 ;; Ensure there is a valid result.
5558 (cond 5491 (cond
5559 ((and (equal id-format 'integer) (not (integerp res))) -1) 5492 ((and (equal id-format 'integer) (not (integerp res)))
5560 ((and (equal id-format 'string) (not (stringp res))) "UNKNOWN") 5493 tramp-unknown-id-integer)
5494 ((and (equal id-format 'string) (not (stringp res)))
5495 tramp-unknown-id-string)
5561 (t res))))) 5496 (t res)))))
5562 5497
5563(defun tramp-get-remote-gid-with-id (vec id-format) 5498(defun tramp-get-remote-gid-with-id (vec id-format)
@@ -5600,8 +5535,10 @@ Return ATTR."
5600 (tramp-get-remote-gid-with-python vec id-format)))))) 5535 (tramp-get-remote-gid-with-python vec id-format))))))
5601 ;; Ensure there is a valid result. 5536 ;; Ensure there is a valid result.
5602 (cond 5537 (cond
5603 ((and (equal id-format 'integer) (not (integerp res))) -1) 5538 ((and (equal id-format 'integer) (not (integerp res)))
5604 ((and (equal id-format 'string) (not (stringp res))) "UNKNOWN") 5539 tramp-unknown-id-integer)
5540 ((and (equal id-format 'string) (not (stringp res)))
5541 tramp-unknown-id-string)
5605 (t res))))) 5542 (t res)))))
5606 5543
5607;; Some predefined connection properties. 5544;; Some predefined connection properties.
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index c4dde050c83..fbd7cd30008 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -663,8 +663,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
663 result))) 663 result)))
664 ;; Sort them if necessary. 664 ;; Sort them if necessary.
665 (unless nosort (setq result (sort result 'string-lessp))) 665 (unless nosort (setq result (sort result 'string-lessp)))
666 ;; Remove double entries. 666 result))
667 (delete-dups result)))
668 667
669(defun tramp-smb-handle-expand-file-name (name &optional dir) 668(defun tramp-smb-handle-expand-file-name (name &optional dir)
670 "Like `expand-file-name' for Tramp files." 669 "Like `expand-file-name' for Tramp files."
@@ -907,17 +906,17 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
907 "Like `file-name-all-completions' for Tramp files." 906 "Like `file-name-all-completions' for Tramp files."
908 (all-completions 907 (all-completions
909 filename 908 filename
910 (with-parsed-tramp-file-name directory nil 909 (with-parsed-tramp-file-name (expand-file-name directory) nil
911 (with-tramp-file-property v localname "file-name-all-completions" 910 (with-tramp-file-property v localname "file-name-all-completions"
912 (save-match-data 911 (save-match-data
913 (let ((entries (tramp-smb-get-file-entries directory))) 912 (delete-dups
914 (mapcar 913 (mapcar
915 (lambda (x) 914 (lambda (x)
916 (list 915 (list
917 (if (string-match "d" (nth 1 x)) 916 (if (string-match "d" (nth 1 x))
918 (file-name-as-directory (nth 0 x)) 917 (file-name-as-directory (nth 0 x))
919 (nth 0 x)))) 918 (nth 0 x))))
920 entries))))))) 919 (tramp-smb-get-file-entries directory))))))))
921 920
922(defun tramp-smb-handle-file-writable-p (filename) 921(defun tramp-smb-handle-file-writable-p (filename)
923 "Like `file-writable-p' for Tramp files." 922 "Like `file-writable-p' for Tramp files."
@@ -1389,16 +1388,18 @@ target of the symlink differ."
1389(defun tramp-smb-handle-start-file-process (name buffer program &rest args) 1388(defun tramp-smb-handle-start-file-process (name buffer program &rest args)
1390 "Like `start-file-process' for Tramp files." 1389 "Like `start-file-process' for Tramp files."
1391 (with-parsed-tramp-file-name default-directory nil 1390 (with-parsed-tramp-file-name default-directory nil
1392 (let ((command (mapconcat 'identity (cons program args) " ")) 1391 (let* ((buffer
1393 (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer))) 1392 (if buffer
1394 (name1 name) 1393 (get-buffer-create buffer)
1395 (i 0)) 1394 ;; BUFFER can be nil. We use a temporary buffer.
1395 (generate-new-buffer tramp-temp-buffer-name)))
1396 (command (mapconcat 'identity (cons program args) " "))
1397 (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
1398 (name1 name)
1399 (i 0))
1396 (unwind-protect 1400 (unwind-protect
1397 (save-excursion 1401 (save-excursion
1398 (save-restriction 1402 (save-restriction
1399 (unless buffer
1400 ;; BUFFER can be nil. We use a temporary buffer.
1401 (setq buffer (generate-new-buffer tramp-temp-buffer-name)))
1402 (while (get-process name1) 1403 (while (get-process name1)
1403 ;; NAME must be unique as process name. 1404 ;; NAME must be unique as process name.
1404 (setq i (1+ i) 1405 (setq i (1+ i)
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 28fc9c748bb..e3755533b9d 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -774,6 +774,12 @@ Derived from `tramp-postfix-host-format'.")
774(defconst tramp-localname-regexp ".*$" 774(defconst tramp-localname-regexp ".*$"
775 "Regexp matching localnames.") 775 "Regexp matching localnames.")
776 776
777(defconst tramp-unknown-id-string "UNKNOWN"
778 "String used to denote an unknown user or group")
779
780(defconst tramp-unknown-id-integer -1
781 "Integer used to denote an unknown user or group")
782
777;;; File name format: 783;;; File name format:
778 784
779(defconst tramp-remote-file-name-spec-regexp 785(defconst tramp-remote-file-name-spec-regexp
@@ -2861,11 +2867,21 @@ User is always nil."
2861 (error 2867 (error
2862 "tramp-handle-file-name-completion invoked on non-tramp directory `%s'" 2868 "tramp-handle-file-name-completion invoked on non-tramp directory `%s'"
2863 directory)) 2869 directory))
2864 (try-completion 2870 (let (hits-ignored-extensions)
2865 filename 2871 (or
2866 (mapcar 'list (file-name-all-completions filename directory)) 2872 (try-completion
2867 (when predicate 2873 filename (file-name-all-completions filename directory)
2868 (lambda (x) (funcall predicate (expand-file-name (car x) directory)))))) 2874 (lambda (x)
2875 (when (funcall (or predicate 'identity) (expand-file-name x directory))
2876 (not
2877 (and
2878 completion-ignored-extensions
2879 (string-match
2880 (concat (regexp-opt completion-ignored-extensions 'paren) "$") x)
2881 ;; We remember the hit.
2882 (push x hits-ignored-extensions))))))
2883 ;; No match. So we try again for ignored files.
2884 (try-completion filename hits-ignored-extensions))))
2869 2885
2870(defun tramp-handle-file-name-directory (file) 2886(defun tramp-handle-file-name-directory (file)
2871 "Like `file-name-directory' but aware of Tramp files." 2887 "Like `file-name-directory' but aware of Tramp files."
@@ -3834,7 +3850,10 @@ be granted."
3834 vec (concat "uid-" suffix) nil)) 3850 vec (concat "uid-" suffix) nil))
3835 (remote-gid 3851 (remote-gid
3836 (tramp-get-connection-property 3852 (tramp-get-connection-property
3837 vec (concat "gid-" suffix) nil))) 3853 vec (concat "gid-" suffix) nil))
3854 (unknown-id
3855 (if (string-equal suffix "string")
3856 tramp-unknown-id-string tramp-unknown-id-integer)))
3838 (and 3857 (and
3839 file-attr 3858 file-attr
3840 (or 3859 (or
@@ -3847,12 +3866,14 @@ be granted."
3847 ;; User accessible and owned by user. 3866 ;; User accessible and owned by user.
3848 (and 3867 (and
3849 (eq access (aref (nth 8 file-attr) offset)) 3868 (eq access (aref (nth 8 file-attr) offset))
3850 (equal remote-uid (nth 2 file-attr))) 3869 (or (equal remote-uid (nth 2 file-attr))
3870 (equal unknown-id (nth 2 file-attr))))
3851 ;; Group accessible and owned by user's 3871 ;; Group accessible and owned by user's
3852 ;; principal group. 3872 ;; principal group.
3853 (and 3873 (and
3854 (eq access (aref (nth 8 file-attr) (+ offset 3))) 3874 (eq access (aref (nth 8 file-attr) (+ offset 3)))
3855 (equal remote-gid (nth 3 file-attr))))))))))) 3875 (or (equal remote-gid (nth 3 file-attr))
3876 (equal unknown-id (nth 3 file-attr))))))))))))
3856 3877
3857;;;###tramp-autoload 3878;;;###tramp-autoload
3858(defun tramp-local-host-p (vec) 3879(defun tramp-local-host-p (vec)
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index 2450a5db8b9..4d6a1203c25 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -229,8 +229,12 @@
229;; The starting position from where we determined `c-macro-cache'. 229;; The starting position from where we determined `c-macro-cache'.
230(defvar c-macro-cache-syntactic nil) 230(defvar c-macro-cache-syntactic nil)
231(make-variable-buffer-local 'c-macro-cache-syntactic) 231(make-variable-buffer-local 'c-macro-cache-syntactic)
232;; non-nil iff `c-macro-cache' has both elements set AND the cdr is at a 232;; Either nil, or the syntactic end of the macro currently represented by
233;; syntactic end of macro, not merely an apparent one. 233;; `c-macro-cache'.
234(defvar c-macro-cache-no-comment nil)
235(make-variable-buffer-local 'c-macro-cache-no-comment)
236;; Either nil, or the last character of the macro currently represented by
237;; `c-macro-cache' which isn't in a comment. */
234 238
235(defun c-invalidate-macro-cache (beg end) 239(defun c-invalidate-macro-cache (beg end)
236 ;; Called from a before-change function. If the change region is before or 240 ;; Called from a before-change function. If the change region is before or
@@ -242,12 +246,14 @@
242 ((< beg (car c-macro-cache)) 246 ((< beg (car c-macro-cache))
243 (setq c-macro-cache nil 247 (setq c-macro-cache nil
244 c-macro-cache-start-pos nil 248 c-macro-cache-start-pos nil
245 c-macro-cache-syntactic nil)) 249 c-macro-cache-syntactic nil
250 c-macro-cache-no-comment nil))
246 ((and (cdr c-macro-cache) 251 ((and (cdr c-macro-cache)
247 (< beg (cdr c-macro-cache))) 252 (< beg (cdr c-macro-cache)))
248 (setcdr c-macro-cache nil) 253 (setcdr c-macro-cache nil)
249 (setq c-macro-cache-start-pos beg 254 (setq c-macro-cache-start-pos beg
250 c-macro-cache-syntactic nil)))) 255 c-macro-cache-syntactic nil
256 c-macro-cache-no-comment nil))))
251 257
252(defun c-macro-is-genuine-p () 258(defun c-macro-is-genuine-p ()
253 ;; Check that the ostensible CPP construct at point is a real one. In 259 ;; Check that the ostensible CPP construct at point is a real one. In
@@ -288,7 +294,8 @@ comment at the start of cc-engine.el for more info."
288 t)) 294 t))
289 (setq c-macro-cache nil 295 (setq c-macro-cache nil
290 c-macro-cache-start-pos nil 296 c-macro-cache-start-pos nil
291 c-macro-cache-syntactic nil) 297 c-macro-cache-syntactic nil
298 c-macro-cache-no-comment nil)
292 299
293 (save-restriction 300 (save-restriction
294 (if lim (narrow-to-region lim (point-max))) 301 (if lim (narrow-to-region lim (point-max)))
@@ -323,7 +330,8 @@ comment at the start of cc-engine.el for more info."
323 (>= (point) (car c-macro-cache))) 330 (>= (point) (car c-macro-cache)))
324 (setq c-macro-cache nil 331 (setq c-macro-cache nil
325 c-macro-cache-start-pos nil 332 c-macro-cache-start-pos nil
326 c-macro-cache-syntactic nil)) 333 c-macro-cache-syntactic nil
334 c-macro-cache-no-comment nil))
327 (while (progn 335 (while (progn
328 (end-of-line) 336 (end-of-line)
329 (when (and (eq (char-before) ?\\) 337 (when (and (eq (char-before) ?\\)
@@ -347,14 +355,38 @@ comment at the start of cc-engine.el for more info."
347 (let* ((here (point)) 355 (let* ((here (point))
348 (there (progn (c-end-of-macro) (point))) 356 (there (progn (c-end-of-macro) (point)))
349 s) 357 s)
350 (unless c-macro-cache-syntactic 358 (if c-macro-cache-syntactic
359 (goto-char c-macro-cache-syntactic)
351 (setq s (parse-partial-sexp here there)) 360 (setq s (parse-partial-sexp here there))
352 (while (and (or (nth 3 s) ; in a string 361 (while (and (or (nth 3 s) ; in a string
353 (nth 4 s)) ; in a comment (maybe at end of line comment) 362 (nth 4 s)) ; in a comment (maybe at end of line comment)
354 (> there here)) ; No infinite loops, please. 363 (> there here)) ; No infinite loops, please.
355 (setq there (1- (nth 8 s))) 364 (setq there (1- (nth 8 s)))
356 (setq s (parse-partial-sexp here there))) 365 (setq s (parse-partial-sexp here there)))
357 (setq c-macro-cache-syntactic (car c-macro-cache))) 366 (setq c-macro-cache-syntactic (point)))
367 (point)))
368
369(defun c-no-comment-end-of-macro ()
370 ;; Go to the end of a CPP directive, or a pos just before which isn't in a
371 ;; comment. For this purpose, open strings are ignored.
372 ;;
373 ;; This function must only be called from the beginning of a CPP construct.
374 ;;
375 ;; Note that this function might do hidden buffer changes. See the comment
376 ;; at the start of cc-engine.el for more info.
377 (let* ((here (point))
378 (there (progn (c-end-of-macro) (point)))
379 s)
380 (if c-macro-cache-no-comment
381 (goto-char c-macro-cache-no-comment)
382 (setq s (parse-partial-sexp here there))
383 (while (and (nth 3 s) ; in a string
384 (> there here)) ; No infinite loops, please.
385 (setq here (1+ (nth 8 s)))
386 (setq s (parse-partial-sexp here there)))
387 (when (nth 4 s)
388 (goto-char (1- (nth 8 s))))
389 (setq c-macro-cache-no-comment (point)))
358 (point))) 390 (point)))
359 391
360(defun c-forward-over-cpp-define-id () 392(defun c-forward-over-cpp-define-id ()
@@ -8899,6 +8931,22 @@ comment at the start of cc-engine.el for more info."
8899 (c-syntactic-skip-backward c-block-prefix-charset limit t) 8931 (c-syntactic-skip-backward c-block-prefix-charset limit t)
8900 (eq (char-before) ?>)))))) 8932 (eq (char-before) ?>))))))
8901 8933
8934 ;; Skip back over noise clauses.
8935 (while (and
8936 c-opt-cpp-prefix
8937 (eq (char-before) ?\))
8938 (let ((after-paren (point)))
8939 (if (and (c-go-list-backward)
8940 (progn (c-backward-syntactic-ws)
8941 (c-simple-skip-symbol-backward))
8942 (or (looking-at c-paren-nontype-key)
8943 (looking-at c-noise-macro-with-parens-name-re)))
8944 (progn
8945 (c-syntactic-skip-backward c-block-prefix-charset limit t)
8946 t)
8947 (goto-char after-paren)
8948 nil))))
8949
8902 ;; Note: Can't get bogus hits inside template arglists below since they 8950 ;; Note: Can't get bogus hits inside template arglists below since they
8903 ;; have gotten paren syntax above. 8951 ;; have gotten paren syntax above.
8904 (when (and 8952 (when (and
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index 705f723d55d..6f4d1f16857 100644
--- a/lisp/progmodes/cc-langs.el
+++ b/lisp/progmodes/cc-langs.el
@@ -476,7 +476,8 @@ so that all identifiers are recognized as words.")
476 c++ '(c-extend-region-for-CPP 476 c++ '(c-extend-region-for-CPP
477 c-before-change-check-<>-operators 477 c-before-change-check-<>-operators
478 c-invalidate-macro-cache) 478 c-invalidate-macro-cache)
479 (c objc) '(c-extend-region-for-CPP c-invalidate-macro-cache) 479 (c objc) '(c-extend-region-for-CPP
480 c-invalidate-macro-cache)
480 ;; java 'c-before-change-check-<>-operators 481 ;; java 'c-before-change-check-<>-operators
481 awk 'c-awk-record-region-clear-NL) 482 awk 'c-awk-record-region-clear-NL)
482(c-lang-defvar c-get-state-before-change-functions 483(c-lang-defvar c-get-state-before-change-functions
@@ -505,9 +506,11 @@ parameters \(point-min) and \(point-max).")
505 ;; For documentation see the following c-lang-defvar of the same name. 506 ;; For documentation see the following c-lang-defvar of the same name.
506 ;; The value here may be a list of functions or a single function. 507 ;; The value here may be a list of functions or a single function.
507 t 'c-change-expand-fl-region 508 t 'c-change-expand-fl-region
508 (c objc) '(c-neutralize-syntax-in-and-mark-CPP 509 (c objc) '(c-extend-font-lock-region-for-macros
510 c-neutralize-syntax-in-and-mark-CPP
509 c-change-expand-fl-region) 511 c-change-expand-fl-region)
510 c++ '(c-neutralize-syntax-in-and-mark-CPP 512 c++ '(c-extend-font-lock-region-for-macros
513 c-neutralize-syntax-in-and-mark-CPP
511 c-restore-<>-properties 514 c-restore-<>-properties
512 c-change-expand-fl-region) 515 c-change-expand-fl-region)
513 java '(c-restore-<>-properties 516 java '(c-restore-<>-properties
@@ -2264,6 +2267,10 @@ contain type identifiers."
2264 ;; MSVC extension. 2267 ;; MSVC extension.
2265 "__declspec")) 2268 "__declspec"))
2266 2269
2270(c-lang-defconst c-paren-nontype-key
2271 t (c-make-keywords-re t (c-lang-const c-paren-nontype-kwds)))
2272(c-lang-defvar c-paren-nontype-key (c-lang-const c-paren-nontype-key))
2273
2267(c-lang-defconst c-paren-type-kwds 2274(c-lang-defconst c-paren-type-kwds
2268 "Keywords that may be followed by a parenthesis expression containing 2275 "Keywords that may be followed by a parenthesis expression containing
2269type identifiers separated by arbitrary tokens." 2276type identifiers separated by arbitrary tokens."
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index de903b80ade..9ab04808af6 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -865,14 +865,6 @@ Note that the style variables are always made local to the buffer."
865 865
866;;; Change hooks, linking with Font Lock and electric-indent-mode. 866;;; Change hooks, linking with Font Lock and electric-indent-mode.
867 867
868;; Buffer local variables recording Beginning/End-of-Macro position before a
869;; change, when a macro straddles, respectively, the BEG or END (or both) of
870;; the change region. Otherwise these have the values BEG/END.
871(defvar c-old-BOM 0)
872(make-variable-buffer-local 'c-old-BOM)
873(defvar c-old-EOM 0)
874(make-variable-buffer-local 'c-old-EOM)
875
876(defun c-called-from-text-property-change-p () 868(defun c-called-from-text-property-change-p ()
877 ;; Is the primitive which invoked `before-change-functions' or 869 ;; Is the primitive which invoked `before-change-functions' or
878 ;; `after-change-functions' one which merely changes text properties? This 870 ;; `after-change-functions' one which merely changes text properties? This
@@ -886,8 +878,8 @@ Note that the style variables are always made local to the buffer."
886 '(put-text-property remove-list-of-text-properties))) 878 '(put-text-property remove-list-of-text-properties)))
887 879
888(defun c-extend-region-for-CPP (beg end) 880(defun c-extend-region-for-CPP (beg end)
889 ;; Set c-old-BOM or c-old-EOM respectively to BEG, END, each extended to the 881 ;; Adjust `c-new-BEG', `c-new-END' respectively to the beginning and end of
890 ;; beginning/end of any preprocessor construct they may be in. 882 ;; any preprocessor construct they may be in.
891 ;; 883 ;;
892 ;; Point is undefined both before and after this function call; the buffer 884 ;; Point is undefined both before and after this function call; the buffer
893 ;; has already been widened, and match-data saved. The return value is 885 ;; has already been widened, and match-data saved. The return value is
@@ -896,45 +888,33 @@ Note that the style variables are always made local to the buffer."
896 ;; This function is in the C/C++/ObjC values of 888 ;; This function is in the C/C++/ObjC values of
897 ;; `c-get-state-before-change-functions' and is called exclusively as a 889 ;; `c-get-state-before-change-functions' and is called exclusively as a
898 ;; before change function. 890 ;; before change function.
899 (goto-char beg) 891 (goto-char c-new-BEG)
900 (c-beginning-of-macro) 892 (c-beginning-of-macro)
901 (setq c-old-BOM (point)) 893 (setq c-new-BEG (point))
902 894
903 (goto-char end) 895 (goto-char c-new-END)
904 (when (c-beginning-of-macro) 896 (when (c-beginning-of-macro)
905 (c-end-of-macro) 897 (c-end-of-macro)
906 (or (eobp) (forward-char))) ; Over the terminating NL which may be marked 898 (or (eobp) (forward-char))) ; Over the terminating NL which may be marked
907 ; with a c-cpp-delimiter category property 899 ; with a c-cpp-delimiter category property
908 (setq c-old-EOM (point))) 900 (setq c-new-END (point)))
909 901
910(defun c-extend-font-lock-region-for-macros (begg endd &optional old-len) 902(defun c-extend-font-lock-region-for-macros (begg endd old-len)
911 ;; Extend the region (BEGG ENDD) to cover all (possibly changed) 903 ;; Extend the region (c-new-BEG c-new-END) to cover all (possibly changed)
912 ;; preprocessor macros; return the cons (new-BEG . new-END). OLD-LEN should 904 ;; preprocessor macros; The return value has no significance.
913 ;; be either the old length parameter when called from an
914 ;; after-change-function, or nil otherwise. This defun uses the variables
915 ;; c-old-BOM, c-new-BOM.
916 ;; 905 ;;
917 ;; Point is undefined on both entry and exit to this function. The buffer 906 ;; Point is undefined on both entry and exit to this function. The buffer
918 ;; will have been widened on entry. 907 ;; will have been widened on entry.
919 (let (limits new-beg new-end) 908 ;;
920 (goto-char c-old-BOM) ; already set to old start of macro or begg. 909 ;; This function is in the C/C++/ObjC value of `c-before-font-lock-functions'.
921 (setq new-beg 910 (goto-char endd)
922 (min begg 911 (if (c-beginning-of-macro)
923 (if (setq limits (c-state-literal-at (point))) 912 (c-end-of-macro))
924 (cdr limits) ; go forward out of any string or comment. 913 (setq c-new-END (max endd c-new-END (point)))
925 (point)))) 914 ;; Determine the region, (c-new-BEG c-new-END), which will get font
926 915 ;; locked. This restricts the region should there be long macros.
927 (goto-char endd) 916 (setq c-new-BEG (max c-new-BEG (c-determine-limit 500 begg))
928 (if (setq limits (c-state-literal-at (point))) 917 c-new-END (min c-new-END (c-determine-+ve-limit 500 endd))))
929 (goto-char (car limits))) ; go backward out of any string or comment.
930 (if (c-beginning-of-macro)
931 (c-end-of-macro))
932 (setq new-end (max endd
933 (if old-len
934 (+ (- c-old-EOM old-len) (- endd begg))
935 c-old-EOM)
936 (point)))
937 (cons new-beg new-end)))
938 918
939(defun c-neutralize-CPP-line (beg end) 919(defun c-neutralize-CPP-line (beg end)
940 ;; BEG and END bound a region, typically a preprocessor line. Put a 920 ;; BEG and END bound a region, typically a preprocessor line. Put a
@@ -963,19 +943,14 @@ Note that the style variables are always made local to the buffer."
963 (t nil))))))) 943 (t nil)))))))
964 944
965(defun c-neutralize-syntax-in-and-mark-CPP (begg endd old-len) 945(defun c-neutralize-syntax-in-and-mark-CPP (begg endd old-len)
966 ;; (i) Extend the font lock region to cover all changed preprocessor 946 ;; (i) "Neutralize" every preprocessor line wholly or partially in the
967 ;; regions; it does this by setting the variables `c-new-BEG' and 947 ;; changed region. "Restore" lines which were CPP lines before the change
968 ;; `c-new-END' to the new boundaries. 948 ;; and are no longer so.
969 ;;
970 ;; (ii) "Neutralize" every preprocessor line wholly or partially in the
971 ;; extended changed region. "Restore" lines which were CPP lines before the
972 ;; change and are no longer so; these can be located from the Buffer local
973 ;; variables `c-old-BOM' and `c-old-EOM'.
974 ;; 949 ;;
975 ;; (iii) Mark every CPP construct by placing a `category' property value 950 ;; (ii) Mark each CPP construct by placing a `category' property value
976 ;; `c-cpp-delimiter' at its start and end. The marked characters are the 951 ;; `c-cpp-delimiter' at its start and end. The marked characters are the
977 ;; opening # and usually the terminating EOL, but sometimes the character 952 ;; opening # and usually the terminating EOL, but sometimes the character
978 ;; before a comment/string delimiter. 953 ;; before a comment delimiter.
979 ;; 954 ;;
980 ;; That is, set syntax-table properties on characters that would otherwise 955 ;; That is, set syntax-table properties on characters that would otherwise
981 ;; interact syntactically with those outside the CPP line(s). 956 ;; interact syntactically with those outside the CPP line(s).
@@ -992,15 +967,8 @@ Note that the style variables are always made local to the buffer."
992 ;; Note: SPEED _MATTERS_ IN THIS FUNCTION!!! 967 ;; Note: SPEED _MATTERS_ IN THIS FUNCTION!!!
993 ;; 968 ;;
994 ;; This function might make hidden buffer changes. 969 ;; This function might make hidden buffer changes.
995 (c-save-buffer-state (new-bounds) 970 (c-save-buffer-state (limits )
996 ;; First determine the region, (c-new-BEG c-new-END), which will get font 971 ;; Clear 'syntax-table properties "punctuation":
997 ;; locked. It might need "neutralizing". This region may not start
998 ;; inside a string, comment, or macro.
999 (setq new-bounds (c-extend-font-lock-region-for-macros
1000 c-new-BEG c-new-END old-len))
1001 (setq c-new-BEG (max (car new-bounds) (c-determine-limit 500 begg))
1002 c-new-END (min (cdr new-bounds) (c-determine-+ve-limit 500 endd)))
1003 ;; Clear all old relevant properties.
1004 (c-clear-char-property-with-value c-new-BEG c-new-END 'syntax-table '(1)) 972 (c-clear-char-property-with-value c-new-BEG c-new-END 'syntax-table '(1))
1005 973
1006 ;; CPP "comment" markers: 974 ;; CPP "comment" markers:
@@ -1011,6 +979,8 @@ Note that the style variables are always made local to the buffer."
1011 979
1012 ;; Add needed properties to each CPP construct in the region. 980 ;; Add needed properties to each CPP construct in the region.
1013 (goto-char c-new-BEG) 981 (goto-char c-new-BEG)
982 (if (setq limits (c-literal-limits)) ; Go past any literal.
983 (goto-char (cdr limits)))
1014 (skip-chars-backward " \t") 984 (skip-chars-backward " \t")
1015 (let ((pps-position (point)) pps-state mbeg) 985 (let ((pps-position (point)) pps-state mbeg)
1016 (while (and (< (point) c-new-END) 986 (while (and (< (point) c-new-END)
@@ -1030,7 +1000,7 @@ Note that the style variables are always made local to the buffer."
1030 (nth 4 pps-state)))) ; in a comment? 1000 (nth 4 pps-state)))) ; in a comment?
1031 (goto-char (match-beginning 1)) 1001 (goto-char (match-beginning 1))
1032 (setq mbeg (point)) 1002 (setq mbeg (point))
1033 (if (> (c-syntactic-end-of-macro) mbeg) 1003 (if (> (c-no-comment-end-of-macro) mbeg)
1034 (progn 1004 (progn
1035 (c-neutralize-CPP-line mbeg (point)) ; "punctuation" properties 1005 (c-neutralize-CPP-line mbeg (point)) ; "punctuation" properties
1036 (if (eval-when-compile 1006 (if (eval-when-compile
@@ -1256,10 +1226,15 @@ Note that the style variables are always made local to the buffer."
1256 ;; 1226 ;;
1257 ;; This is called from an after-change-function, but the parameters BEG END 1227 ;; This is called from an after-change-function, but the parameters BEG END
1258 ;; and OLD-LEN are not used. 1228 ;; and OLD-LEN are not used.
1259 (if font-lock-mode 1229 (if font-lock-mode
1260 (setq c-new-BEG 1230 (setq c-new-BEG
1261 (or (c-fl-decl-start c-new-BEG) (c-point 'bol c-new-BEG)) 1231 (or (c-fl-decl-start c-new-BEG) (c-point 'bol c-new-BEG))
1262 c-new-END (c-point 'bonl c-new-END)))) 1232 c-new-END
1233 (save-excursion
1234 (goto-char c-new-END)
1235 (if (bolp)
1236 (point)
1237 (c-point 'bonl c-new-END))))))
1263 1238
1264(defun c-context-expand-fl-region (beg end) 1239(defun c-context-expand-fl-region (beg end)
1265 ;; Return a cons (NEW-BEG . NEW-END), where NEW-BEG is the beginning of a 1240 ;; Return a cons (NEW-BEG . NEW-END), where NEW-BEG is the beginning of a
diff --git a/lisp/recentf.el b/lisp/recentf.el
index df7f3e2e565..3321f2fe101 100644
--- a/lisp/recentf.el
+++ b/lisp/recentf.el
@@ -1064,7 +1064,6 @@ Go to the beginning of buffer if not found."
1064 (define-key km "q" 'recentf-cancel-dialog) 1064 (define-key km "q" 'recentf-cancel-dialog)
1065 (define-key km "n" 'next-line) 1065 (define-key km "n" 'next-line)
1066 (define-key km "p" 'previous-line) 1066 (define-key km "p" 'previous-line)
1067 (define-key km [follow-link] "\C-m")
1068 km) 1067 km)
1069 "Keymap used in recentf dialogs.") 1068 "Keymap used in recentf dialogs.")
1070 1069
diff --git a/lisp/simple.el b/lisp/simple.el
index affc403dcdc..3d25ec19ab2 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -6054,7 +6054,13 @@ If NOERROR, don't signal an error if we can't move that many lines."
6054 (setq temporary-goal-column 6054 (setq temporary-goal-column
6055 (cons (/ (float x-pos) 6055 (cons (/ (float x-pos)
6056 (frame-char-width)) 6056 (frame-char-width))
6057 hscroll)))))) 6057 hscroll)))
6058 (executing-kbd-macro
6059 ;; When we move beyond the first/last character visible in
6060 ;; the window, posn-at-point will return nil, so we need to
6061 ;; approximate the goal column as below.
6062 (setq temporary-goal-column
6063 (mod (current-column) (window-text-width)))))))
6058 (if target-hscroll 6064 (if target-hscroll
6059 (set-window-hscroll (selected-window) target-hscroll)) 6065 (set-window-hscroll (selected-window) target-hscroll))
6060 ;; vertical-motion can move more than it was asked to if it moves 6066 ;; vertical-motion can move more than it was asked to if it moves
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 0a0f4582b32..9ede9a5633f 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -1789,7 +1789,13 @@ If END is omitted, it defaults to the length of LIST."
1789 "An embedded link." 1789 "An embedded link."
1790 :button-prefix 'widget-link-prefix 1790 :button-prefix 'widget-link-prefix
1791 :button-suffix 'widget-link-suffix 1791 :button-suffix 'widget-link-suffix
1792 :follow-link 'mouse-face 1792 ;; The `follow-link' property should only be used in those contexts where the
1793 ;; mouse-1 event normally doesn't follow the link, yet the `link' widget
1794 ;; seems to almost always be used in contexts where (down-)mouse-1 is bound
1795 ;; to `widget-button-click' and hence the "mouse-1 to mouse-2" remapping is
1796 ;; not necessary (and can even be harmful). So let's not add a :follow-link
1797 ;; by default. See (bug#22434).
1798 ;; :follow-link 'mouse-face
1793 :help-echo "Follow the link." 1799 :help-echo "Follow the link."
1794 :format "%[%t%]") 1800 :format "%[%t%]")
1795 1801