unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
From: Wolfgang Scherer <Wolfgang.Scherer@gmx.de>
To: Eli Zaretskii <eliz@gnu.org>
Cc: 37189@debbugs.gnu.org, dgutov@yandex.ru
Subject: bug#37189: 25.4.1: vc-hg-ignore implementation is missing
Date: Sun, 9 Feb 2020 22:06:02 +0100	[thread overview]
Message-ID: <6f6fe037-056c-67cf-58d3-17bce36f8f03@gmx.de> (raw)
In-Reply-To: <8336bmg1o9.fsf@gnu.org>

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

Am 07.02.20 um 10:57 schrieb Eli Zaretskii:
>> Cc: dgutov@yandex.ru, 37189@debbugs.gnu.org
>> From: Wolfgang Scherer <Wolfgang.Scherer@gmx.de>
>> Date: Wed, 5 Feb 2020 20:06:15 +0100
>>
>> coming to think of it, I realized that there probably is no maintainer for the vc ignore feature. I.e., there is no use in explaining the design with many words, since it will not be implemented anyway.
> AFAIU, Dmitry oversees the VC development and maintenance.  That
> includes the issues you raised here.

I have finished the implementation of the vc ignore feature. See attached patch.

The standalone vc extension for old Emacsen is available at http://sw-amt.ws/emacs/doc/_build/html/_static/x-vc-repair.el

This obsoletes #37215 <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=37215>vc-cvs-ignore writes absolute filenames and duplicate strings, <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=37215>

------

Subject: [PATCH] vc ignore feature repair

Complete implementation of ignore feature with proper filename
escaping and anchoring for all applicable supported backends:

  CVS, SVN, SRC, Bzr, Git, Hg, Mtn.

Going back to my day job ...


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-vc-ignore-feature-repair.patch --]
[-- Type: text/x-patch; name="0001-vc-ignore-feature-repair.patch", Size: 25825 bytes --]

From 08d888a903796ef65fa0fe733ecfd71e3b367c26 Mon Sep 17 00:00:00 2001
From: Wolfgang Scherer <wolfgang.scherer@gmx.de>
Date: Sun, 9 Feb 2020 21:50:34 +0100
Subject: [PATCH] vc ignore feature repair
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Complete implementation of ignore feature with proper filename
escaping and anchoring for all applicable supported backends:

  CVS, SVN, SRC, Bzr, Git, Hg, Mtn.

* lisp/vc/vc.el: (vc-ignore-param-none, vc-ignore-param-glob)
  (vc-ignore-param-glob-anchored, vc-ignore-param-regexp)
  (vc-default-ignore-param, vc-glob-escape)
  (vc--py-regexp-special-chars, vc-py-regexp-quote): new vc ignore
  parameters
  (vc-ignore-pattern, vc-ignore-file): new user interface commands
  (vc-ignore-fileset): new frontend command
  (vc-ignore): thin wrapper around ‘vc-default-ignore’
  (vc-default-ignore): thin wrapper around
  ‘vc-default-get-ignore-file-and-pattern’ and
  ‘vc-default-modify-ignores’
  (vc-default-get-ignore-file-and-pattern): workhorse for preparing
  pattern and file ignore parameters
  (vc-default-modify-ignores): default ignore ignore file manipulator
  (vc-file-name-directory, vc-file-relative-name):
  (vc-no-final-slash, vc-has-final-slash): utilities

* lisp/vc/vc-bzr.el: (vc-bzr-ignore-param-regexp)
  (vc-bzr-ignore-param): new vc ignore parameters

* lisp/vc/vc-cvs.el: (vc-cvs-find-ignore-file)
  (vc-cvs-ignore-param-glob, vc-cvs-ignore-param)
  (vc-cvs-glob-escape): new vc ignore parameters
  (vc-cvs-ignore, vc-cvs-append-to-ignore): removed

* lisp/vc/vc-git.el: (vc-git-ignore-param): new vc ignore parameters

* lisp/vc/vc-hg.el: (vc-hg-ignore-param-regexp)
  (vc-hg-ignore-param-glob, vc-hg-ignore-param): new vc ignore
  parameters

* lisp/vc/vc-mtn.el: (vc-mtn-ignore-param-regexp)
  (vc-mtn-ignore-param): new vc ignore parameters

* lisp/vc/vc-src.el: (vc-src-find-ignore-file, vc-src-glob-escape)
  (vc-src-ignore-param-glob, vc-src-ignore-param): new vc ignore
  parameters

* lisp/vc/vc-svn.el: (vc-svn-find-ignore-file)
  (vc-svn-ignore-param-glob, vc-svn-ignore-param)
  (vc-svn-modify-ignores): new vc ignore parameters,
  (vc-svn-ignore): removed

* lisp/vc/vc-dir.el: (vc-dir-mode-map)
  new binding "F" => 'vc-ignore-file
  new binding "G" => 'vc-ignore-pattern

* lisp/vc/vc-hooks.el: (vc-prefix-map)
  new binding "F" => 'vc-ignore-file
  new binding "G" => 'vc-ignore-pattern
  (vc-menu-map): new menu item "Ignore Pattern..."
---
 lisp/vc/vc-bzr.el   |   8 ++
 lisp/vc/vc-cvs.el   |  38 +++----
 lisp/vc/vc-dir.el   |   3 +-
 lisp/vc/vc-git.el   |   4 +
 lisp/vc/vc-hg.el    |  23 +++++
 lisp/vc/vc-hooks.el |   8 +-
 lisp/vc/vc-mtn.el   |   8 ++
 lisp/vc/vc-src.el   |  26 +++++
 lisp/vc/vc-svn.el   |  26 +++--
 lisp/vc/vc.el       | 278 +++++++++++++++++++++++++++++++++++++++++++++-------
 10 files changed, 352 insertions(+), 70 deletions(-)

diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index e5d307e..1546aba 100644
--- a/lisp/vc/vc-bzr.el
+++ b/lisp/vc/vc-bzr.el
@@ -683,6 +683,14 @@ or a superior directory.")
   (expand-file-name ".bzrignore"
 		    (vc-bzr-root file)))

+(defvar vc-bzr-ignore-param-regexp
+  '(:escape: vc-py-regexp-quote :anchor: "RE:^" :trailer: "$" :dir-trailer: "/.*")
+  "Ignore parameters for Bzr anchored regular expressions.")
+
+(defun vc-bzr-ignore-param (&optional _ignore-file)
+  "Appropriate Bzr ignore parameters for IGNORE-FILE."
+        vc-bzr-ignore-param-regexp)
+
 (defun vc-bzr-checkout (_file &optional rev)
   (if rev (error "Operation not supported")
     ;; Else, there's nothing to do.
diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el
index 16566a8..ae60c6c 100644
--- a/lisp/vc/vc-cvs.el
+++ b/lisp/vc/vc-cvs.el
@@ -1220,29 +1220,21 @@ is non-nil."
   "Return the administrative directory of FILE."
   (vc-find-root file "CVS"))

-(defun vc-cvs-ignore (file &optional _directory _remove)
-  "Ignore FILE under CVS."
-  (vc-cvs-append-to-ignore (file-name-directory file) file))
-
-(defun vc-cvs-append-to-ignore (dir str &optional old-dir)
-  "In DIR, add STR to the .cvsignore file.
-If OLD-DIR is non-nil, then this is a directory that we don't want
-to hear about anymore."
-  (with-current-buffer
-      (find-file-noselect (expand-file-name ".cvsignore" dir))
-    (when (ignore-errors
-	    (and buffer-read-only
-		 (eq 'CVS (vc-backend buffer-file-name))
-		 (not (vc-editable-p buffer-file-name))))
-      ;; CVSREAD=on special case
-      (vc-checkout buffer-file-name t))
-    (goto-char (point-max))
-    (unless (bolp) (insert "\n"))
-    (insert str (if old-dir "/\n" "\n"))
-    ;; FIXME this is a pcvs variable.
-    (if (bound-and-true-p cvs-sort-ignore-file)
-        (sort-lines nil (point-min) (point-max)))
-    (save-buffer)))
+(defun vc-cvs-find-ignore-file (file)
+  "Return the ignore file for FILE."
+  (expand-file-name ".cvsignore" (if file (file-name-directory file))))
+
+(defvar vc-cvs-ignore-param-glob
+  '(:escape: vc-cvs-glob-escape :anchor: "" :trailer: "" :dir-trailer: "/")
+  "Ignore parameters for CVS partially anchored glob wildcards.")
+
+(defun vc-cvs-ignore-param (&optional _ignore-file)
+  "Appropriate CVS ignore parameters for IGNORE-FILE."
+  vc-cvs-ignore-param-glob)
+
+(defun vc-cvs-glob-escape (string)
+  "Escape special glob characters and spaces in STRING."
+  (replace-regexp-in-string " " "?" (vc-glob-escape string) t))

 (provide 'vc-cvs)

diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el
index 0c29352..0a1deeb 100644
--- a/lisp/vc/vc-dir.el
+++ b/lisp/vc/vc-dir.el
@@ -302,7 +302,8 @@ See `run-hooks'."
     (define-key map "Q" 'vc-dir-query-replace-regexp)
     (define-key map (kbd "M-s a C-s")   'vc-dir-isearch)
     (define-key map (kbd "M-s a M-C-s") 'vc-dir-isearch-regexp)
-    (define-key map "G" 'vc-dir-ignore)
+    (define-key map "F" 'vc-ignore-file)
+    (define-key map "G" 'vc-ignore-pattern)

     (let ((branch-map (make-sparse-keymap)))
       (define-key map "B" branch-map)
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 2caa287..5292f21 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -976,6 +976,10 @@ It is based on `log-edit-mode', and has Git-specific extensions.")
   (expand-file-name ".gitignore"
 		    (vc-git-root file)))

+(defun vc-git-ignore-param (&optional _ignore-file)
+  "Appropriate Git ignore parameters for IGNORE-FILE."
+  vc-ignore-param-glob-anchored)
+
 (defun vc-git-checkout (file &optional rev)
   (vc-git-command nil 0 file "checkout" (or rev "HEAD")))

diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index eac9a6f..3d22ae2 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -1212,6 +1212,29 @@ REV is ignored."
   (expand-file-name ".hgignore"
 		    (vc-hg-root file)))

+(defvar vc-hg-ignore-param-regexp
+  '(:escape: vc-py-regexp-quote :anchor: "^" :trailer: "$" :dir-trailer: "/")
+  "Ignore parameters for Hg anchored regular expressions.")
+
+(defvar vc-hg-ignore-param-glob
+  '(:escape: vc-glob-escape :anchor: "" :trailer: "" :dir-trailer: "/*")
+  "Ignore parameters for Hg anchored regular expressions.")
+
+(defun vc-hg-ignore-param (&optional ignore-file)
+  "Appropriate Hg ignore parameters for IGNORE-FILE."
+  (let ((syntax "regexp"))
+    (if (not ignore-file)
+        (setq ignore-file (vc-hg-find-ignore-file default-directory)))
+    (if (file-exists-p ignore-file)
+        (with-current-buffer (find-file-noselect ignore-file)
+          (save-match-data
+            (goto-char (point-max))
+            (if (re-search-backward "^ *syntax: *\\(regexp\\|glob\\)$" nil t)
+                (setq syntax (match-string 1))))))
+    (if (string= syntax "regexp")
+        vc-hg-ignore-param-regexp
+      vc-hg-ignore-param-glob)))
+
 ;; Modeled after the similar function in vc-bzr.el
 (defun vc-hg-checkout (file &optional rev)
   "Retrieve a revision of FILE.
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el
index 345a28d..3492dc1 100644
--- a/lisp/vc/vc-hooks.el
+++ b/lisp/vc/vc-hooks.el
@@ -883,7 +883,8 @@ In the latter case, VC mode is deactivated for this buffer."
     (define-key map "b" 'vc-switch-backend)
     (define-key map "d" 'vc-dir)
     (define-key map "g" 'vc-annotate)
-    (define-key map "G" 'vc-ignore)
+    (define-key map "F" 'vc-ignore-file)
+    (define-key map "G" 'vc-ignore-pattern)
     (define-key map "h" 'vc-region-history)
     (define-key map "i" 'vc-register)
     (define-key map "l" 'vc-print-log)
@@ -970,8 +971,11 @@ In the latter case, VC mode is deactivated for this buffer."
       '(menu-item "Register" vc-register
 		  :help "Register file set into a version control system"))
     (bindings--define-key map [vc-ignore]
-      '(menu-item "Ignore File..." vc-ignore
+      '(menu-item "Ignore File..." vc-ignore-file
 		  :help "Ignore a file under current version control system"))
+    (bindings--define-key vc-menu-map [vc-ignore-pattern]
+      '(menu-item "Ignore Pattern..." vc-ignore-pattern
+                  :help "Ignore a pattern under current version control system"))
     (bindings--define-key map [vc-dir]
       '(menu-item "VC Dir"  vc-dir
 		  :help "Show the VC status of files in a directory"))
diff --git a/lisp/vc/vc-mtn.el b/lisp/vc/vc-mtn.el
index 092d8b5..af42d3f 100644
--- a/lisp/vc/vc-mtn.el
+++ b/lisp/vc/vc-mtn.el
@@ -106,6 +106,14 @@ switches."
   "Return the mtn ignore file that controls FILE."
   (expand-file-name ".mtnignore" (vc-mtn-root file)))

+(defvar vc-mtn-ignore-param-regexp
+  '(:escape: vc-py-regexp-quote :anchor: "^" :trailer: "$" :dir-trailer: "/")
+  "Ignore parameters for Mtn anchored regular expressions.")
+
+(defun vc-mtn-ignore-param (&optional _ignore-file)
+  "Appropriate Mtn ignore parameters for IGNORE-FILE."
+  vc-mtn-ignore-param-regexp)
+
 (defun vc-mtn-registered (file)
   (let ((root (vc-mtn-root file)))
     (when root
diff --git a/lisp/vc/vc-src.el b/lisp/vc/vc-src.el
index db127ee..cd9f032 100644
--- a/lisp/vc/vc-src.el
+++ b/lisp/vc/vc-src.el
@@ -310,6 +310,32 @@ If LIMIT is non-nil, show no more than this many entries."
   "Rename file from OLD to NEW using `src mv'."
   (vc-src-command nil 0 new "mv" old))

+(defun vc-src-find-ignore-file (file)
+  "Return the ignore file for FILE."
+  (expand-file-name ".srcignore" (if file (file-name-directory file))))
+
+(defun vc-src-glob-escape (string)
+  "Escape special glob characters in STRING."
+  (save-match-data
+    (if (string-match "[?*[]" string)
+        (mapconcat (lambda (c)
+                     (pcase c
+                       (?? "[?]")
+                       (?* "[*]")
+                       (?\[ "[[]")
+                       (_ (char-to-string c))))
+                   string "")
+      string)))
+;; (vc-src-glob-escape "full[glo]?\\b*")
+
+(defvar vc-src-ignore-param-glob
+  '(:escape: vc-src-glob-escape :anchor: "" :trailer: "" :dir-trailer: "")
+  "Ignore parameters for SRC unanchored glob wildcards.")
+
+(defun vc-src-ignore-param (&optional _ignore-file)
+  "Appropriate SRC ignore parameters for IGNORE-FILE."
+  vc-src-ignore-param-glob)
+
 (provide 'vc-src)

 ;;; vc-src.el ends here
diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el
index d039bf3..9d35b75 100644
--- a/lisp/vc/vc-svn.el
+++ b/lisp/vc/vc-svn.el
@@ -352,17 +352,25 @@ to the SVN command."
 		(concat "-r" rev))
 	   (vc-switches 'SVN 'checkout))))

-(defun vc-svn-ignore (file &optional directory remove)
-  "Ignore FILE under Subversion.
-FILE is a wildcard specification, either relative to
-DIRECTORY or absolute."
-  (let* ((path (directory-file-name (expand-file-name file directory)))
-         (directory (file-name-directory path))
-         (file (file-name-nondirectory path))
+(defun vc-svn-find-ignore-file (file)
+  "Return the virtual ignore file for FILE."
+  (expand-file-name ".svnignore" (if file (file-name-directory file))))
+
+(defvar vc-svn-ignore-param-glob
+  '(:escape: vc-glob-escape :anchor: "" :trailer: "" :dir-trailer: "")
+  "Ignore parameters for SVN unanchored glob wildcards.")
+
+(defun vc-svn-ignore-param (&optional _ignore-file)
+  "Appropriate SVN ignore parameters for IGNORE-FILE."
+  vc-svn-ignore-param-glob)
+
+(defun vc-svn-modify-ignores (pattern ignore-file remove)
+  ;; implements ‘vc-default-modify-ignores’ for SVN
+  (let* ((directory (file-name-directory ignore-file))
          (ignores (vc-svn-ignore-completion-table directory))
          (ignores (if remove
-                      (delete file ignores)
-                    (push file ignores))))
+                      (delete pattern ignores)
+                    (push pattern ignores))))
     (vc-svn-command nil 0 nil nil "propset" "svn:ignore"
                     (mapconcat #'identity ignores "\n")
                     directory)))
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index ec252b7..d3e5537 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -1392,54 +1392,262 @@ first backend that could register the file is used."
   (let ((vc-handled-backends (list backend)))
     (call-interactively 'vc-register)))

-(defun vc-ignore (file &optional directory remove)
-  "Ignore FILE under the VCS of DIRECTORY.
-
-Normally, FILE is a wildcard specification that matches the files
-to be ignored.  When REMOVE is non-nil, remove FILE from the list
-of ignored files.
+(defvar vc-ignore-param-none
+  '(:escape: identity :anchor: "" :trailer: "" :dir-trailer: "")
+  "Property list of ignore parameters for plain strings.
+
+All properties are optional.
+
+Property :escape: is a function that takes a pattern string as parameter
+and returns an escaped pattern (default is ‘identity’).
+
+Property :anchor: is a string that is prepended to the ignore
+pattern (default is an empty string).
+
+Property :trailer: is a string that is appended to non-directory
+ignore patterns (default is an empty string).
+
+Property :dir-trailer: is a string that is appended to directory
+ignore patterns (default is an empty string).")
+
+(defvar vc-ignore-param-glob
+  '(:escape: vc-glob-escape :anchor: "" :trailer: "" :dir-trailer: "")
+  "Ignore parameters for unanchored glob wildcards.")
+
+(defvar vc-ignore-param-glob-anchored
+  '(:escape: vc-glob-escape :anchor: "/" :trailer: "" :dir-trailer: "/")
+  "Ignore parameters for anchored glob wildcards.")
+
+(defvar vc-ignore-param-regexp
+  '(:escape: regexp-quote :anchor: "^" :trailer: "$" :dir-trailer: "/")
+  "Ignore parameters for anchored regular expressions.")
+
+(defun vc-default-ignore-param (_backend &optional _ignore-file)
+  "Default ignore parameters for IGNORE-FILE."
+  vc-ignore-param-glob)
+
+(defun vc-glob-escape (string)
+  "Escape special glob characters in STRING."
+  (save-match-data
+    (if (string-match "[\\?*[]" string)
+        (mapconcat (lambda (c)
+                     (pcase c
+                       (?\\ "\\\\")
+                       (?? "\\?")
+                       (?* "\\*")
+                       (?\[ "\\[")
+                       (_ (char-to-string c))))
+                   string "")
+      string)))
+
+(defvar vc--py-regexp-special-chars
+  (mapcar
+   (function
+    (lambda (c)
+      (cons c (concat "\\" (char-to-string c)))))
+   (append "()[]{}?*+-|^$\\.&~# \t\n\r\v\f" nil))
+  "Characters that have special meaning in Python regular expressions.")
+
+(defun vc-py-regexp-quote (string)
+  "Python regexp to match exactly STRING and nothing else.
+Ported from Python v3.7"
+  (mapconcat
+   (function
+    (lambda (c)
+      (or (cdr (assq c vc--py-regexp-special-chars))
+          (char-to-string c))))
+   string ""))
+
+(defun vc-ignore-pattern (pattern &optional directory remove)
+  "Ignore PATTERN under VCS of DIRECTORY.

 DIRECTORY defaults to `default-directory' and is used to
 determine the responsible VC backend.

-When called interactively, prompt for a FILE to ignore, unless a
-prefix argument is given, in which case prompt for a file FILE to
-remove from the list of ignored files."
+PATTERN is an expression following the rules of the backend
+pattern syntax, matching the files to be ignored.  When REMOVE is
+non-nil, remove PATTERN from the list of ignored files.
+
+When called interactively, prompt for a PATTERN to ignore, unless
+a prefix argument is given, in which case prompt for a PATTERN to
+remove from the list of ignored files offering currently defined
+patterns for completion."
   (interactive
    (list
     (if (not current-prefix-arg)
-        (read-file-name "File to ignore: ")
+        (read-string "Pattern to ignore: ")
       (completing-read
-       "File to remove: "
+       "Pattern to remove: "
        (vc-call-backend
         (or (vc-responsible-backend default-directory)
             (error "Unknown backend"))
         'ignore-completion-table default-directory)))
     nil current-prefix-arg))
-  (let* ((directory (or directory default-directory))
-	 (backend (or (vc-responsible-backend default-directory)
-                      (error "Unknown backend"))))
-    (vc-call-backend backend 'ignore file directory remove)))
-
-(defun vc-default-ignore (backend file &optional directory remove)
-  "Ignore FILE under the VCS of DIRECTORY (default is `default-directory').
-FILE is a wildcard specification, either relative to
-DIRECTORY or absolute.
-When called from Lisp code, if DIRECTORY is non-nil, the
-repository to use will be deduced by DIRECTORY; if REMOVE is
-non-nil, remove FILE from ignored files.
-Argument BACKEND is the backend you are using."
-  (let ((ignore
-	 (vc-call-backend backend 'find-ignore-file (or directory default-directory)))
-	file-path root-dir 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)))
-    (if remove
-	(vc--remove-regexp (concat "^" (regexp-quote pattern ) "\\(\n\\|$\\)") ignore)
-      (vc--add-line pattern ignore))))
+  (vc-ignore pattern directory remove t))
+
+(defun vc-ignore-file (file &optional directory remove)
+  "Ignore FILE under VCS of DIRECTORY.
+
+DIRECTORY defaults to `default-directory' and is used to
+determine the responsible VC backend.
+
+If FILE is nil, ‘vc-ignore-fileset’ is called.
+
+Otherwise, FILE is a file path that must be escaped and anchored.
+The directory name of FILE expanded against DIRECTORY is used to
+determine the ignore file.  The effective pattern consists of the
+file path relative to the directory of the ignore file, properly
+escaped and anchored by the VC backend.
+
+The effective pattern is added to the list of ignored files,
+unless REMOVE is non-nil, in which case it is removed.
+
+When called interactively and the mode is neither ‘vc-dir-mode’
+nor ‘dired-mode’, prompt for a FILE to ignore, unless a prefix
+argument is given, in which case prompt for a FILE to remove from
+the list of ignored files."
+  (interactive
+   (list
+    (unless (or (derived-mode-p 'vc-dir-mode) (derived-mode-p 'dired-mode))
+      (read-file-name
+       (concat "File to "
+               (if (not current-prefix-arg) "ignore" "remove") ": ")))
+    nil current-prefix-arg))
+  (if file
+      (vc-ignore file directory remove nil)
+    (vc-ignore-fileset nil remove)))
+
+(defun vc-ignore-fileset (&optional vc-fileset remove)
+  "Ignore file set under a version control system..
+
+If VC-FILESET is not given, it is deduced with
+‘vc-deduce-fileset’.
+
+When REMOVE is non-nil (prefix arg, if interactive), remove the
+files from the list of ignored files."
+  (interactive (list nil current-prefix-arg))
+  (let* ((fileset-arg (or vc-fileset (vc-deduce-fileset t t)))
+         (backend (car fileset-arg))
+         (files (delq nil (nth 1 fileset-arg))))
+    (when files
+      (message "Ignoring %s... " files)
+      (mapc
+       (lambda (file)
+         (vc-call-backend backend 'ignore file nil remove nil)
+         (vc-dir-resynch-file file))
+       files))
+    (when (derived-mode-p 'vc-dir-mode)
+      (vc-dir-move-to-goal-column))
+    (when files (message "Ignoring %s... done" files))))
+
+(defun vc-ignore (file-or-pattern &optional directory remove as-is)
+  "Ignore FILE-OR-PATTERN under VCS of DIRECTORY.
+
+DIRECTORY defaults to `default-directory' and is used to
+determine the responsible VC backend.
+
+When REMOVE is non-nil, remove FILE-OR-PATTERN from the list of
+ignored files.
+
+If AS-IS is nil, FILE-OR-PATTERN is considered a file path that
+must be escaped and anchored.  The directory name of
+FILE-OR-PATTERN expanded against DIRECTORY is used to determine
+the ignore file.  The effective pattern consists of the file path
+relative to the directory of the ignore file, properly escaped
+and anchored by the VC backend.
+
+If AS-IS is non-nil, FILE-OR-PATTERN is considered a pattern that
+should not be modified.  DIRECTORY is used to determine the
+ignore file."
+  (setq directory (or directory default-directory))
+  (vc-call-backend (or (vc-responsible-backend directory)
+                       (error "Unknown backend"))
+                   'ignore file-or-pattern directory remove as-is))
+
+(defun vc-default-ignore (backend file-or-pattern &optional directory remove as-is)
+  ;; implements ‘vc-ignore’ generically
+  (apply #'vc-call-backend backend 'modify-ignores
+         (vc-call-backend backend 'get-ignore-file-and-pattern
+                          file-or-pattern directory as-is remove)))
+
+(defun vc-default-get-ignore-file-and-pattern (backend file-or-pattern &optional directory as-is remove)
+  "Determine ignore file and pattern for BACKEND from FILE-OR-PATTERN.
+Implements API of ‘vc-ignore’ for FILE-OR-PATTERN, DIRECTORY and AS-IS.
+REMOVE is passed through without evaluation.
+Returns (pattern ignore-file remove) suitable for calling
+‘vc-default-modify-ignores’."
+
+  (setq directory (or directory default-directory))
+  (when (not as-is)
+    (setq file-or-pattern (expand-file-name file-or-pattern directory))
+    ;; apply directory-as-file-name, otherwise, if file-or-pattern was
+    ;; a sub-repository, find-ignore-file would return the wrong
+    ;; ignore file:
+    ;; (vc-cvs-find-ignore-file "/re/po/dir/") => /re/po/dir/.cvsignore
+    ;; (vc-cvs-find-ignore-file "/re/po/dir") => /re/po/.cvsignore
+    (setq directory (file-name-directory (vc-no-final-slash file-or-pattern))))
+
+  (let* ((ignore-file (vc-call-backend backend 'find-ignore-file directory))
+         (ignore-dir (file-name-directory ignore-file))
+         is-dir ignore-param pattern)
+    (if as-is
+        (setq ignore-param vc-ignore-param-none)
+      (when (not (string= (substring file-or-pattern 0 (length ignore-dir))
+                          ignore-dir))
+        (error "Ignore spec %s is not below project root %s"
+               file-or-pattern ignore-dir))
+      ;; directory may not yet exist
+      (setq is-dir (or (file-directory-p file-or-pattern)
+                       (vc-has-final-slash file-or-pattern)))
+      (setq file-or-pattern (vc-no-final-slash
+                             (substring file-or-pattern (length ignore-dir))))
+      (setq ignore-param (vc-call-backend backend 'ignore-param ignore-file)))
+
+    (setq pattern
+          (concat
+           (plist-get ignore-param :anchor:)
+           (funcall (or (plist-get ignore-param :escape:) #'identity)
+                    file-or-pattern)
+           (or (and is-dir (plist-get ignore-param :dir-trailer:))
+               (plist-get ignore-param :trailer:))))
+    (list pattern ignore-file remove)))
+
+(defun vc-default-modify-ignores (_backend pattern ignore-file remove)
+  "Add PATTERN to IGNORE-FILE, if REMOVE is nil..
+Otherwise remove PATTERN from IGNORE-FILE."
+  (if remove
+      (vc--remove-regexp
+       (concat "^" (regexp-quote pattern) "\\(\n\\|$\\)") ignore-file)
+    (vc--add-line pattern ignore-file)))
+
+(defun vc-file-name-directory (file &optional dir dir-as-file)
+  "Get directory name for FILE.
+FILE is expanded against DIR.  If FILE is a directory and DIR-AS-FILE
+is non-nil, its parent directory is returned."
+  (and file
+       (let* ((path (expand-file-name file dir)))
+         (file-name-directory
+          (if dir-as-file
+              (vc-no-final-slash path)
+            path)))))
+
+(defun vc-file-relative-name (file &optional dir dir-is-empty)
+  "Get relative file name for FILE against DIR.
+If FILE is a directory and DIR-IS-EMPTY is non-nil, nil is returned.
+Otherwise, if FILE is a directory, the final slash is removed."
+  (and (not (and dir-is-empty (file-directory-p file)))
+       (vc-no-final-slash (file-relative-name file dir))))
+
+(defun vc-no-final-slash (s)
+  "Remove optional final slash from string S."
+  ;; based on ‘ido-no-final-slash’
+  (let ((l (vc-has-final-slash s)))
+    (if l (substring s 0 l) s)))
+
+(defun vc-has-final-slash (s)
+  ;"Return index of final slash in string S or nil."
+  (let ((l (1- (length s))))
+    (and (> l 0) (eq (aref s l) ?/) l)))

 (defun vc-default-ignore-completion-table (backend file)
   "Return the list of ignored files under BACKEND."
--
2.7.4


      parent reply	other threads:[~2020-02-09 21:06 UTC|newest]

Thread overview: 66+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2019-08-26  0:21 bug#37189: 25.4.1: vc-hg-ignore implementation is missing Wolfgang Scherer
     [not found] ` <handler.37189.B.15667808855126.ack@debbugs.gnu.org>
2019-08-26 23:25   ` bug#37189: Acknowledgement (25.4.1: vc-hg-ignore implementation is missing) Wolfgang Scherer
2019-08-27  7:45     ` Eli Zaretskii
2019-08-28  1:46       ` bug#37189: *** GMX Spamverdacht *** " Wolfgang Scherer
2019-08-28  6:16         ` Eli Zaretskii
2019-08-29  1:23           ` bug#37189: 25.4.1: vc-hg-ignore implementation is missing Wolfgang Scherer
2019-08-29  0:38         ` Wolfgang Scherer
2019-08-29 15:52           ` Wolfgang Scherer
2019-12-25  0:16             ` Dmitry Gutov
2020-01-05  3:46               ` Wolfgang Scherer
2020-01-05  8:58                 ` Andreas Schwab
2020-01-05 17:25                   ` Wolfgang Scherer
2020-01-14  1:14                 ` Dmitry Gutov
2020-02-01  1:20                   ` Wolfgang Scherer
2020-02-01  8:27                     ` Eli Zaretskii
2020-02-03  1:16                       ` Wolfgang Scherer
2020-02-04 18:55                         ` Eli Zaretskii
2020-02-05  5:18                           ` Wolfgang Scherer
2020-02-05 19:06                           ` Wolfgang Scherer
2020-02-07  9:57                             ` Eli Zaretskii
2020-02-08  9:57                               ` Dmitry Gutov
2020-02-08 19:45                                 ` Wolfgang Scherer
2020-02-08 20:05                                   ` Eli Zaretskii
2020-02-08 23:12                                     ` Wolfgang Scherer
2020-02-09 13:57                                       ` Wolfgang Scherer
2020-02-10 16:02                                         ` Eli Zaretskii
2020-02-11  1:45                                           ` Wolfgang Scherer
2020-02-11 17:32                                             ` Eli Zaretskii
2020-02-11 22:28                                               ` Wolfgang Scherer
2020-02-12 18:34                                                 ` Eli Zaretskii
     [not found]                                                   ` <6f3ba261-e1f9-cf19-cc22-ec8c24cf3298@gmx.de>
2020-02-12 23:20                                                     ` Wolfgang Scherer
2020-02-13  1:18                                                       ` Wolfgang Scherer
2020-02-13 15:09                                                         ` Eli Zaretskii
2020-02-13 16:30                                                           ` Wolfgang Scherer
2020-02-13 23:43                                                           ` Richard Stallman
2020-02-14  1:49                                                             ` Wolfgang Scherer
2020-02-16  2:29                                                               ` Richard Stallman
2020-02-13 15:21                                                         ` Eli Zaretskii
2020-02-13 23:40                                                           ` Dmitry Gutov
2020-02-14  9:23                                                             ` Eli Zaretskii
2020-02-21  0:05                                                               ` Dmitry Gutov
2020-02-21  8:10                                                                 ` Eli Zaretskii
2020-02-21 22:22                                                                 ` Wolfgang Scherer
2020-02-22  7:44                                                                   ` Eli Zaretskii
2020-02-22 13:46                                                                     ` Wolfgang Scherer
2020-02-22 14:30                                                                       ` Eli Zaretskii
2020-02-22 19:14                                                                         ` Dmitry Gutov
2020-02-22 22:04                                                                           ` Wolfgang Scherer
2020-02-22 23:32                                                                         ` Wolfgang Scherer
2020-02-23 15:20                                                                           ` Eli Zaretskii
2020-02-23 19:16                                                                             ` Wolfgang Scherer
2020-02-22 19:30                                                                   ` Dmitry Gutov
2020-02-22 22:00                                                                     ` Wolfgang Scherer
2020-02-22 23:58                                                                       ` Dmitry Gutov
2020-02-23  0:29                                                                         ` Wolfgang Scherer
2020-02-24 23:07                                                                           ` Dmitry Gutov
2020-02-25  2:22                                                                             ` Wolfgang Scherer
2020-03-19 23:42                                                                               ` Dmitry Gutov
2020-07-03 20:53                                                                                 ` Wolfgang Scherer
2020-07-03 21:49                                                                                   ` Dmitry Gutov
2020-02-12 17:23                                               ` Wolfgang Scherer
2020-02-09 13:57                                       ` Wolfgang Scherer
2020-02-09 13:57                                       ` Wolfgang Scherer
2020-02-09 14:07                                         ` Wolfgang Scherer
2020-02-08 23:59                                     ` Wolfgang Scherer
2020-02-09 21:06                               ` Wolfgang Scherer [this message]

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=6f6fe037-056c-67cf-58d3-17bce36f8f03@gmx.de \
    --to=wolfgang.scherer@gmx.de \
    --cc=37189@debbugs.gnu.org \
    --cc=dgutov@yandex.ru \
    --cc=eliz@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).