From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Jambunathan K Newsgroups: gmane.emacs.bugs Subject: bug#11095: [PATCH] Re: bug#11095: 24.0.94; hi-lock-face-buffer/unhighlight-regexp': Augment? Date: Thu, 06 Dec 2012 20:20:16 +0530 Message-ID: <87fw3j9qvr.fsf@gmail.com> References: <81d37z271c.fsf@gmail.com> <87626i2i4r.fsf@gmail.com> <87zk1r3h3b.fsf@gmail.com> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1354805296 5883 80.91.229.3 (6 Dec 2012 14:48:16 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Thu, 6 Dec 2012 14:48:16 +0000 (UTC) Cc: 11095@debbugs.gnu.org To: Stefan Monnier Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Thu Dec 06 15:48:27 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 1TgckS-000221-8i for geb-bug-gnu-emacs@m.gmane.org; Thu, 06 Dec 2012 15:48:24 +0100 Original-Received: from localhost ([::1]:46771 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1TgckG-0007vL-9b for geb-bug-gnu-emacs@m.gmane.org; Thu, 06 Dec 2012 09:48:12 -0500 Original-Received: from eggs.gnu.org ([208.118.235.92]:57932) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Tgck6-0007sp-Va for bug-gnu-emacs@gnu.org; Thu, 06 Dec 2012 09:48:09 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1Tgcjt-0007SI-NQ for bug-gnu-emacs@gnu.org; Thu, 06 Dec 2012 09:48:02 -0500 Original-Received: from debbugs.gnu.org ([140.186.70.43]:46007) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Tgcjt-0007S7-J8 for bug-gnu-emacs@gnu.org; Thu, 06 Dec 2012 09:47:49 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.72) (envelope-from ) id 1Tgck5-0000Qc-Vk for bug-gnu-emacs@gnu.org; Thu, 06 Dec 2012 09:48:02 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Jambunathan K Original-Sender: debbugs-submit-bounces@debbugs.gnu.org Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Thu, 06 Dec 2012 14:48:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 11095 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 11095-submit@debbugs.gnu.org id=B11095.13548052731630 (code B ref 11095); Thu, 06 Dec 2012 14:48:01 +0000 Original-Received: (at 11095) by debbugs.gnu.org; 6 Dec 2012 14:47:53 +0000 Original-Received: from localhost ([127.0.0.1]:56258 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.72) (envelope-from ) id 1Tgcjv-0000QE-Dt for submit@debbugs.gnu.org; Thu, 06 Dec 2012 09:47:52 -0500 Original-Received: from mail-pa0-f44.google.com ([209.85.220.44]:59281) by debbugs.gnu.org with esmtp (Exim 4.72) (envelope-from ) id 1Tgcjh-0000Pq-QP for 11095@debbugs.gnu.org; Thu, 06 Dec 2012 09:47:49 -0500 Original-Received: by mail-pa0-f44.google.com with SMTP id hz11so4278228pad.3 for <11095@debbugs.gnu.org>; Thu, 06 Dec 2012 06:47:23 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; h=from:to:cc:subject:references:date:in-reply-to:message-id :user-agent:mime-version:content-type; bh=MtXkXxweSrRUS5o85PayheBTE42JDmlciyDs6l5jT3U=; b=KnNYLOAdjnTIAm7gA7sSGzM661RvMktP0OD7GT+BDIbYC72QF1NoqJ7MyQo283We8t GOaGo1GvCKm8U3aLGiaUV6uDuUwsAocxPn5/KFL41X5b+aFByfX5+S+bBNNR1ss3Q3Mf 14ESk44uG13Y6cw/+w3ZpqB9jg2Y/8serYqqWYEvtnAeB/vZ6WXbpiSeMJbRiGOiDw1o +XEy2sHWa2eGMY5Xcw0ZUIlRR4BbZR0s8oONua7veJjCeCw/BfTosp0b//DG/mkmksRm HaC6XQnAE8eo3+CraU6qOFGa4Xd07BpFcRHDJbZ9jkWxvUmm98ncYcaId1dN5F5bAAum W2zQ== Original-Received: by 10.68.232.200 with SMTP id tq8mr6591424pbc.52.1354805241700; Thu, 06 Dec 2012 06:47:21 -0800 (PST) Original-Received: from debian-6.05 ([115.184.38.95]) by mx.google.com with ESMTPS id ug6sm4906436pbc.4.2012.12.06.06.47.17 (version=TLSv1/SSLv3 cipher=OTHER); Thu, 06 Dec 2012 06:47:20 -0800 (PST) In-Reply-To: <87zk1r3h3b.fsf@gmail.com> (Jambunathan K.'s message of "Thu, 06 Dec 2012 10:36:00 +0530") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.3.50 (gnu/linux) 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.x 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:68028 Archived-At: --=-=-= Content-Type: text/plain Please review the attached patch. The patch exposes exposes a bug in defcustom and defvar-local which I will outline separately in a followup post (after another 2-3 hours). ps: I only wish you had tested unhighlighting part. It would have saved some re-working for me. --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=bug11095.patch Content-Description: bug11095.patch === modified file 'etc/NEWS' --- etc/NEWS 2012-12-04 17:07:09 +0000 +++ etc/NEWS 2012-12-06 14:44:01 +0000 @@ -74,6 +74,15 @@ when its arg ADJACENT is non-nil (when c it works like the utility `uniq'. Otherwise by default it deletes duplicate lines everywhere in the region without regard to adjacency. +** Various improvements to hi-lock.el +*** New user variables `hi-lock-faces' and `hi-lock-auto-select-face' +*** Highlighting commands (`hi-lock-face-buffer', `hi-lock-face-phrase-buffer' +and `hi-lock-line-face-buffer') now take a prefix argument which +temporarily inverts the meaning of `hi-lock-auto-select-face'. +*** Unhighlighting command (`hi-lock-unface-buffer') now un-highlights text at +point. When called interactively with C-u, removes all highlighting +in current buffer. + ** Tramp +++ *** New connection method "adb", which allows to access Android === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-12-06 09:15:27 +0000 +++ lisp/ChangeLog 2012-12-06 14:24:34 +0000 @@ -1,3 +1,18 @@ +2012-12-06 Jambunathan K + + * hi-lock.el (hi-lock-faces): New user variable. + (hi-lock--auto-select-face-defaults): Use `hi-lock-faces'. + (hi-lock-read-face-name): New optional param `toggle-auto-select'. + (hi-lock-line-face-buffer, hi-lock-face-buffer) + (hi-lock-face-phrase-buffer): Allow prefix argument to temporarily + toggle the value of `hi-lock-auto-select-face'. + (hi-lock--regexps-at-point, hi-lock-unface-buffer): Fix earlier + commit. + (hi-lock-set-pattern): Refuse to highlight a regexp that is + already highlighted. + + * faces.el (face-at-point): Fix bug (Bug#11095). + 2012-12-06 Michael Albinus * net/tramp.el (tramp-replace-environment-variables): Hide === modified file 'lisp/faces.el' --- lisp/faces.el 2012-11-25 04:50:20 +0000 +++ lisp/faces.el 2012-12-05 19:35:05 +0000 @@ -1884,6 +1884,7 @@ Return nil if it has no specified face." (get-char-property (point) 'face) 'default)) (face (cond ((symbolp faceprop) faceprop) + ((stringp faceprop) (intern-soft faceprop)) ;; List of faces (don't treat an attribute spec). ;; Just use the first face. ((and (consp faceprop) (not (keywordp (car faceprop))) === modified file 'lisp/hi-lock.el' --- lisp/hi-lock.el 2012-12-04 21:13:47 +0000 +++ lisp/hi-lock.el 2012-12-06 14:02:42 +0000 @@ -213,13 +213,27 @@ When non-nil, each hi-lock command will (define-obsolete-variable-alias 'hi-lock-face-history 'hi-lock-face-defaults "23.1") + (defvar hi-lock-face-defaults '("hi-yellow" "hi-pink" "hi-green" "hi-blue" "hi-black-b" "hi-blue-b" "hi-red-b" "hi-green-b" "hi-black-hb") "Default faces for hi-lock interactive functions.") +(defcustom hi-lock-faces + (or + (when (boundp 'hi-lock-face-defaults) + (mapcar + (lambda (face-name) (intern-soft face-name)) + hi-lock-face-defaults)) + '(hi-yellow hi-pink hi-green hi-blue hi-black-b + hi-blue-b hi-red-b hi-green-b hi-black-hb)) + "Default faces for hi-lock interactive functions." + :type '(repeat face) + :group 'hi-lock + :version "24.4") + (defvar-local hi-lock--auto-select-face-defaults - (let ((l (copy-sequence hi-lock-face-defaults))) + (let ((l (copy-sequence hi-lock-faces))) (setcdr (last l) l)) "Circular list of faces used for interactive highlighting. When `hi-lock-auto-select-face' is non-nil, use the face at the @@ -410,8 +424,12 @@ versions before 22 use the following in ;;;###autoload (defun hi-lock-line-face-buffer (regexp &optional face) "Set face of all lines containing a match of REGEXP to FACE. -Interactively, prompt for REGEXP then FACE, using a buffer-local -history list for REGEXP and a global history list for FACE. +Interactively, prompt for REGEXP, using a buffer-local history +list for REGEXP . When `hi-lock-auto-select-face' is non-nil, +prompt for FACE using a global history list. Otherwise, use the +next of `hi-lock-faces'. When invoked with +\\[universal-argument] prefix, invert the meaning of +`hi-lock-auto-select-face'. If Font Lock mode is enabled in the buffer, it is used to highlight REGEXP. If Font Lock mode is disabled, overlays are @@ -421,8 +439,9 @@ updated as you type." (list (hi-lock-regexp-okay (read-regexp "Regexp to highlight line" (car regexp-history))) - (hi-lock-read-face-name))) - (or (facep face) (setq face 'hi-yellow)) + (let ((toggle-auto-select current-prefix-arg)) + (hi-lock-read-face-name toggle-auto-select)))) + (unless (facep face) (setq face (hi-lock-read-face-name))) (unless hi-lock-mode (hi-lock-mode 1)) (hi-lock-set-pattern ;; The \\(?:...\\) grouping construct ensures that a leading ^, +, * or ? @@ -435,8 +454,12 @@ updated as you type." ;;;###autoload (defun hi-lock-face-buffer (regexp &optional face) "Set face of each match of REGEXP to FACE. -Interactively, prompt for REGEXP then FACE, using a buffer-local -history list for REGEXP and a global history list for FACE. +Interactively, prompt for REGEXP, using a buffer-local history +list for REGEXP . When `hi-lock-auto-select-face' is non-nil, +prompt for FACE using a global history list. Otherwise, use the +next of `hi-lock-faces'. When invoked with +\\[universal-argument] prefix, invert the meaning of +`hi-lock-auto-select-face'. If Font Lock mode is enabled in the buffer, it is used to highlight REGEXP. If Font Lock mode is disabled, overlays are @@ -446,8 +469,9 @@ updated as you type." (list (hi-lock-regexp-okay (read-regexp "Regexp to highlight" (car regexp-history))) - (hi-lock-read-face-name))) - (or (facep face) (setq face 'hi-yellow)) + (let ((toggle-auto-select current-prefix-arg)) + (hi-lock-read-face-name toggle-auto-select)))) + (unless (facep face) (setq face (hi-lock-read-face-name))) (unless hi-lock-mode (hi-lock-mode 1)) (hi-lock-set-pattern regexp face)) @@ -457,7 +481,12 @@ updated as you type." (defun hi-lock-face-phrase-buffer (regexp &optional face) "Set face of each match of phrase REGEXP to FACE. If called interactively, replaces whitespace in REGEXP with -arbitrary whitespace and makes initial lower-case letters case-insensitive. +arbitrary whitespace and makes initial lower-case letters +case-insensitive. When `hi-lock-auto-select-face' is non-nil, +prompt for FACE using a global history list. Otherwise, use the +next of `hi-lock-faces'. When invoked with +\\[universal-argument] prefix, invert the meaning of +`hi-lock-auto-select-face'. If Font Lock mode is enabled in the buffer, it is used to highlight REGEXP. If Font Lock mode is disabled, overlays are @@ -467,9 +496,10 @@ updated as you type." (list (hi-lock-regexp-okay (hi-lock-process-phrase - (read-regexp "Phrase to highlight" (car regexp-history)))) - (hi-lock-read-face-name))) - (or (facep face) (setq face 'hi-yellow)) + (read-regexp "Phrase to highlight" (car regexp-history)))))) + (let ((toggle-auto-select current-prefix-arg)) + (hi-lock-read-face-name toggle-auto-select)) + (unless (facep face) (setq face (hi-lock-read-face-name))) (unless hi-lock-mode (hi-lock-mode 1)) (hi-lock-set-pattern regexp face)) @@ -482,26 +512,29 @@ updated as you type." (let ((desired-serial (get-char-property (point) 'hi-lock-overlay-regexp))) (when desired-serial - (catch 'regexp (maphash (lambda (regexp serial) (when (= serial desired-serial) (push regexp regexps))) - hi-lock-string-serialize-hash)))) - ;; With font-locking on, check if the cursor is on an highlighted text. - ;; Checking for hi-lock face is a good heuristic. - (and (string-match "\\`hi-lock-" (face-name (face-at-point))) + hi-lock-string-serialize-hash))) + ;; With font-locking on, check if cursor is on an highlighted + ;; text. + (when (member (list 'quote (face-at-point)) + (mapcar (lambda (pattern) + (cadr (cadr pattern))) + hi-lock-interactive-patterns)) (let* ((hi-text (buffer-substring-no-properties - (previous-single-property-change (point) 'face) - (next-single-property-change (point) 'face)))) + (previous-single-char-property-change (point) 'face) + (next-single-char-property-change (point) 'face)))) ;; Compute hi-lock patterns that match the ;; highlighted text at point. Use this later in ;; during completing-read. (dolist (hi-lock-pattern hi-lock-interactive-patterns) (let ((regexp (car hi-lock-pattern))) - (if (string-match regexp hi-text) - (push regexp regexps)))))))) + (when (string-match regexp hi-text) + (push regexp regexps)))))) + regexps)) ;;;###autoload (defalias 'unhighlight-regexp 'hi-lock-unface-buffer) @@ -529,9 +562,7 @@ then remove all hi-lock highlighting." (list (car pattern) (format "%s (%s)" (car pattern) - (symbol-name - (car - (cdr (car (cdr (car (cdr pattern)))))))) + (cadr (cadr (cadr pattern)))) (cons nil nil) (car pattern))) hi-lock-interactive-patterns)))) @@ -557,6 +588,7 @@ then remove all hi-lock highlighting." (dolist (keyword (if (eq regexp t) hi-lock-interactive-patterns (list (assoc regexp hi-lock-interactive-patterns)))) (when keyword + (setq regexp (car keyword)) (font-lock-remove-keywords nil (list keyword)) (setq hi-lock-interactive-patterns (delq keyword hi-lock-interactive-patterns)) @@ -615,31 +647,36 @@ not suitable." (error "Regexp cannot match an empty string") regexp)) -(defun hi-lock-read-face-name () +(defun hi-lock-read-face-name (&optional toggle-auto-select) "Return face name for interactive highlighting. When `hi-lock-auto-select-face' is non-nil, just return the next face. -Otherwise, read face name from minibuffer with completion and history." - (if hi-lock-auto-select-face +Otherwise, read face name from minibuffer with completion and history. + +When TOGGLE-AUTO-SELECT is non-nil, temporarily invert the value +of `hi-lock-auto-select-face'." + (let ((auto-select + (if toggle-auto-select (not hi-lock-auto-select-face) + hi-lock-auto-select-face))) + (if auto-select ;; Return current head and rotate the face list. (pop hi-lock--auto-select-face-defaults) - (intern (completing-read + (intern + (let* ((face-names (mapcar #'face-name hi-lock-faces)) + (prefix (try-completion "" face-names))) + (completing-read "Highlight using face: " obarray 'facep t - (cons (car hi-lock-face-defaults) - (let ((prefix - (try-completion - (substring (car hi-lock-face-defaults) 0 1) - hi-lock-face-defaults))) + (cons (car face-names) (if (and (stringp prefix) - (not (equal prefix (car hi-lock-face-defaults)))) - (length prefix) 0))) - 'face-name-history - (cdr hi-lock-face-defaults))))) + (not (equal prefix (car face-names)))) + (length prefix) 0)) + 'face-name-history (cdr face-names))))))) (defun hi-lock-set-pattern (regexp face) "Highlight REGEXP with face FACE." (let ((pattern (list regexp (list 0 (list 'quote face) t)))) - (unless (member pattern hi-lock-interactive-patterns) + ;; Check if REGEXP is already highlighted. + (unless (assoc regexp hi-lock-interactive-patterns) (push pattern hi-lock-interactive-patterns) (if font-lock-mode (progn --=-=-= Content-Type: text/plain > There are three issues that I see with your commmit: > > Issue-1: face-at-point broken? > =============================== > > M-x toggle-debug-on-error RET > M-x find-function RET face-at-point RET > C-x w h > C-x w r > > Debugger entered--Lisp error: (error "Not a face: nil") > signal(error ("Not a face: nil")) > error("Not a face: %s" nil) > check-face(nil) > face-name(nil) > hi-lock--regexps-at-point() > byte-code("\203\305C\207\306 \203. <\203.\n\203.\307\310\215\207 \204!\311\312!\210\313 \314\f\204-\315\2022\316\317\f@\" \320\305\320\211\f&)C\207" [current-prefix-arg last-nonmenu-event use-dialog-box hi-lock-interactive-patterns defaults t display-popup-menus-p snafu (byte-code "\301\302\303\304\305\306\"BB\"\206.\307\310\311\"\207" [hi-lock-interactive-patterns x-popup-menu t keymap "Select Pattern to Unhighlight" mapcar #[(pattern) "@\301\302@\303A@A@A@!#\304\211B@F\207" [pattern format "%s (%s)" symbol-name nil] 6] throw snafu ("")] 7) error "No highlighting to remove" hi-lock--regexps-at-point completing-read "Regexp to unhighlight: " format "Regexp to unhighlight (default %s): " nil] 8) > call-interactively(unhighlight-regexp nil nil) > > The reason is faceprop happens to be a string > > (get-char-property (point) 'face) > : "hi-yellow" > > Issue-2: Various issues with unhighlighting > ============================================ > > Once you fix Issue-1 you will run in to other issues with > un-highlighting. Try highlighting and UN-highlighting in following 3 > ways > > 1. Buffer with font-lock-mode ON > 2. Buffer with font-lock-mode OFF > 3. Unhighlight from the menu > > Caveat: Extra testing needed if /type/ of face names are changed > ================================================================= > > hi-lock-face-defautls is currently a list of face names (stringp). If > it is made a defcustom, it will be cast to a list of symbols (symbolp). > In some places, face names are expected and in some other places face as > a symbol is used. So you need to re-run the tests if move from > string->symbols. > > Suggestion: In default faces, don't mix bold and foreground/background > ======================================================================= > > I am OK with defcustom of faces. Something like > > (defcustom hi-lock-face-defaults > '(hi-yellow hi-pink hi-green hi-blue hi-black-b > hi-blue-b hi-red-b hi-green-b hi-black-hb) > "Default faces for hi-lock interactive functions." > :type '(repeat face) > :group 'hi-lock-faces) > > Bonus points if the default settings of the faces that go in there is > revised as part of this bug. I want to highlight variables in a buffer. > So consistent policy of highlighting - a changed background of normal > face - will require no additional work. > > Here is how my own faces look like. Note that the first 4 come from > "blue" space and the later 4 or so come from "pink" space, all chosen > using agave. > > ps: I will let you install a change for the above issues. --=-=-=--