From 81672e2909bca4ea4299301bbf4450e392b3a4f8 Mon Sep 17 00:00:00 2001 From: Wolfgang Scherer 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 - ("^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 + ("^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