From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Juri Linkov Newsgroups: gmane.emacs.bugs Subject: bug#10181: 24.0.92; [wishlist] split `diff-refine-change' in several faces Date: Wed, 23 May 2012 03:36:18 +0300 Organization: JURTA Message-ID: <878vgj7k6l.fsf@mail.jurta.org> References: <87txzftzn0.fsf@mail.jurta.org> <87396yxr9u.fsf@mail.jurta.org> <87d361w2ea.fsf@mail.jurta.org> <87aa13k9o1.fsf@mail.jurta.org> <87k406uz7n.fsf@mail.jurta.org> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: dough.gmane.org 1337737173 30614 80.91.229.3 (23 May 2012 01:39:33 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Wed, 23 May 2012 01:39:33 +0000 (UTC) Cc: 10181@debbugs.gnu.org To: Stefan Monnier Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Wed May 23 03:39:31 2012 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1SX0Xu-0008L9-GJ for geb-bug-gnu-emacs@m.gmane.org; Wed, 23 May 2012 03:39:26 +0200 Original-Received: from localhost ([::1]:54105 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1SX0Xt-0003Up-ON for geb-bug-gnu-emacs@m.gmane.org; Tue, 22 May 2012 21:39:25 -0400 Original-Received: from eggs.gnu.org ([208.118.235.92]:54306) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1SX0Xn-0003Tw-18 for bug-gnu-emacs@gnu.org; Tue, 22 May 2012 21:39:23 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1SX0Xk-0004o2-37 for bug-gnu-emacs@gnu.org; Tue, 22 May 2012 21:39:18 -0400 Original-Received: from debbugs.gnu.org ([140.186.70.43]:58233) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1SX0Xj-0004nx-V4 for bug-gnu-emacs@gnu.org; Tue, 22 May 2012 21:39:15 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.72) (envelope-from ) id 1SX0YT-00039s-LM for bug-gnu-emacs@gnu.org; Tue, 22 May 2012 21:40:01 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Juri Linkov Original-Sender: debbugs-submit-bounces@debbugs.gnu.org Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Wed, 23 May 2012 01:40:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 10181 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: Original-Received: via spool by 10181-submit@debbugs.gnu.org id=B10181.133773719912128 (code B ref 10181); Wed, 23 May 2012 01:40:01 +0000 Original-Received: (at 10181) by debbugs.gnu.org; 23 May 2012 01:39:59 +0000 Original-Received: from localhost ([127.0.0.1]:39546 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.72) (envelope-from ) id 1SX0YQ-00039Y-8A for submit@debbugs.gnu.org; Tue, 22 May 2012 21:39:59 -0400 Original-Received: from ps18281.dreamhost.com ([69.163.218.105]:49004 helo=ps18281.dreamhostps.com) by debbugs.gnu.org with esmtp (Exim 4.72) (envelope-from ) id 1SX0Y0-000392-S4 for 10181@debbugs.gnu.org; Tue, 22 May 2012 21:39:56 -0400 Original-Received: from localhost (ps18281.dreamhostps.com [69.163.218.105]) by ps18281.dreamhostps.com (Postfix) with ESMTP id 067EB451C951; Tue, 22 May 2012 18:38:43 -0700 (PDT) In-Reply-To: (Stefan Monnier's message of "Sun, 20 May 2012 21:45:54 -0400") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.1.50 (x86_64-pc-linux-gnu) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.13 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6 (newer, 2) X-Received-From: 140.186.70.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.bugs:60291 Archived-At: > Please move the :inherit to a `default' clause instead of copying it > into each one of the clauses. Fixed in the patch below. >> + (if (not (or (face-equal diff-changed-face diff-added-face) >> + (face-equal diff-changed-face diff-removed-face))) > > Please introduce a defvar for it, so we don't re-evaluate the face > comparison for each and every line. This defvar needs to be re-evaluated when the user customized faces. Since faces are used by font-lock, a good place to re-evaluate the value of this defvar before font-lock starts is in the function `diff-mode'. > And while I'm OK with not implementing the changed-added-remove scheme > for refinement yet, I think that if we change the API of > smerge-refine-subst for the added-removed case, we should make sure the > API won't need to be changed yet again if/when we add the > changed-added-removed scheme. The following patch implements the API for all possible cases: === modified file 'lisp/vc/diff-mode.el' --- lisp/vc/diff-mode.el 2012-05-01 02:48:41 +0000 +++ lisp/vc/diff-mode.el 2012-05-23 00:31:05 +0000 @@ -277,14 +275,28 @@ (define-obsolete-face-alias 'diff-hunk-h (defvar diff-hunk-header-face 'diff-hunk-header) (defface diff-removed - '((t :inherit diff-changed)) + '((default + :inherit diff-changed) + (((class color) (min-colors 88)) + :background "#ffdddd") + (((class color)) + :foreground "red" + :weight normal + :slant normal)) "`diff-mode' face used to highlight removed lines." :group 'diff-mode) (define-obsolete-face-alias 'diff-removed-face 'diff-removed "22.1") (defvar diff-removed-face 'diff-removed) (defface diff-added - '((t :inherit diff-changed)) + '((default + :inherit diff-changed) + (((class color) (min-colors 88)) + :background "#ddffdd") + (((class color)) + :foreground "green" + :weight normal + :slant normal)) "`diff-mode' face used to highlight added lines." :group 'diff-mode) (define-obsolete-face-alias 'diff-added-face 'diff-added "22.1") @@ -374,6 +386,8 @@ (defconst diff-hunk-header-re-unified (defconst diff-context-mid-hunk-header-re "--- \\([0-9]+\\)\\(?:,\\([0-9]+\\)\\)? ----$") +(defvar diff-use-changed-face nil) + (defvar diff-font-lock-keywords `((,(concat "\\(" diff-hunk-header-re-unified "\\)\\(.*\\)$") (1 diff-hunk-header-face) (6 diff-function-face)) @@ -393,7 +407,17 @@ (defvar diff-font-lock-keywords ("^\\([+>]\\)\\(.*\n\\)" (1 diff-indicator-added-face) (2 diff-added-face)) ("^\\(!\\)\\(.*\n\\)" - (1 diff-indicator-changed-face) (2 diff-changed-face)) + (1 diff-indicator-changed-face) + (2 + (if diff-use-changed-face + diff-changed-face + ;; Otherwise, search for `diff-context-mid-hunk-header-re' and + ;; if the line of context diff is above, use `diff-removed-face'; + ;; if below, use `diff-added-face'. + (let ((limit (save-excursion (diff-beginning-of-hunk)))) + (if (save-excursion (re-search-backward diff-context-mid-hunk-header-re limit t)) + diff-added-face + diff-removed-face))))) ("^\\(?:Index\\|revno\\): \\(.+\\).*\n" (0 diff-header-face) (1 diff-index-face prepend)) ("^Only in .*\n" . diff-nonexistent-face) @@ -1281,6 +1305,11 @@ (define-derived-mode diff-mode fundament \\{diff-mode-map}" (set (make-local-variable 'font-lock-defaults) diff-font-lock-defaults) + (set (make-local-variable 'diff-use-changed-face) + (and (face-differs-from-default-p diff-changed-face) + (not (face-equal diff-changed-face diff-added-face)) + (not (face-equal diff-changed-face diff-removed-face)))) + (set (make-local-variable 'outline-regexp) diff-outline-regexp) (set (make-local-variable 'imenu-generic-expression) diff-imenu-generic-expression) @@ -1866,6 +1895,28 @@ (defface diff-refine-change "Face used for char-based changes shown by `diff-refine-hunk'." :group 'diff-mode) +(defface diff-refine-removed + '((default + :inherit diff-refine-change) + (((class color) (min-colors 88)) + :background "#ffaaaa") + (((class color)) + :background "red")) + "Face used for removed characters shown by `diff-refine-hunk'." + :group 'diff-mode + :version "24.2") + +(defface diff-refine-added + '((default + :inherit diff-refine-change) + (((class color) (min-colors 88)) + :background "#aaffaa") + (((class color)) + :background "green")) + "Face used for added characters shown by `diff-refine-hunk'." + :group 'diff-mode + :version "24.2") + (defun diff-refine-preproc () (while (re-search-forward "^[+>]" nil t) ;; Remove spurious changes due to the fact that one side of the hunk is @@ -1879,7 +1930,7 @@ (defun diff-refine-preproc () ) (declare-function smerge-refine-subst "smerge-mode" - (beg1 end1 beg2 end2 props &optional preproc)) + (beg1 end1 beg2 end2 props-c &optional preproc props-r props-a)) (defun diff-refine-hunk () "Highlight changes of hunk at point at a finer granularity." @@ -1890,7 +1941,9 @@ (defun diff-refine-hunk () (let* ((start (point)) (style (diff-hunk-style)) ;Skips the hunk header as well. (beg (point)) - (props '((diff-mode . fine) (face diff-refine-change))) + (props-c '((diff-mode . fine) (face diff-refine-change))) + (props-r '((diff-mode . fine) (face diff-refine-removed))) + (props-a '((diff-mode . fine) (face diff-refine-added))) ;; Be careful to go back to `start' so diff-end-of-hunk gets ;; to read the hunk header's line info. (end (progn (goto-char start) (diff-end-of-hunk) (point)))) @@ -1904,7 +1957,7 @@ (defun diff-refine-hunk () end t) (smerge-refine-subst (match-beginning 0) (match-end 1) (match-end 1) (match-end 0) - props 'diff-refine-preproc))) + nil 'diff-refine-preproc props-r props-a))) (context (let* ((middle (save-excursion (re-search-forward "^---"))) (other middle)) @@ -1916,14 +1969,17 @@ (defun diff-refine-hunk () (setq other (match-end 0)) (match-beginning 0)) other - props 'diff-refine-preproc)))) + (if diff-use-changed-face props-c) + 'diff-refine-preproc + (unless diff-use-changed-face props-r) + (unless diff-use-changed-face props-a))))) (t ;; Normal diffs. (let ((beg1 (1+ (point)))) (when (re-search-forward "^---.*\n" end t) ;; It's a combined add&remove, so there's something to do. (smerge-refine-subst beg1 (match-beginning 0) (match-end 0) end - props 'diff-refine-preproc)))))))) + nil 'diff-refine-preproc props-r props-a)))))))) (defun diff-undo (&optional arg) "Perform `undo', ignoring the buffer's read-only status." === modified file 'lisp/vc/smerge-mode.el' --- lisp/vc/smerge-mode.el 2012-05-04 23:16:47 +0000 +++ lisp/vc/smerge-mode.el 2012-05-23 00:34:09 +0000 @@ -128,6 +128,28 @@ (defface smerge-refined-change "Face used for char-based changes shown by `smerge-refine'." :group 'smerge) +(defface smerge-refined-removed + '((default + :inherit smerge-refined-change) + (((class color) (min-colors 88)) + :background "#ffaaaa") + (((class color)) + :background "red")) + "Face used for removed characters shown by `smerge-refine'." + :group 'smerge + :version "24.2") + +(defface smerge-refined-added + '((default + :inherit smerge-refined-change) + (((class color) (min-colors 88)) + :background "#aaffaa") + (((class color)) + :background "green")) + "Face used for added characters shown by `smerge-refine'." + :group 'smerge + :version "24.2") + (easy-mmode-defmap smerge-basic-map `(("n" . smerge-next) ("p" . smerge-prev) @@ -980,9 +1002,17 @@ (defun smerge-refine-highlight-change (b (dolist (x props) (overlay-put ol (car x) (cdr x))) ol))))) -(defun smerge-refine-subst (beg1 end1 beg2 end2 props &optional preproc) +(defun smerge-refine-subst (beg1 end1 beg2 end2 props-c &optional preproc props-r props-a) "Show fine differences in the two regions BEG1..END1 and BEG2..END2. -PROPS is an alist of properties to put (via overlays) on the changes. +PROPS-C is an alist of properties to put (via overlays) on the changes. +PROPS-R is an alist of properties to put on removed characters. +PROPS-A is an alist of properties to put on added characters. +If PROPS-R and PROPS-A are nil, put PROPS-C on all changes. +If PROPS-C is nil, but PROPS-R and PROPS-A are non-nil, +put PROPS-A on added characters, PROPS-R on removed characters. +If PROPS-C, PROPS-R and PROPS-A are non-nil, put PROPS-C on changes characters, +PROPS-A on added characters, PROPS-R on removed characters. + If non-nil, PREPROC is called with no argument in a buffer that contains a copy of a region, just before preparing it to for `diff'. It can be used to replace chars to try and eliminate some spurious differences." @@ -1026,10 +1056,18 @@ (defun smerge-refine-subst (beg1 end1 be (m5 (match-string 5))) (when (memq op '(?d ?c)) (setq last1 - (smerge-refine-highlight-change buf beg1 m1 m2 props))) + (smerge-refine-highlight-change + buf beg1 m1 m2 + ;; Try to use props-c only for changed chars, + ;; fallback to props-r for changed/removed chars, + ;; but if props-r is nil then fallback to props-c. + (or (and (eq op '?c) props-c) props-r props-c)))) (when (memq op '(?a ?c)) (setq last2 - (smerge-refine-highlight-change buf beg2 m4 m5 props)))) + (smerge-refine-highlight-change + buf beg2 m4 m5 + ;; Same logic as for removed chars above. + (or (and (eq op '?c) props-c) props-a props-c))))) (forward-line 1) ;Skip hunk header. (and (re-search-forward "^[0-9]" nil 'move) ;Skip hunk body. (goto-char (match-beginning 0)))) @@ -1081,7 +1119,11 @@ (defun smerge-refine (&optional part) ((eq (match-end 3) (match-beginning 3)) 3) (t 2))) (let ((n1 (if (eq part 1) 2 1)) - (n2 (if (eq part 3) 2 3))) + (n2 (if (eq part 3) 2 3)) + (smerge-use-changed-face + (and (face-differs-from-default-p 'smerge-refined-change) + (not (face-equal 'smerge-refined-change 'smerge-refined-added)) + (not (face-equal 'smerge-refined-change 'smerge-refined-removed))))) (smerge-ensure-match n1) (smerge-ensure-match n2) (with-silent-modifications @@ -1090,8 +1132,13 @@ (defun smerge-refine (&optional part) (cons (buffer-chars-modified-tick) part))) (smerge-refine-subst (match-beginning n1) (match-end n1) (match-beginning n2) (match-end n2) - '((smerge . refine) - (face . smerge-refined-change))))) + (if smerge-use-changed-face + '((smerge . refine) (face . smerge-refined-change))) + nil + (unless smerge-use-changed-face + '((smerge . refine) (face . smerge-refined-removed))) + (unless smerge-use-changed-face + '((smerge . refine) (face . smerge-refined-added)))))) (defun smerge-diff (n1 n2) (smerge-match-conflict)