From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: dick Newsgroups: gmane.emacs.bugs Subject: bug#54481: 29.0.50; [PATCH] Rewrite hl-line Date: Sun, 20 Mar 2022 11:52:35 -0400 Message-ID: <877d8o8vuk.fsf@dick> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="29469"; mail-complaints-to="usenet@ciao.gmane.io" To: 54481@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Sun Mar 20 17:12:17 2022 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1nVyAC-0007QV-6j for geb-bug-gnu-emacs@m.gmane-mx.org; Sun, 20 Mar 2022 17:12:16 +0100 Original-Received: from localhost ([::1]:37366 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1nVyAA-000359-OG for geb-bug-gnu-emacs@m.gmane-mx.org; Sun, 20 Mar 2022 12:12:14 -0400 Original-Received: from eggs.gnu.org ([209.51.188.92]:48270) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nVy66-0005lK-Ow for bug-gnu-emacs@gnu.org; Sun, 20 Mar 2022 12:08:03 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:41159) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nVy66-00076e-F6 for bug-gnu-emacs@gnu.org; Sun, 20 Mar 2022 12:08:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1nVy65-0006CP-QA for bug-gnu-emacs@gnu.org; Sun, 20 Mar 2022 12:08:01 -0400 X-Loop: help-debbugs@gnu.org Resent-From: dick Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sun, 20 Mar 2022 16:08:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 54481 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch X-Debbugs-Original-To: bug-gnu-emacs Original-Received: via spool by submit@debbugs.gnu.org id=B.164779245323772 (code B ref -1); Sun, 20 Mar 2022 16:08:01 +0000 Original-Received: (at submit) by debbugs.gnu.org; 20 Mar 2022 16:07:33 +0000 Original-Received: from localhost ([127.0.0.1]:35054 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nVy5b-0006BI-55 for submit@debbugs.gnu.org; Sun, 20 Mar 2022 12:07:33 -0400 Original-Received: from lists.gnu.org ([209.51.188.17]:45832) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nVxrG-0005m4-82 for submit@debbugs.gnu.org; Sun, 20 Mar 2022 11:52:43 -0400 Original-Received: from eggs.gnu.org ([209.51.188.92]:44658) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nVxrF-0002HK-UG for bug-gnu-emacs@gnu.org; Sun, 20 Mar 2022 11:52:42 -0400 Original-Received: from [2607:f8b0:4864:20::f31] (port=36512 helo=mail-qv1-xf31.google.com) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nVxrC-0003Qa-A2 for bug-gnu-emacs@gnu.org; Sun, 20 Mar 2022 11:52:41 -0400 Original-Received: by mail-qv1-xf31.google.com with SMTP id kc20so6122616qvb.3 for ; Sun, 20 Mar 2022 08:52:37 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20210112; h=from:to:subject:date:message-id:mime-version; bh=5T+XW82BNZdyMrDBpb8aZB67aikWXCwDniESYTnWgd4=; b=q1LXa4XgWm7a99+GcjCoXkdM7WbVDuXDqEVqnX8jp10WiniPRTfbEAgkklno+UJ/9Y v/uSVBCES+V9Z9mlKQFwvn30r5F5NyUXhbRjpcOBjeXUPOB5gn+VApbQtdxnk6wOT+qY c87+vipzONRp0FHZOyx+e5hd6UCvnD0GbeQvXyyDOmkjI/GvRlvt6DYP7+ZxzyDGUBhd iRnTcgiDxQgXAssBdbdPeHwDE+dghB2Yn5MQwNOmgIRL4RCJFEk5GW4rDskI9FS/JFmK 7C1Gj8FHntwHairNKmi+mi/fVM1tb4mpwY134JK4CWiXj1cmzgI+mr66iASF79ffANQW Nhcw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=x-gm-message-state:from:to:subject:date:message-id:mime-version; bh=5T+XW82BNZdyMrDBpb8aZB67aikWXCwDniESYTnWgd4=; b=sfwd1FFHtDX1iPRL0NVArc+IGqp77tVq4HWzdhZHf+zcAOsu+IA8Fmqi9TknGVxWP0 eQjCPn7rHuSZ9fCcfk9p0DJPvjgvqYiV4XAAmpe+IYbIvGYnybAvD/EzmF6bpSoVLlsk HkMGyNG5DiVqwkwMkGK7ikelkw/Uep3v82iMaJU/ZhbEonBpcE55VK8bJLE276tVQiKd l5ZHOWGEKYcbZDxDES7b/iXsGYqzXDO+RRWCgcjGecA9i5XyisxjKHwt7HNL7NEr2cMc BJMa4fmWtACNql+JNMDrkyp2c8I1Zkc6mLftQ0XqNd86ik54DFpjd2P9D6TPE3MUtLst nHKg== X-Gm-Message-State: AOAM532QQG30PsPGMHxFtWLDgfu2yIXl1dSxTsRzKkY0cbkYs53wDHmu IbFHxtRvjOqanFpaAjHPTgz4ANuWeTI= X-Google-Smtp-Source: ABdhPJz0YPm0pesHu8OVyleec2d5ibF7OyouasEzthMLCaiabVr0jWu++nZxXox+VpITe9X2J/gr8g== X-Received: by 2002:a05:6214:c63:b0:441:2263:56c1 with SMTP id t3-20020a0562140c6300b00441226356c1mr1325192qvj.131.1647791556490; Sun, 20 Mar 2022 08:52:36 -0700 (PDT) Original-Received: from localhost (pool-96-232-253-158.nycmny.fios.verizon.net. [96.232.253.158]) by smtp.gmail.com with ESMTPSA id f14-20020ac8068e000000b002dd1bc00eadsm9276163qth.93.2022.03.20.08.52.35 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Sun, 20 Mar 2022 08:52:35 -0700 (PDT) X-Host-Lookup-Failed: Reverse DNS lookup failed for 2607:f8b0:4864:20::f31 (failed) Received-SPF: pass client-ip=2607:f8b0:4864:20::f31; envelope-from=dick.r.chiang@gmail.com; helo=mail-qv1-xf31.google.com X-Spam_score_int: -6 X-Spam_score: -0.7 X-Spam_bar: / X-Spam_report: (-0.7 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_FROM=0.001, PDS_HP_HELO_NORDNS=0.659, RCVD_IN_DNSWL_NONE=-0.0001, RDNS_NONE=0.793, SPF_HELO_NONE=0.001, SPF_PASS=-0.001, T_SCC_BODY_TEXT_LINE=-0.01 autolearn=no autolearn_force=no X-Spam_action: no action X-Mailman-Approved-At: Sun, 20 Mar 2022 12:07:29 -0400 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list 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-mx.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.io gmane.emacs.bugs:228629 Archived-At: --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0001-Rewrite-hl-line-mode.patch >From f61a14c16154e0a170e0b9b58851279e282face9 Mon Sep 17 00:00:00 2001 From: dickmao Date: Sun, 20 Mar 2022 11:34:56 -0400 Subject: [PATCH] Rewrite hl-line-mode The fashion of dual global and minor modes, each managing a replica of state, has long been outmoded by globalized minor modes (nee easy-mmode-define-global-mode) around the turn of the century. * lisp/calendar/todo-mode.el (todo-toggle-item-highlighting, todo-hl-line-range, todo-modes-set-2): Adapt to new hl-line-highlight-hook. * lisp/hl-line.el (hl-line-overlay): Rename hl-line--overlay. (global-hl-line-overlay, global-hl-line-overlays, global-hl-line-sticky-flag, hl-line-overlay-buffer, hl-line-range-function): Obsolesce. (hl-line--overlay): Erstwhile hl-line-overlay. (hl-line, hl-line-face): Consolidate. (hl-line-sticky-flag): Say less (Gen Z Hospital). (hl-line-overlay-priority): Make this a custom. (hl-line-highlight-hook): Prefer hook over specialized hl-line-range-function. (hl-line-mode): Say less (Gen Z Hospital). (hl-line-make-overlay): Remove (hl-line-highlight, hl-line-unhighlight): Rewrite. (hl-line-maybe-unhighlight): Remove. (hl-line-turn-on): Necessary for globalized minor mode. (global-hl-line-mode, global-hl-line-highlight, global-hl-line-highlight-all, global-hl-line-unhighlight, global-hl-line-maybe-unhighlight, global-hl-line-unhighlight-all): Prefer globalized minor mode. (hl-line-move, hl-line-unload-function): Remove. * test/lisp/calendar/todo-mode-tests.el (todo-test-item-highlighting, todo-test-done-items-separator06-bol, todo-test-done-items-separator06-eol, todo-test-done-items-separator07): Adapt to consolidated face. --- lisp/calendar/todo-mode.el | 11 +- lisp/hl-line.el | 297 ++++++-------------------- test/lisp/calendar/todo-mode-tests.el | 10 +- test/lisp/hl-line-tests.el | 51 +++++ 4 files changed, 123 insertions(+), 246 deletions(-) create mode 100644 test/lisp/hl-line-tests.el diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index 57fcd1b17e1..eed597a0337 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -1040,9 +1040,7 @@ todo-toggle-item-highlighting (eval-and-compile (require 'hl-line)) (when (memq major-mode '(todo-mode todo-archive-mode todo-filtered-items-mode)) - (if hl-line-mode - (hl-line-mode -1) - (hl-line-mode 1)))) + (hl-line-mode 'toggle))) (defvar todo--item-headers-hidden nil "Non-nil if item date-time headers in current buffer are hidden.") @@ -6676,9 +6674,8 @@ todo-modes-set-1 (defun todo-hl-line-range () "Make `todo-toggle-item-highlighting' highlight entire item." (save-excursion - (when (todo-item-end) - (cons (todo-item-start) - (todo-item-end))))) + (when (and (todo-item-end) hl-line--overlay) + (move-overlay hl-line--overlay (todo-item-start) (todo-item-end))))) (defun todo-modes-set-2 () "Make some settings that apply to multiple Todo modes." @@ -6686,7 +6683,7 @@ todo-modes-set-2 (setq buffer-read-only t) (setq-local todo--item-headers-hidden nil) (setq-local desktop-save-buffer 'todo-desktop-save-buffer) - (setq-local hl-line-range-function #'todo-hl-line-range)) + (add-hook 'hl-line-highlight-hook #'todo-hl-line-range nil t)) (defun todo-modes-set-3 () "Make some settings that apply to multiple Todo modes." diff --git a/lisp/hl-line.el b/lisp/hl-line.el index 8e60ddf6b07..daa24c4fbf3 100644 --- a/lisp/hl-line.el +++ b/lisp/hl-line.el @@ -24,274 +24,103 @@ ;;; Commentary: -;; Provides a local minor mode (toggled by M-x hl-line-mode) and -;; a global minor mode (toggled by M-x global-hl-line-mode) to -;; highlight, on a suitable terminal, the line on which point is. The -;; global mode highlights the current line in the selected window only -;; (except when the minibuffer window is selected). This was -;; implemented to satisfy a request for a feature of Lesser Editors. -;; The local mode is sticky: it highlights the line about the buffer's -;; point even if the buffer's window is not selected. Caveat: the -;; buffer's point might be different from the point of a non-selected -;; window. Set the variable `hl-line-sticky-flag' to nil to make the -;; local mode behave like the global mode. - -;; You probably don't really want to use the global mode; if the -;; cursor is difficult to spot, try changing its color, relying on -;; `blink-cursor-mode' or both. The hookery used might affect -;; response noticeably on a slow machine. The local mode may be -;; useful in non-editing buffers such as Gnus or PCL-CVS though. - -;; An overlay is used. In the non-sticky cases, this overlay is -;; active only on the selected window. A hook is added to -;; `post-command-hook' to activate the overlay and move it to the line -;; about point. - -;; You could make variable `global-hl-line-mode' buffer-local and set -;; it to nil to avoid highlighting specific buffers, when the global -;; mode is used. - -;; By default the whole line is highlighted. The range of highlighting -;; can be changed by defining an appropriate function as the -;; buffer-local value of `hl-line-range-function'. - ;;; Code: -(defvar-local hl-line-overlay nil - "Overlay used by Hl-Line mode to highlight the current line.") +(make-obsolete-variable 'hl-line-overlay nil "29.1") +(make-obsolete-variable 'global-hl-line-overlay nil "29.1") +(make-obsolete-variable 'global-hl-line-overlays nil "29.1") +(make-obsolete-variable 'global-hl-line-sticky-flag nil "29.1") +(make-obsolete-variable 'hl-line-overlay-buffer nil "29.1") +(make-obsolete-variable 'hl-line-range-function nil "29.1") -(defvar-local global-hl-line-overlay nil - "Overlay used by Global-Hl-Line mode to highlight the current line.") +(defvar-local hl-line--overlay nil + "Keep state else scan entire buffer in `post-command-hook'.") -(defvar global-hl-line-overlays nil - "Overlays used by Global-Hl-Line mode in various buffers. -Global-Hl-Line keeps displaying one overlay in each buffer -when `global-hl-line-sticky-flag' is non-nil.") +;; 1. define-minor-mode creates buffer-local hl-line--overlay +;; 2. overlay wiped by kill-all-local-variables +;; 3. post-command-hook dupes overlay +;; Solution: prevent step 2. +(put 'hl-line--overlay 'permanent-local t) (defgroup hl-line nil "Highlight the current line." :version "21.1" :group 'convenience) -(defface hl-line - '((t :inherit highlight :extend t)) - "Default face for highlighting the current line in Hl-Line mode." +(defface hl-line-face '((t :inherit highlight :extend t)) + "Default face for highlighting the current line in hl-line-mode." :version "22.1" :group 'hl-line) -(defcustom hl-line-face 'hl-line - "Face with which to highlight the current line in Hl-Line mode." - :type 'face - :group 'hl-line - :set (lambda (symbol value) - (set symbol value) - (dolist (buffer (buffer-list)) - (with-current-buffer buffer - (when (overlayp hl-line-overlay) - (overlay-put hl-line-overlay 'face hl-line-face)))) - (when (overlayp global-hl-line-overlay) - (overlay-put global-hl-line-overlay 'face hl-line-face)))) - (defcustom hl-line-sticky-flag t - "Non-nil means the HL-Line mode highlight appears in all windows. -Otherwise Hl-Line mode will highlight only in the selected -window. Setting this variable takes effect the next time you use -the command `hl-line-mode' to turn Hl-Line mode on. - -This variable has no effect in Global Highlight Line mode. -For that, use `global-hl-line-sticky-flag'." + "Non-nil to preserve highlighting overlay when focus leaves window." :type 'boolean :version "22.1" + :group 'hl-line + :set (lambda (symbol value) + (set-default symbol value) + (unless value + (let ((selected (window-buffer (selected-window)))) + (dolist (buffer (buffer-list)) + (unless (eq buffer selected) + (with-current-buffer buffer + (hl-line-unhighlight)))))))) + +(defcustom hl-line-overlay-priority -50 + "Priority used on the overlay used by hl-line." + :type 'integer + :version "22.1" :group 'hl-line) -(defcustom global-hl-line-sticky-flag nil - "Non-nil means the Global HL-Line mode highlight appears in all windows. -Otherwise Global Hl-Line mode will highlight only in the selected -window. Setting this variable takes effect the next time you use -the command `global-hl-line-mode' to turn Global Hl-Line mode on." - :type 'boolean - :version "24.1" +(defcustom hl-line-highlight-hook nil + "After hook for `hl-line-highlight'. +Currently used in calendar/todo-mode." + :type 'hook :group 'hl-line) -(defvar hl-line-range-function nil - "If non-nil, function to call to return highlight range. -The function of no args should return a cons cell; its car value -is the beginning position of highlight and its cdr value is the -end position of highlight in the buffer. -It should return nil if there's no region to be highlighted. - -This variable is expected to be made buffer-local by modes.") - -(defvar hl-line-overlay-buffer nil - "Most recently visited buffer in which Hl-Line mode is enabled.") - -(defvar hl-line-overlay-priority -50 - "Priority used on the overlay used by hl-line.") - ;;;###autoload (define-minor-mode hl-line-mode - "Toggle highlighting of the current line (Hl-Line mode). - -Hl-Line mode is a buffer-local minor mode. If -`hl-line-sticky-flag' is non-nil, Hl-Line mode highlights the -line about the buffer's point in all windows. Caveat: the -buffer's point might be different from the point of a -non-selected window. Hl-Line mode uses the function -`hl-line-highlight' on `post-command-hook' in this case. - -When `hl-line-sticky-flag' is nil, Hl-Line mode highlights the -line about point in the selected window only." + "Toggle highlighting of the current line." :group 'hl-line (if hl-line-mode (progn - ;; In case `kill-all-local-variables' is called. - (add-hook 'change-major-mode-hook #'hl-line-unhighlight nil t) (hl-line-highlight) - (setq hl-line-overlay-buffer (current-buffer)) + (add-hook 'change-major-mode-hook #'hl-line-unhighlight nil t) (add-hook 'post-command-hook #'hl-line-highlight nil t)) (remove-hook 'post-command-hook #'hl-line-highlight t) - (hl-line-unhighlight) - (remove-hook 'change-major-mode-hook #'hl-line-unhighlight t))) - -(defun hl-line-make-overlay () - (let ((ol (make-overlay (point) (point)))) - (overlay-put ol 'priority hl-line-overlay-priority) ;(bug#16192) - (overlay-put ol 'face hl-line-face) - ol)) - -(defun hl-line-highlight () - "Activate the Hl-Line overlay on the current line." - (if hl-line-mode ; Might be changed outside the mode function. - (progn - (unless (overlayp hl-line-overlay) - (setq hl-line-overlay (hl-line-make-overlay))) ; To be moved. - (overlay-put hl-line-overlay - 'window (unless hl-line-sticky-flag (selected-window))) - (hl-line-move hl-line-overlay) - (hl-line-maybe-unhighlight)) - (hl-line-unhighlight))) + (remove-hook 'change-major-mode-hook #'hl-line-unhighlight t) + (let (hl-line-sticky-flag) + (hl-line-unhighlight)))) (defun hl-line-unhighlight () - "Deactivate the Hl-Line overlay on the current line." - (when (overlayp hl-line-overlay) - (delete-overlay hl-line-overlay) - (setq hl-line-overlay nil))) + (unless hl-line-sticky-flag + (when hl-line--overlay + (delete-overlay hl-line--overlay) + (setq hl-line--overlay nil)))) -(defun hl-line-maybe-unhighlight () - "Maybe deactivate the Hl-Line overlay on the current line. -Specifically, when `hl-line-sticky-flag' is nil deactivate all -such overlays in all buffers except the current one." - (let ((hlob hl-line-overlay-buffer) - (curbuf (current-buffer))) - (when (and (buffer-live-p hlob) - (not hl-line-sticky-flag) - (not (eq curbuf hlob)) - (not (minibufferp))) - (with-current-buffer hlob - (hl-line-unhighlight))) - (when (and (overlayp hl-line-overlay) - (eq (overlay-buffer hl-line-overlay) curbuf)) - (setq hl-line-overlay-buffer curbuf)))) +(defun hl-line-highlight () + (unless (minibufferp) + (unless hl-line--overlay + (setq hl-line--overlay + (let ((ol (make-overlay (point) (point)))) + (prog1 ol + (overlay-put ol 'priority hl-line-overlay-priority) + (overlay-put ol 'face 'hl-line-face))))) + (move-overlay hl-line--overlay + (line-beginning-position) + (line-beginning-position 2)) + (run-hooks 'hl-line-highlight-hook))) + +(defun hl-line-turn-on () + (unless (minibufferp) + (let (inhibit-quit) + (hl-line-mode 1)))) ;;;###autoload -(define-minor-mode global-hl-line-mode - "Toggle line highlighting in all buffers (Global Hl-Line mode). - -If `global-hl-line-sticky-flag' is non-nil, Global Hl-Line mode -highlights the line about the current buffer's point in all live -windows. - -Global-Hl-Line mode uses the function `global-hl-line-highlight' -on `post-command-hook'." - :global t +(define-globalized-minor-mode global-hl-line-mode + hl-line-mode hl-line-turn-on :group 'hl-line - (if global-hl-line-mode - (progn - ;; In case `kill-all-local-variables' is called. - (add-hook 'change-major-mode-hook #'global-hl-line-unhighlight) - (global-hl-line-highlight-all) - (add-hook 'post-command-hook #'global-hl-line-highlight)) - (global-hl-line-unhighlight-all) - (remove-hook 'post-command-hook #'global-hl-line-highlight) - (remove-hook 'change-major-mode-hook #'global-hl-line-unhighlight))) - -(defun global-hl-line-highlight () - "Highlight the current line in the current window." - (when global-hl-line-mode ; Might be changed outside the mode function. - (unless (window-minibuffer-p) - (unless (overlayp global-hl-line-overlay) - (setq global-hl-line-overlay (hl-line-make-overlay))) ; To be moved. - (unless (member global-hl-line-overlay global-hl-line-overlays) - (push global-hl-line-overlay global-hl-line-overlays)) - (overlay-put global-hl-line-overlay 'window - (unless global-hl-line-sticky-flag - (selected-window))) - (hl-line-move global-hl-line-overlay) - (global-hl-line-maybe-unhighlight)))) - -(defun global-hl-line-highlight-all () - "Highlight the current line in all live windows." - (walk-windows (lambda (w) - (with-current-buffer (window-buffer w) - (global-hl-line-highlight))) - nil t)) - -(defun global-hl-line-unhighlight () - "Deactivate the Global-Hl-Line overlay on the current line." - (when (overlayp global-hl-line-overlay) - (delete-overlay global-hl-line-overlay) - (setq global-hl-line-overlay nil))) - -(defun global-hl-line-maybe-unhighlight () - "Maybe deactivate the Global-Hl-Line overlay on the current line. -Specifically, when `global-hl-line-sticky-flag' is nil deactivate -all such overlays in all buffers except the current one." - (mapc (lambda (ov) - (let ((ovb (overlay-buffer ov))) - (when (and (not global-hl-line-sticky-flag) - (bufferp ovb) - (not (eq ovb (current-buffer))) - (not (minibufferp))) - (with-current-buffer ovb - (global-hl-line-unhighlight))))) - global-hl-line-overlays)) - -(defun global-hl-line-unhighlight-all () - "Deactivate all Global-Hl-Line overlays." - (mapc (lambda (ov) - (let ((ovb (overlay-buffer ov))) - (when (bufferp ovb) - (with-current-buffer ovb - (global-hl-line-unhighlight))))) - global-hl-line-overlays) - (setq global-hl-line-overlays nil)) - -(defun hl-line-move (overlay) - "Move the Hl-Line overlay. -If `hl-line-range-function' is non-nil, move the OVERLAY to the position -where the function returns. If `hl-line-range-function' is nil, fill -the line including the point by OVERLAY." - (let (tmp b e) - (if hl-line-range-function - (setq tmp (funcall hl-line-range-function) - b (car tmp) - e (cdr tmp)) - (setq tmp t - b (line-beginning-position) - e (line-beginning-position 2))) - (if tmp - (move-overlay overlay b e) - (move-overlay overlay 1 1)))) - -(defun hl-line-unload-function () - "Unload the Hl-Line library." - (global-hl-line-mode -1) - (save-current-buffer - (dolist (buffer (buffer-list)) - (set-buffer buffer) - (when hl-line-mode (hl-line-mode -1)))) - ;; continue standard unloading - nil) + :version "29.1") (provide 'hl-line) diff --git a/test/lisp/calendar/todo-mode-tests.el b/test/lisp/calendar/todo-mode-tests.el index 0102b62c10f..8715a32b883 100644 --- a/test/lisp/calendar/todo-mode-tests.el +++ b/test/lisp/calendar/todo-mode-tests.el @@ -130,8 +130,8 @@ todo-test-item-highlighting (todo-toggle-item-highlighting) (let ((end (1- (todo-item-end))) (beg (todo-item-start))) - (should (eq (get-char-property beg 'face) 'hl-line)) - (should (eq (get-char-property end 'face) 'hl-line)) + (should (eq (get-char-property beg 'face) 'hl-line-face)) + (should (eq (get-char-property end 'face) 'hl-line-face)) (should (> (count-lines beg end) 1)) (should (eq (next-single-char-property-change beg 'face) (1+ end)))) (todo-toggle-item-highlighting))) ; Turn off highlighting (for test rerun). @@ -736,7 +736,7 @@ todo-test-done-items-separator06-bol (todo-test--done-items-separator) (call-interactively #'todo-toggle-item-highlighting) (ert-simulate-command '(todo-previous-item)) - (should (eq 'hl-line (get-char-property (point) 'face))))) + (should (eq 'hl-line-face (get-char-property (point) 'face))))) (ert-deftest todo-test-done-items-separator06-eol () ; bug#32343 "Test enabling item highlighting at EOL of done items separator. @@ -746,7 +746,7 @@ todo-test-done-items-separator06-eol (todo-toggle-item-highlighting) (forward-line -1) (ert-simulate-command '(todo-previous-item)) - (should (eq 'hl-line (get-char-property (point) 'face))))) + (should (eq 'hl-line-face (get-char-property (point) 'face))))) (ert-deftest todo-test-done-items-separator07 () ; bug#32343 "Test item highlighting when crossing done items separator. @@ -758,7 +758,7 @@ todo-test-done-items-separator07 (todo-next-item) ; Now on empty line above separator. (forward-line) ; Now on separator. (ert-simulate-command '(forward-line)) ; Now on first done item. - (should (eq 'hl-line (get-char-property (point) 'face))))) + (should (eq 'hl-line-face (get-char-property (point) 'face))))) (ert-deftest todo-test-current-file-in-edit-mode () ; bug#32437 "Test the value of todo-current-todo-file in todo-edit-mode." diff --git a/test/lisp/hl-line-tests.el b/test/lisp/hl-line-tests.el new file mode 100644 index 00000000000..422d4ddae7d --- /dev/null +++ b/test/lisp/hl-line-tests.el @@ -0,0 +1,51 @@ +;;; hl-line-tests.el --- Test suite for hl-line. -*- lexical-binding: t -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: +(require 'ert) +(require 'hl-line) + +(ert-deftest hl-line-sticky () + (should hl-line-sticky-flag) + (with-temp-buffer + (let ((from-buffer (current-buffer))) + (hl-line-mode 1) + (save-excursion + (insert "foo")) + (hl-line-highlight) + (should (cl-some (apply-partially #'eq hl-line--overlay) + (overlays-at (point)))) + (switch-to-buffer (get-buffer-create "*scratch*")) + (hl-line-mode 1) + (save-excursion + (insert "bar")) + (hl-line-highlight) + (should (cl-some (apply-partially #'eq hl-line--overlay) + (overlays-at (point)))) + (should (buffer-local-value 'hl-line--overlay from-buffer)) + (should-not (eq (buffer-local-value 'hl-line--overlay from-buffer) + hl-line--overlay)) + (customize-set-variable 'hl-line-sticky-flag nil) + (should hl-line--overlay) + (should (buffer-live-p from-buffer)) + (should-not (buffer-local-value 'hl-line--overlay from-buffer))))) + +(provide 'hl-line-tests) + +;;; hl-line-tests.el ends here -- 2.26.2 --=-=-= Content-Type: text/plain In Commercial Emacs 0.3.1snapshot 3de8c3d in master (upstream 29.0.50, x86_64-pc-linux-gnu) built on dick Repository revision: 3de8c3da89e822c59ff7fd582cd454bd122e421f Repository branch: master Windowing system distributor 'The X.Org Foundation', version 11.0.12013000 System Description: Ubuntu 20.04.3 LTS Configured using: 'configure --prefix=/home/dick/.local --with-tree-sitter --enable-dumping-overwrite 'CFLAGS=-g3 -O2 -I/home/dick/.local/include/' LDFLAGS=-L/home/dick/.local/lib' Configured features: CAIRO DBUS FREETYPE GIF GLIB GMP GNUTLS GSETTINGS HARFBUZZ JPEG JSON TREE_SITTER LCMS2 LIBSELINUX LIBXML2 MODULES NOTIFY INOTIFY PDUMPER PNG RSVG SECCOMP SOUND THREADS TIFF TOOLKIT_SCROLL_BARS WEBP X11 XDBE XIM XPM GTK3 ZLIB Important settings: value of $LANG: en_US.UTF-8 locale-coding-system: utf-8-unix Major mode: Magit Log Minor modes in effect: global-git-commit-mode: t magit-auto-revert-mode: t shell-dirtrack-mode: t global-hl-line-mode: t hl-line-mode: t global-auto-revert-mode: t projectile-mode: t flx-ido-mode: t override-global-mode: t winner-mode: t tooltip-mode: t show-paren-mode: t mouse-wheel-mode: t file-name-shadow-mode: t global-font-lock-mode: t font-lock-mode: t blink-cursor-mode: t buffer-read-only: t column-number-mode: t line-number-mode: t transient-mark-mode: t auto-composition-mode: t auto-encryption-mode: t auto-compression-mode: t Load-path shadows: /home/dick/gomacro-mode/gomacro-mode hides /home/dick/.emacs.d/elpa/gomacro-mode-20200326.1103/gomacro-mode /home/dick/.emacs.d/elpa/magit-3.3.0snapshot/magit-section-pkg hides /home/dick/.emacs.d/elpa/magit-section-3.3.0snapshot/magit-section-pkg /home/dick/org-gcal.el/org-gcal hides /home/dick/.emacs.d/elpa/org-gcal-0.3/org-gcal /home/dick/.emacs.d/elpa/chess-2.0.5/_pkg hides /home/dick/.local/share/emacs/site-lisp/_pkg /home/dick/.emacs.d/elpa/chess-2.0.5/chess-pos hides /home/dick/.local/share/emacs/site-lisp/chess-pos /home/dick/.emacs.d/elpa/chess-2.0.5/chess-module hides /home/dick/.local/share/emacs/site-lisp/chess-module /home/dick/.emacs.d/elpa/chess-2.0.5/chess-ucb hides /home/dick/.local/share/emacs/site-lisp/chess-ucb /home/dick/.emacs.d/elpa/chess-2.0.5/chess-scid hides /home/dick/.local/share/emacs/site-lisp/chess-scid /home/dick/.emacs.d/elpa/chess-2.0.5/chess-puzzle hides /home/dick/.local/share/emacs/site-lisp/chess-puzzle /home/dick/.emacs.d/elpa/chess-2.0.5/chess-irc hides /home/dick/.local/share/emacs/site-lisp/chess-irc /home/dick/.emacs.d/elpa/chess-2.0.5/chess-network hides /home/dick/.local/share/emacs/site-lisp/chess-network /home/dick/.emacs.d/elpa/chess-2.0.5/chess-autosave hides /home/dick/.local/share/emacs/site-lisp/chess-autosave /home/dick/.emacs.d/elpa/chess-2.0.5/chess-engine hides /home/dick/.local/share/emacs/site-lisp/chess-engine /home/dick/.emacs.d/elpa/chess-2.0.5/chess-tutorial hides /home/dick/.local/share/emacs/site-lisp/chess-tutorial /home/dick/.emacs.d/elpa/chess-2.0.5/chess-german hides /home/dick/.local/share/emacs/site-lisp/chess-german /home/dick/.emacs.d/elpa/chess-2.0.5/chess-file hides /home/dick/.local/share/emacs/site-lisp/chess-file /home/dick/.emacs.d/elpa/chess-2.0.5/chess-random hides /home/dick/.local/share/emacs/site-lisp/chess-random /home/dick/.emacs.d/elpa/chess-2.0.5/chess-stockfish hides /home/dick/.local/share/emacs/site-lisp/chess-stockfish /home/dick/.emacs.d/elpa/chess-2.0.5/chess-pgn hides /home/dick/.local/share/emacs/site-lisp/chess-pgn /home/dick/.emacs.d/elpa/chess-2.0.5/chess-kibitz hides /home/dick/.local/share/emacs/site-lisp/chess-kibitz /home/dick/.emacs.d/elpa/chess-2.0.5/chess-eco hides /home/dick/.local/share/emacs/site-lisp/chess-eco /home/dick/.emacs.d/elpa/chess-2.0.5/chess-display hides /home/dick/.local/share/emacs/site-lisp/chess-display /home/dick/.emacs.d/elpa/chess-2.0.5/chess-var hides /home/dick/.local/share/emacs/site-lisp/chess-var /home/dick/.emacs.d/elpa/chess-2.0.5/chess-test hides /home/dick/.local/share/emacs/site-lisp/chess-test /home/dick/.emacs.d/elpa/chess-2.0.5/chess-ply hides /home/dick/.local/share/emacs/site-lisp/chess-ply /home/dick/.emacs.d/elpa/chess-2.0.5/chess-message hides /home/dick/.local/share/emacs/site-lisp/chess-message /home/dick/.emacs.d/elpa/chess-2.0.5/chess-ics1 hides /home/dick/.local/share/emacs/site-lisp/chess-ics1 /home/dick/.emacs.d/elpa/chess-2.0.5/chess-phalanx hides /home/dick/.local/share/emacs/site-lisp/chess-phalanx /home/dick/.emacs.d/elpa/chess-2.0.5/chess-game hides /home/dick/.local/share/emacs/site-lisp/chess-game /home/dick/.emacs.d/elpa/chess-2.0.5/chess-log hides /home/dick/.local/share/emacs/site-lisp/chess-log /home/dick/.emacs.d/elpa/chess-2.0.5/chess-plain hides /home/dick/.local/share/emacs/site-lisp/chess-plain /home/dick/.emacs.d/elpa/chess-2.0.5/chess-perft hides /home/dick/.local/share/emacs/site-lisp/chess-perft /home/dick/.emacs.d/elpa/chess-2.0.5/chess-glaurung hides /home/dick/.local/share/emacs/site-lisp/chess-glaurung /home/dick/.emacs.d/elpa/chess-2.0.5/chess-ai hides /home/dick/.local/share/emacs/site-lisp/chess-ai /home/dick/.emacs.d/elpa/chess-2.0.5/chess-fruit hides /home/dick/.local/share/emacs/site-lisp/chess-fruit /home/dick/.emacs.d/elpa/chess-2.0.5/chess-uci hides /home/dick/.local/share/emacs/site-lisp/chess-uci /home/dick/.emacs.d/elpa/chess-2.0.5/chess-epd hides /home/dick/.local/share/emacs/site-lisp/chess-epd /home/dick/.emacs.d/elpa/chess-2.0.5/chess-database hides /home/dick/.local/share/emacs/site-lisp/chess-database /home/dick/.emacs.d/elpa/chess-2.0.5/chess-link hides /home/dick/.local/share/emacs/site-lisp/chess-link /home/dick/.emacs.d/elpa/chess-2.0.5/chess-transport hides /home/dick/.local/share/emacs/site-lisp/chess-transport /home/dick/.emacs.d/elpa/chess-2.0.5/chess-none hides /home/dick/.local/share/emacs/site-lisp/chess-none /home/dick/.emacs.d/elpa/chess-2.0.5/chess-polyglot hides /home/dick/.local/share/emacs/site-lisp/chess-polyglot /home/dick/.emacs.d/elpa/chess-2.0.5/chess-crafty hides /home/dick/.local/share/emacs/site-lisp/chess-crafty /home/dick/.emacs.d/elpa/chess-2.0.5/chess-chat hides /home/dick/.local/share/emacs/site-lisp/chess-chat /home/dick/.emacs.d/elpa/chess-2.0.5/chess hides /home/dick/.local/share/emacs/site-lisp/chess /home/dick/.emacs.d/elpa/chess-2.0.5/chess-images hides /home/dick/.local/share/emacs/site-lisp/chess-images /home/dick/.emacs.d/elpa/chess-2.0.5/chess-gnuchess hides /home/dick/.local/share/emacs/site-lisp/chess-gnuchess /home/dick/.emacs.d/elpa/chess-2.0.5/chess-fen hides /home/dick/.local/share/emacs/site-lisp/chess-fen /home/dick/.emacs.d/elpa/chess-2.0.5/chess-ics hides /home/dick/.local/share/emacs/site-lisp/chess-ics /home/dick/.emacs.d/elpa/chess-2.0.5/chess-ics2 hides /home/dick/.local/share/emacs/site-lisp/chess-ics2 /home/dick/.emacs.d/elpa/chess-2.0.5/chess-common hides /home/dick/.local/share/emacs/site-lisp/chess-common /home/dick/.emacs.d/elpa/chess-2.0.5/chess-input hides /home/dick/.local/share/emacs/site-lisp/chess-input /home/dick/.emacs.d/elpa/chess-2.0.5/chess-announce hides /home/dick/.local/share/emacs/site-lisp/chess-announce /home/dick/.emacs.d/elpa/chess-2.0.5/chess-clock hides /home/dick/.local/share/emacs/site-lisp/chess-clock /home/dick/.emacs.d/elpa/chess-2.0.5/chess-sound hides /home/dick/.local/share/emacs/site-lisp/chess-sound /home/dick/.emacs.d/elpa/chess-2.0.5/chess-sjeng hides /home/dick/.local/share/emacs/site-lisp/chess-sjeng /home/dick/.emacs.d/elpa/chess-2.0.5/chess-algebraic hides /home/dick/.local/share/emacs/site-lisp/chess-algebraic /home/dick/.emacs.d/elpa/transient-0.3.7snapshot/transient hides /home/dick/.local/share/emacs/0.3.1/lisp/transient Features: (shadow sort footnote mail-extr gnus-msg gnus-art mm-uu mml2015 mm-view mml-smime smime dig gnus-sum shr pixel-fill kinsoku url-file url-dired svg dom gnus-group mm-url gnus-undo gnus-start gnus-dbus gnus-cloud nnimap nnmail mail-source utf7 netrc nnoo gnus-spec gnus-int gnus-range gnus-win emacsbug git-rebase mule-util misearch multi-isearch magit-extras blamer a benchmark face-remap magit-patch-changelog magit-patch magit-submodule magit-obsolete magit-blame magit-stash magit-reflog magit-bisect magit-push magit-pull magit-fetch magit-clone magit-remote magit-commit magit-sequence magit-notes magit-worktree magit-tag magit-merge magit-branch magit-reset magit-files magit-refs magit-status magit magit-repos magit-apply magit-wip magit-log which-func imenu magit-diff smerge-mode diff git-commit log-edit message sendmail yank-media rmc puny dired-x dired dired-loaddefs rfc822 mml mml-sec epa epg rfc6068 epg-config mm-decode mm-bodies mm-encode mail-parse rfc2231 rfc2047 rfc2045 ietf-drums mailabbrev gmm-utils mailheader pcvs-util add-log magit-core magit-autorevert magit-margin magit-transient magit-process with-editor server magit-mode transient magit-git magit-base magit-section crm dash tramp-archive tramp-gvfs tramp-cache zeroconf dbus xml tramp tramp-loaddefs trampver tramp-integration files-x tramp-compat shell pcomplete parse-time iso8601 ls-lisp format-spec vc-git diff-mode vc-dispatcher bug-reference cl-print help-fns radix-tree cus-start hl-line paredit-ext paredit autorevert filenotify subed subed-vtt subed-srt subed-common subed-mpv subed-debug subed-config inf-ruby ruby-mode smie company pcase haskell-interactive-mode haskell-presentation-mode haskell-process haskell-session haskell-compile haskell-mode haskell-cabal haskell-utils haskell-font-lock haskell-indentation haskell-string haskell-sort-imports haskell-lexeme rx haskell-align-imports haskell-complete-module haskell-ghc-support noutline outline flymake-proc flymake warnings etags fileloop generator xref project dabbrev haskell-customize hydra lv use-package-ensure solarized-theme solarized-definitions projectile lisp-mnt ibuf-ext ibuffer ibuffer-loaddefs thingatpt grep compile comint ansi-color gnus nnheader range mail-utils mm-util mail-prsvr gnus-util text-property-search time-date flx-ido flx google-translate-default-ui google-translate-core-ui facemenu color ido google-translate-core google-translate-tk google-translate-backend use-package-bind-key bind-key auto-complete easy-mmode advice edmacro kmacro popup cus-edit pp cus-load wid-edit emms-player-mplayer emms-player-simple emms emms-compat cl-extra help-mode use-package-core derived winner ring json-reformat-autoloads json-snatcher-autoloads finder-inf sml-mode-autoloads tornado-template-mode-autoloads info package browse-url url url-proxy url-privacy url-expand url-methods url-history url-cookie url-domsuf url-util mailcap url-handlers url-parse auth-source cl-seq eieio eieio-core cl-macs eieio-loaddefs password-cache json map url-vars seq gv subr-x byte-opt bytecomp byte-compile cconv cldefs cl-loaddefs cl-lib iso-transl tooltip eldoc paren electric uniquify ediff-hook vc-hooks lisp-float-type elisp-mode mwheel term/x-win x-win term/common-win x-dnd tool-bar dnd fontset image regexp-opt fringe tree-sitter tabulated-list replace newcomment text-mode lisp-mode prog-mode register page tab-bar menu-bar rfn-eshadow isearch easymenu timer select scroll-bar mouse jit-lock font-lock syntax font-core term/tty-colors frame minibuffer nadvice simple cl-generic cham georgian utf-8-lang misc-lang vietnamese tibetan thai tai-viet lao korean japanese eucjp-ms cp51932 hebrew greek romanian slovak czech european ethiopic indian cyrillic chinese composite emoji-zwj charscript charprop case-table epa-hook jka-cmpr-hook help abbrev obarray cl-preloaded button loaddefs faces cus-face macroexp files window text-properties overlay sha1 md5 base64 format env code-pages mule custom widget keymap hashtable-print-readable backquote threads dbusbind inotify lcms2 dynamic-setting system-font-setting font-render-setting cairo move-toolbar gtk x-toolkit x multi-tty make-network-process emacs) Memory information: ((conses 16 523472 27767) (symbols 48 32537 8) (strings 32 135993 4809) (string-bytes 1 4138773) (vectors 16 61479) (vector-slots 8 948205 17573) (floats 8 455 1428) (intervals 56 5390 3902) (buffers 992 23)) --=-=-=--