bug#37189: 25.4.1: vc-hg-ignore implementation is missing

[Wolfgang Scherer <Wolfgang.Scherer@gmx.de>]

[-- Attachment #1: Type: text/plain, Size: 3365 bytes --]

Hi Dmitry,

Am 25.12.19 um 01:16 schrieb Dmitry Gutov:
> On 29.08.2019 18:52, Wolfgang Scherer wrote:
>> +  "Ignore FILE of DIRECTORY (default is `default-directory').
>
> IF this function needs a docstring at all (which is not obvious since it should be following vc-ignore), I think I'd rather this followed the latter's docstring. Where the clarification about the default is not in the first sentence.

vc-hg-ignore needs a docstring, since it exhibits specific behavior for the backend (e.g. glob/regex syntax), which is not and cannot be covered by the rather generic vc-ignore docstring.

Most of the description in  vc-ignore is not even applicable to the backend specific functions, e.g. there is no interactive functionality in the backend function and no backend is determined.

If a backend does not provide a vc-BACKEND-ignore function, vc-default-ignore is invoked. This function has a docstring of its own (which contains the clarification about the default in the first sentence). According to your argument, this function should also have no docstring of its own. However, I cannot see how both docstrings are equivalent.

vc-hg-ignore is modeled after vc-default-ignore, the docstring was copied from vc-default-ignore and modified to fit the implementation. I have modified the docstring further to match other backend specific ignore functions.

>
> Also, I think saying "Ignore FILE under DIRECTORY" would be better, if you intend to add this particular semantics to relative names.
All other ignore functions say "Ignore FILE under VCS". I have modified the docstring accordingly.
>
>> +Otherwise, FILE is either relative to DIRECTORY or absolute. FILE
>> +is converted to a path relative to the project root of DIRECTORY.
>
> Isn't it a bit odd that vc-ignore's docstring doesn't specify this distinction, and yet we're trying to implement it in vc-hg-ignore?

No. vc-ignore's semantic roots stem from SCCS/RCS/CVS/subversion with single directory ignore files. The ignore files for those VCS only contain file patterns.

For a VCS with subdirectories and a single ignore file at the root of the repository (Git, Mercurial), rooted and non-rooted expressions are handled differently and the single directory ignore file paradigm fails.

>
> Do you have a particular reason for that?
Yes. It is the standard use case for ignoring something from vc-dir mode. As mentioned, the vc-default-ignore produces utterly useless results for Git and Mercurial in vc-dir mode.
>
>> +                (concat pattern (and (file-directory-p file-path) "*"))))))
>
> I think it needs to asterisks for the glob to become recursive. At least according to https://stackoverflow.com/a/255094/615245.
No, according to https://stackoverflow.com/a/255094/2127439, all of "bin/", "bin/*", "bin/**" are equivalent under glob syntax. I also tested this specifically and extensivlely.
>
>> +    (lambda (_c)
>> +      (cons _c (concat "\\" (char-to-string _c)))))
>
> Our convention says that an argument whose name starts with underscore is unused. That's not the case here, so it shouldn't be named like that.
OK.
>
>> +    (lambda (_c)
>> +      (or (cdr (assq _c vc-hg--py-regexp-special-chars))
>> +          (char-to-string _c))))
>
> Same.

OK.

New patch attached.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Provide-vc-hg-ignore-to-make-vc-ignore-work-correctl.patch --]
[-- Type: text/x-patch; name="0001-Provide-vc-hg-ignore-to-make-vc-ignore-work-correctl.patch", Size: 16393 bytes --]

From 81672e2909bca4ea4299301bbf4450e392b3a4f8 Mon Sep 17 00:00:00 2001
From: Wolfgang Scherer <wolfgang.scherer@gmx.de>
Date: Sun, 5 Jan 2020 04:29:28 +0100
Subject: [PATCH] Provide vc-hg-ignore to make vc-ignore work correctly

* lisp/vc/vc-hg.el: (vc-hg-ignore) Ignore file of directory.  Add
filepath relative to directory of Mercurial .hgignore file.  The
filepath is quoted according to the active ignore syntax (Bug#37189).
(vc-hg--py-regexp-quote) Quote string as regexp to match exactly
string.
---
 lisp/vc/vc-hg.el | 229 +++++++++++++++++++++++++++++++++++--------------------
 1 file changed, 145 insertions(+), 84 deletions(-)

diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index eac9a6f..db84a28 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -142,9 +142,9 @@ If nil, use the value of `vc-diff-switches'.  If t, use no switches."
 If nil, use the value of `vc-annotate-switches'.  If t, use no
 switches."
   :type '(choice (const :tag "Unspecified" nil)
-		 (const :tag "None" t)
-		 (string :tag "Argument String")
-		 (repeat :tag "Argument List" :value ("") string))
+                 (const :tag "None" t)
+                 (string :tag "Argument String")
+                 (repeat :tag "Argument List" :value ("") string))
   :version "25.1"
   :group 'vc-hg)

@@ -152,8 +152,8 @@ switches."
   "String or list of strings specifying switches for hg revert
 under VC."
   :type '(choice (const :tag "None" nil)
-		 (string :tag "Argument String")
-		 (repeat :tag "Argument List" :value ("") string))
+                 (string :tag "Argument String")
+                 (repeat :tag "Argument List" :value ("") string))
   :version "27.1"
   :group 'vc-hg)

@@ -233,35 +233,35 @@ highlighting the Log View buffer."
             (setq status
                   (condition-case nil
                       ;; Ignore all errors.
-		      (let ((process-environment
-			     ;; Avoid localization of messages so we
-			     ;; can parse the output.  Disable pager.
-			     (append
-			      (list "TERM=dumb" "LANGUAGE=C" "HGPLAIN=1")
-			      process-environment)))
-			(process-file
-			 vc-hg-program nil t nil
+                      (let ((process-environment
+                             ;; Avoid localization of messages so we
+                             ;; can parse the output.  Disable pager.
+                             (append
+                              (list "TERM=dumb" "LANGUAGE=C" "HGPLAIN=1")
+                              process-environment)))
+                        (process-file
+                         vc-hg-program nil t nil
                          "--config" "ui.report_untrusted=0"
-			 "--config" "alias.status=status"
-			 "--config" "defaults.status="
-			 "status" "-A" (file-relative-name file)))
+                         "--config" "alias.status=status"
+                         "--config" "defaults.status="
+                         "status" "-A" (file-relative-name file)))
                     ;; Some problem happened.  E.g. We can't find an `hg'
                     ;; executable.
                     (error nil)))))))
     (when (and (eq 0 status)
-	       (> (length out) 0)
-	       (null (string-match ".*: No such file or directory$" out)))
+               (> (length out) 0)
+               (null (string-match ".*: No such file or directory$" out)))
       (let ((state (aref out 0)))
-	(cond
-	 ((eq state ?=) 'up-to-date)
-	 ((eq state ?A) 'added)
-	 ((eq state ?M) 'edited)
-	 ((eq state ?I) 'ignored)
-	 ((eq state ?R) 'removed)
-	 ((eq state ?!) 'missing)
-	 ((eq state ??) 'unregistered)
-	 ((eq state ?C) 'up-to-date) ;; Older mercurial versions use this.
-	 (t 'up-to-date))))))
+        (cond
+         ((eq state ?=) 'up-to-date)
+         ((eq state ?A) 'added)
+         ((eq state ?M) 'edited)
+         ((eq state ?I) 'ignored)
+         ((eq state ?R) 'removed)
+         ((eq state ?!) 'missing)
+         ((eq state ??) 'unregistered)
+         ((eq state ?C) 'up-to-date) ;; Older mercurial versions use this.
+         (t 'up-to-date))))))

 (defun vc-hg-working-revision (file)
   "Hg-specific version of `vc-working-revision'."
@@ -429,19 +429,19 @@ If LIMIT is non-nil, show no more than this many entries."
   ;; read-only.
   (let ((inhibit-read-only t))
     (with-current-buffer
-	buffer
+        buffer
       (apply 'vc-hg-command buffer 'async files "log"
-	     (nconc
-	      (when start-revision (list (format "-r%s:0" start-revision)))
-	      (when limit (list "-l" (format "%s" limit)))
+             (nconc
+              (when start-revision (list (format "-r%s:0" start-revision)))
+              (when limit (list "-l" (format "%s" limit)))
               (when (eq vc-log-view-type 'with-diff)
                 (list "-p"))
-	      (if shortlog
+              (if shortlog
                   `(,@(if vc-hg-log-graph '("--graph"))
                     "--template"
                     ,(car vc-hg-root-log-format))
                 `("--template" ,vc-hg-log-format))
-	      vc-hg-log-switches)))))
+              vc-hg-log-switches)))))

 (defvar log-view-message-re)
 (defvar log-view-file-re)
@@ -455,35 +455,35 @@ If LIMIT is non-nil, show no more than this many entries."
   (set (make-local-variable 'log-view-per-file-logs) nil)
   (set (make-local-variable 'log-view-message-re)
        (if (eq vc-log-view-type 'short)
-	   (cadr vc-hg-root-log-format)
+           (cadr vc-hg-root-log-format)
          "^changeset:[ \t]*\\([0-9]+\\):\\(.+\\)"))
   (set (make-local-variable 'tab-width) 2)
   ;; Allow expanding short log entries
   (when (eq vc-log-view-type 'short)
     (setq truncate-lines t)
     (set (make-local-variable 'log-view-expanded-log-entry-function)
-	 'vc-hg-expanded-log-entry))
+         'vc-hg-expanded-log-entry))
   (set (make-local-variable 'log-view-font-lock-keywords)
        (if (eq vc-log-view-type 'short)
-	   (list (cons (nth 1 vc-hg-root-log-format)
-		       (nth 2 vc-hg-root-log-format)))
-	 (append
-	  log-view-font-lock-keywords
-	  '(
-	    ;; Handle the case:
-	    ;; user: FirstName LastName <foo@bar>
-	    ("^user:[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]"
-	     (1 'change-log-name)
-	     (2 'change-log-email))
-	    ;; Handle the cases:
-	    ;; user: foo@bar
-	    ;; and
-	    ;; user: foo
-	    ("^user:[ \t]+\\([A-Za-z0-9_.+-]+\\(?:@[A-Za-z0-9_.-]+\\)?\\)"
-	     (1 'change-log-email))
-	    ("^date: \\(.+\\)" (1 'change-log-date))
-	    ("^tag: +\\([^ ]+\\)$" (1 'highlight))
-	    ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message)))))))
+           (list (cons (nth 1 vc-hg-root-log-format)
+                       (nth 2 vc-hg-root-log-format)))
+         (append
+          log-view-font-lock-keywords
+          '(
+            ;; Handle the case:
+            ;; user: FirstName LastName <foo@bar>
+            ("^user:[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]"
+             (1 'change-log-name)
+             (2 'change-log-email))
+            ;; Handle the cases:
+            ;; user: foo@bar
+            ;; and
+            ;; user: foo
+            ("^user:[ \t]+\\([A-Za-z0-9_.+-]+\\(?:@[A-Za-z0-9_.-]+\\)?\\)"
+             (1 'change-log-email))
+            ("^date: \\(.+\\)" (1 'change-log-date))
+            ("^tag: +\\([^ ]+\\)$" (1 'highlight))
+            ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message)))))))

 (autoload 'vc-switches "vc")

@@ -545,7 +545,7 @@ This requires hg 4.4 or later, for the \"-L\" option of \"hg log\"."
     (when (and (not oldvers) newvers)
       (setq oldvers working))
     (apply #'vc-hg-command
-	   (or buffer "*vc-diff*")
+           (or buffer "*vc-diff*")
            nil ; bug#21969
            files "diff"
            (append
@@ -584,7 +584,7 @@ This requires hg 4.4 or later, for the \"-L\" option of \"hg log\"."
   "Execute \"hg annotate\" on FILE, inserting the contents in BUFFER.
 Optional arg REVISION is a revision to annotate from."
   (apply #'vc-hg-command buffer 0 file "annotate" "-dq" "-n"
-	 (append (vc-switches 'hg 'annotate)
+         (append (vc-switches 'hg 'annotate)
                  (if revision (list (concat "-r" revision))))))

 (declare-function vc-annotate-convert-time "vc-annotate" (&optional time))
@@ -1102,9 +1102,9 @@ hg binary."
                (let ((vc-hg-size (nth 2 dirstate-entry))
                      (vc-hg-mtime (nth 3 dirstate-entry))
                      (fs-size (file-attribute-size stat))
-		     (fs-mtime (time-convert
-				(file-attribute-modification-time stat)
-				'integer)))
+                     (fs-mtime (time-convert
+                                (file-attribute-modification-time stat)
+                                'integer)))
                  (if (and (eql vc-hg-size fs-size) (eql vc-hg-mtime fs-mtime))
                      'up-to-date
                    'edited)))
@@ -1210,7 +1210,51 @@ REV is ignored."
 (defun vc-hg-find-ignore-file (file)
   "Return the root directory of the repository of FILE."
   (expand-file-name ".hgignore"
-		    (vc-hg-root file)))
+                    (vc-hg-root file)))
+
+(defvar vc-hg-ignore-detect-wildcard "[*^$]"
+  "Regular expresssion to detect wildcards in an ignored file
+  specification.")
+
+(defun vc-hg-ignore (file &optional directory remove)
+  "Ignore FILE under Mercurial.
+FILE is either absolute or relative to DIRECTORY (default is
+`default-directory').
+If FILE matches the regular expression
+`vc-hg-ignore-detect-wildcard', it is processed unmodified.
+Otherwise, FILE is converted to a path relative to the project
+root of DIRECTORY.  It is then further escaped/expanded according
+to the active syntax in .hgignore.  If the syntax is `regexp',
+FILE is quoted as anchored literal Python regexp and if FILE is a
+directory, the trailing `$' is omitted.  Otherwise, if the syntax
+is `glob', FILE is used unquoted and if FILE is a directory, a
+`*' is appended.
+If REMOVE is non-nil, remove the pattern derived from FILE from
+ignored files."
+  (let ((ignore (vc-hg-find-ignore-file (or directory default-directory)))
+        (pattern file)
+        root-dir file-path syntax)
+    (unless (string-match vc-hg-ignore-detect-wildcard pattern)
+      (setq file-path (expand-file-name file directory))
+      (setq root-dir (file-name-directory ignore))
+      (when (not (string= (substring file-path 0 (length root-dir)) root-dir))
+        (error "Ignore spec %s is not below project root %s" file-path root-dir))
+      (setq pattern (substring file-path (length root-dir)))
+      (save-match-data
+        (with-current-buffer (find-file-noselect ignore)
+          (goto-char (point-max))
+          (setq syntax
+                (if (re-search-backward "^ *syntax: *\\(regexp\\|glob\\)$" nil t)
+                    (match-string 1)
+                  "regexp")))
+        (setq pattern
+              (if (string= syntax "regexp")
+                  (concat "^" (vc-hg--py-regexp-quote pattern)
+                          (and (not (file-directory-p file-path)) "$"))
+                (concat pattern (and (file-directory-p file-path) "*"))))))
+    (if remove
+        (vc--remove-regexp (concat "^" (regexp-quote pattern ) "\\(\n\\|$\\)") ignore)
+      (vc--add-line pattern ignore))))

 ;; Modeled after the similar function in vc-bzr.el
 (defun vc-hg-checkout (file &optional rev)
@@ -1250,7 +1294,6 @@ REV is the revision to check out into WORKFILE."
     (add-hook 'after-save-hook 'vc-hg-resolve-when-done nil t)
     (vc-message-unresolved-conflicts buffer-file-name)))

-
 ;; Modeled after the similar function in vc-bzr.el
 (defun vc-hg-revert (file &optional contents-done)
   (unless contents-done
@@ -1386,12 +1429,12 @@ REV is the revision to check out into WORKFILE."
 (defun vc-hg-log-incoming (buffer remote-location)
   (vc-setup-buffer buffer)
   (vc-hg-command buffer 1 nil "incoming" "-n" (unless (string= remote-location "")
-						remote-location)))
+                                                remote-location)))

 (defun vc-hg-log-outgoing (buffer remote-location)
   (vc-setup-buffer buffer)
   (vc-hg-command buffer 1 nil "outgoing" "-n" (unless (string= remote-location "")
-						remote-location)))
+                                                remote-location)))

 (defvar vc-hg-error-regexp-alist
   '(("^M \\(.+\\)" 1 nil nil 0))
@@ -1413,30 +1456,30 @@ commands, which only operated on marked files."
     ;; `pull'/`push' VC actions were implemented.
     ;; The following is for backwards compatibility.
     (if (and obsolete (setq marked-list (log-view-get-marked)))
-	(apply #'vc-hg-command
-	       nil 0 nil
-	       command
-	       (apply 'nconc
-		      (mapcar (lambda (arg) (list "-r" arg)) marked-list)))
+        (apply #'vc-hg-command
+               nil 0 nil
+               command
+               (apply 'nconc
+                      (mapcar (lambda (arg) (list "-r" arg)) marked-list)))
       (let* ((root (vc-hg-root default-directory))
-	     (buffer (format "*vc-hg : %s*" (expand-file-name root)))
-	      ;; Disable pager.
+             (buffer (format "*vc-hg : %s*" (expand-file-name root)))
+              ;; Disable pager.
              (process-environment (cons "HGPLAIN=1" process-environment))
-	     (hg-program vc-hg-program)
-	     args)
-	;; If necessary, prompt for the exact command.
+             (hg-program vc-hg-program)
+             args)
+        ;; If necessary, prompt for the exact command.
         ;; TODO if pushing, prompt if no default push location - cf bzr.
-	(when prompt
-	  (setq args (split-string
-		      (read-shell-command
+        (when prompt
+          (setq args (split-string
+                      (read-shell-command
                        (format "Hg %s command: " command)
                        (format "%s %s" hg-program command)
                        'vc-hg-history)
-		      " " t))
-	  (setq hg-program (car  args)
-		command    (cadr args)
-		args       (cddr args)))
-	(apply 'vc-do-async-command buffer root hg-program command args)
+                      " " t))
+          (setq hg-program (car  args)
+                command    (cadr args)
+                args       (cddr args)))
+        (apply 'vc-do-async-command buffer root hg-program command args)
         (with-current-buffer buffer
           (vc-run-delayed
             (dolist (cmd post-processing)
@@ -1458,7 +1501,7 @@ commands, which only operated on marked files."
                         (list compile-command nil
                               (lambda (_name-of-mode) buffer)
                               nil))))
-	(vc-set-async-update buffer)))))
+        (vc-set-async-update buffer)))))

 (defun vc-hg-pull (prompt)
   "Issue a Mercurial pull command.
@@ -1494,7 +1537,7 @@ call \"hg push -r REVS\" to push the specified revisions REVS."
   "Prompt for revision and merge it into working directory.
 This runs the command \"hg merge\"."
   (let* ((root (vc-hg-root default-directory))
-	 (buffer (format "*vc-hg : %s*" (expand-file-name root)))
+         (buffer (format "*vc-hg : %s*" (expand-file-name root)))
          ;; Disable pager.
          (process-environment (cons "HGPLAIN=1" process-environment))
          (branch (vc-read-revision "Revision to merge: ")))
@@ -1522,6 +1565,24 @@ This function differs from vc-do-command in that it invokes
 (defun vc-hg-root (file)
   (vc-find-root file ".hg"))

+(defvar vc-hg--py-regexp-special-chars
+  (mapcar
+   (function
+    (lambda (ch)
+      (cons ch (concat "\\" (char-to-string ch)))))
+   (append "()[]{}?*+-|^$\\.&~# \t\n\r\v\f" nil))
+  "Characters that have special meaning in Python regular expressions.")
+
+(defun vc-hg--py-regexp-quote (string)
+  "Return a Python regexp string which matches exactly STRING and nothing else.
+Ported from Python v3.7"
+  (mapconcat
+   (function
+    (lambda (ch)
+      (or (cdr (assq ch vc-hg--py-regexp-special-chars))
+          (char-to-string ch))))
+   string ""))
+
 (provide 'vc-hg)

 ;;; vc-hg.el ends here
--
2.7.4