bug#35058: [PATCH] Use display-graphic-p in more cases

[Alex <agrambot@gmail.com>]

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

Eli Zaretskii <eliz@gnu.org> writes:
>> --- a/lisp/faces.el
>> +++ b/lisp/faces.el
>> @@ -55,6 +55,7 @@ term-file-aliases
>>    :group 'terminals
>>    :version "25.1")
>>  
>> +(declare-function display-graphic-p "frame" (&optional display))
>
> Did you try to bootstrap with this?  frame.el is loaded after
> faces.el.  (There are more similar declarations in the patches with
> the same issues.)

Yes, I successfully bootstrapped, and the loading issue is why I added
the declare-function calls. It seems to work fine. My usage of
display-graphic-p appears to be different compared to the one in
face-spec-reset-face, which apparently is run during bootstrap.

>> --- a/lisp/emulation/cua-base.el
>> +++ b/lisp/emulation/cua-base.el
>> @@ -427,7 +427,7 @@ cua-rectangle-mark-key
>>  
>>  (defcustom cua-rectangle-modifier-key 'meta
>>    "Modifier key used for rectangle commands bindings.
>> -On non-window systems, always use the meta modifier.
>> +On non-window systems, use `cua-rectangle-terminal-modifier-key'.
>>  Must be set prior to enabling CUA."
>>    :type '(choice (const :tag "Meta key" meta)
>>  		 (const :tag "Alt key" alt)
>> @@ -435,6 +435,16 @@ cua-rectangle-modifier-key
>>  		 (const :tag "Super key" super))
>>    :group 'cua)
>>  
>> +(defcustom cua-rectangle-terminal-modifier-key 'meta
>> +  "Modifier key used for rectangle commands bindings in terminals.
>> +Must be set prior to enabling CUA."
>> +  :type '(choice (const :tag "Meta key" meta)
>> +		 (const :tag "Alt key" alt)
>> +		 (const :tag "Hyper key" hyper)
>> +		 (const :tag "Super key" super))
>> +  :group 'cua
>> +  :version "27.1")
>
> This change should be called out in NEWS.
>
> The new display-* predicates should probably also be mentioned in
> NEWS.

Okay, here's a new set of patches (excluding the same logb patch).


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Use-display-graphic-p-and-display-multi-frame-p-in-m.patch --]
[-- Type: text/x-patch, Size: 8507 bytes --]

From 3f476d5e827fc1e94a18101604838923a2a686c7 Mon Sep 17 00:00:00 2001
From: Alexander Gramiak <agrambot@gmail.com>
Date: Wed, 3 Apr 2019 13:57:16 -0600
Subject: [PATCH 1/4] Use display-graphic-p and display-multi-frame-p in more
 cases

* lisp/disp-table.el:
* lisp/faces.el:
* lisp/frame.el:
* lisp/info.el (Info-fontify-node):
* lisp/window.el (handle-select-window): Use display-graphic-p and
  display-multi-frame-p instead of explicit memq calls.
---
 lisp/disp-table.el | 14 +++++++-------
 lisp/faces.el      | 20 +++++++++-----------
 lisp/frame.el      | 19 +++++++++----------
 lisp/info.el       |  2 +-
 lisp/window.el     |  4 +++-
 5 files changed, 29 insertions(+), 30 deletions(-)

diff --git a/lisp/disp-table.el b/lisp/disp-table.el
index 476c0cb986..4a59750677 100644
--- a/lisp/disp-table.el
+++ b/lisp/disp-table.el
@@ -175,8 +175,8 @@ standard-display-ascii
 (defun standard-display-g1 (c sc)
   "Display character C as character SC in the g1 character set.
 This function assumes that your terminal uses the SO/SI characters;
-it is meaningless for an X frame."
-  (if (memq window-system '(x w32 ns))
+it is meaningless for a graphical frame."
+  (if (display-graphic-p)
       (error "Cannot use string glyphs in a windowing system"))
   (or standard-display-table
       (setq standard-display-table (make-display-table)))
@@ -186,9 +186,9 @@ standard-display-g1
 ;;;###autoload
 (defun standard-display-graphic (c gc)
   "Display character C as character GC in graphics character set.
-This function assumes VT100-compatible escapes; it is meaningless for an
-X frame."
-  (if (memq window-system '(x w32 ns))
+This function assumes VT100-compatible escapes; it is meaningless
+for a graphical frame."
+  (if (display-graphic-p)
       (error "Cannot use string glyphs in a windowing system"))
   (or standard-display-table
       (setq standard-display-table (make-display-table)))
@@ -276,7 +276,7 @@ standard-display-european
       (progn
 	(standard-display-default
 	 (unibyte-char-to-multibyte 160) (unibyte-char-to-multibyte 255))
-	(unless (or (memq window-system '(x w32 ns)))
+	(unless (display-graphic-p)
 	  (and (terminal-coding-system)
 	       (set-terminal-coding-system nil))))
 
@@ -289,7 +289,7 @@ standard-display-european
     ;; unless some other has been specified.
     (if (equal current-language-environment "English")
 	(set-language-environment "latin-1"))
-    (unless (or noninteractive (memq window-system '(x w32 ns)))
+    (unless (or noninteractive (display-graphic-p))
       ;; Send those codes literally to a character-based terminal.
       ;; If we are using single-byte characters,
       ;; it doesn't matter which coding system we use.
diff --git a/lisp/faces.el b/lisp/faces.el
index ab6c384c80..fa526c3506 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -55,6 +55,7 @@ term-file-aliases
   :group 'terminals
   :version "25.1")
 
+(declare-function display-graphic-p "frame" (&optional display))
 (declare-function xw-defined-colors "term/common-win" (&optional frame))
 
 (defvar help-xref-stack-item)
@@ -1239,7 +1240,7 @@ read-face-attribute
 	       ;; explicitly in VALID, using color approximation code
 	       ;; in tty-colors.el.
 	       (when (and (memq attribute '(:foreground :background))
-			  (not (memq (window-system frame) '(x w32 ns)))
+			  (not (display-graphic-p frame))
 			  (not (member new-value
 				       '("unspecified"
 					 "unspecified-fg" "unspecified-bg"))))
@@ -1833,7 +1834,7 @@ defined-colors
 The value may be different for frames on different display types.
 If FRAME doesn't support colors, the value is nil.
 If FRAME is nil, that stands for the selected frame."
-  (if (memq (framep (or frame (selected-frame))) '(x w32 ns))
+  (if (display-graphic-p frame)
       (xw-defined-colors frame)
     (mapcar 'car (tty-color-alist frame))))
 (defalias 'x-defined-colors 'defined-colors)
@@ -1877,7 +1878,7 @@ color-defined-p
 
 If FRAME is omitted or nil, use the selected frame."
   (unless (member color '(unspecified "unspecified-bg" "unspecified-fg"))
-    (if (member (framep (or frame (selected-frame))) '(x w32 ns))
+    (if (display-graphic-p frame)
 	(xw-color-defined-p color frame)
       (numberp (tty-color-translate color frame)))))
 (defalias 'x-color-defined-p 'color-defined-p)
@@ -1903,7 +1904,7 @@ color-values
   (cond
    ((member color '(unspecified "unspecified-fg" "unspecified-bg"))
     nil)
-   ((memq (framep (or frame (selected-frame))) '(x w32 ns))
+   ((display-graphic-p frame)
     (xw-color-values color frame))
    (t
     (tty-color-values color frame))))
@@ -1917,7 +1918,7 @@ display-color-p
 The optional argument DISPLAY specifies which display to ask about.
 DISPLAY should be either a frame or a display name (a string).
 If omitted or nil, that stands for the selected frame's display."
-  (if (memq (framep-on-display display) '(x w32 ns))
+  (if (display-graphic-p display)
       (xw-display-color-p display)
     (tty-display-color-p display)))
 (defalias 'x-display-color-p 'display-color-p)
@@ -1928,12 +1929,9 @@ display-grayscale-p
   "Return non-nil if frames on DISPLAY can display shades of gray.
 DISPLAY should be either a frame or a display name (a string).
 If omitted or nil, that stands for the selected frame's display."
-  (let ((frame-type (framep-on-display display)))
-    (cond
-     ((memq frame-type '(x w32 ns))
-      (x-display-grayscale-p display))
-     (t
-      (> (tty-color-gray-shades display) 2)))))
+  (if (display-graphic-p display)
+      (x-display-grayscale-p display)
+    (> (tty-color-gray-shades display) 2)))
 
 (defun read-color (&optional prompt convert-to-RGB allow-empty-name msg)
   "Read a color name or RGB triplet.
diff --git a/lisp/frame.el b/lisp/frame.el
index 6cb1247372..acf6a46716 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -974,7 +974,7 @@ select-frame-set-input-focus
   (select-frame frame norecord)
   (raise-frame frame)
   ;; Ensure, if possible, that FRAME gets input focus.
-  (when (memq (window-system frame) '(x w32 ns))
+  (when (display-multi-frame-p frame)
     (x-focus-frame frame))
   ;; Move mouse cursor if necessary.
   (cond
@@ -1027,16 +1027,15 @@ suspend-frame
   "Do whatever is right to suspend the current frame.
 Calls `suspend-emacs' if invoked from the controlling tty device,
 `suspend-tty' from a secondary tty device, and
-`iconify-or-deiconify-frame' from an X frame."
+`iconify-or-deiconify-frame' from a graphical frame."
   (interactive)
-  (let ((type (framep (selected-frame))))
-    (cond
-     ((memq type '(x ns w32)) (iconify-or-deiconify-frame))
-     ((eq type t)
-      (if (controlling-tty-p)
-	  (suspend-emacs)
-	(suspend-tty)))
-     (t (suspend-emacs)))))
+  (cond
+   ((display-multi-frame-p) (iconify-or-deiconify-frame))
+   ((eq (framep (selected-frame)) t)
+    (if (controlling-tty-p)
+        (suspend-emacs)
+      (suspend-tty)))
+   (t (suspend-emacs))))
 
 (defun make-frame-names-alist ()
   ;; Only consider the frames on the same display.
diff --git a/lisp/info.el b/lisp/info.el
index f2a064abb6..f3b413a2f9 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -4768,7 +4768,7 @@ Info-fontify-node
             ;; This is a serious problem for trying to handle multiple
             ;; frame types at once.  We want this text to be invisible
             ;; on frames that can display the font above.
-            (when (memq (framep (selected-frame)) '(x pc w32 ns))
+            (when (display-multi-font-p)
               (add-text-properties (1- (match-beginning 2)) (match-end 2)
                                    '(invisible t front-sticky nil rear-nonsticky t))))))
 
diff --git a/lisp/window.el b/lisp/window.el
index b769be0633..b4f5ac5cc4 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -9314,6 +9314,8 @@ mouse-autoselect-window-select
      ;; autoselection.
      (mouse-autoselect-window-start mouse-position window)))))
 
+(declare-function display-multi-frame-p "frame" (&optional display))
+
 (defun handle-select-window (event)
   "Handle select-window events."
   (interactive "^e")
@@ -9351,7 +9353,7 @@ handle-select-window
       ;; we might get two windows with an active cursor.
       (select-window window)
       (cond
-       ((or (not (memq (window-system frame) '(x w32 ns)))
+       ((or (not (display-multi-frame-p))
             (not focus-follows-mouse)
             ;; Focus FRAME if it's either a child frame or an ancestor
             ;; of the frame switched from.
-- 
2.21.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-Define-and-use-new-alias-display-blink-cursor-p.patch --]
[-- Type: text/x-patch, Size: 1238 bytes --]

From 372299922bbff28d8fe19fffc6c784b390e13402 Mon Sep 17 00:00:00 2001
From: Alexander Gramiak <agrambot@gmail.com>
Date: Wed, 3 Apr 2019 14:03:42 -0600
Subject: [PATCH 2/4] Define and use new alias display-blink-cursor-p

display-graphic-p is not used in this case because it may be possible
in the future for terminals to allow control over cursor blinking. For
details, see bug#35058.

* lisp/frame.el (blink-cursor-mode): Use display-blink-cursor-p.
---
 lisp/frame.el | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/lisp/frame.el b/lisp/frame.el
index acf6a46716..cc8ca49b3b 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -1905,6 +1905,7 @@ display-images-p
        (fboundp 'image-mask-p)
        (fboundp 'image-size)))
 
+(defalias 'display-blink-cursor-p 'display-graphic-p)
 (defalias 'display-multi-frame-p 'display-graphic-p)
 (defalias 'display-multi-font-p 'display-graphic-p)
 
@@ -2545,7 +2546,7 @@ blink-cursor-mode
   :init-value (not (or noninteractive
 		       no-blinking-cursor
 		       (eq system-type 'ms-dos)
-		       (not (memq window-system '(x w32 ns)))))
+		       (not (display-blink-cursor-p))))
   :initialize 'custom-initialize-delay
   :group 'cursor
   :global t
-- 
2.21.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0003-Define-and-use-new-procedure-display-symbol-keys-p.patch --]
[-- Type: text/x-patch, Size: 3255 bytes --]

From 6d171ce90f42f16f148fae87f083038cc95acf05 Mon Sep 17 00:00:00 2001
From: Alexander Gramiak <agrambot@gmail.com>
Date: Wed, 3 Apr 2019 14:03:28 -0600
Subject: [PATCH 3/4] Define and use new procedure display-symbol-keys-p

* lisp/frame.el (display-symbol-keys-p): Define.

* lisp/simple.el (normal-erase-is-backspace-setup-frame): Use eq
instead of memq.
(normal-erase-is-backspace-mode): Use display-symbol-keys-p.
---
 etc/NEWS       |  5 +++++
 lisp/frame.el  | 10 ++++++++++
 lisp/simple.el |  7 ++++---
 3 files changed, 19 insertions(+), 3 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 7f6aeab73f..1e64c0f15f 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1226,6 +1226,11 @@ the 128...255 range, as expected.
 This allows to create and parent immediately a minibuffer-only child
 frame when making a frame.
 
+*** New predicates 'display-blink-cursor-p' and 'display-symbol-keys-p'.
+These predicates are to be preferred over 'display-graphic-p' when
+testing for blinking cursor capability and the capability to have
+symbols (e.g., [return], [tab], [backspace]) as keys respectively.
+
 ** Tabulated List mode
 
 +++
diff --git a/lisp/frame.el b/lisp/frame.el
index cc8ca49b3b..aa14e87d7b 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -1927,6 +1927,16 @@ display-selections-p
      (t
       nil))))
 
+(defun display-symbol-keys-p (&optional display)
+  "Return non-nil if DISPLAY supports symbol names as keys.
+This means that, for example, DISPLAY can differentiate between
+the keybinding RET and [return]."
+  (let ((frame-type (framep-on-display display)))
+    (or (memq frame-type '(x w32 ns pc))
+        ;; MS-DOS and MS-Windows terminals have built-in support for
+        ;; function (symbol) keys
+        (memq system-type '(ms-dos windows-nt)))))
+
 (declare-function x-display-screens "xfns.c" (&optional terminal))
 
 (defun display-screens (&optional display)
diff --git a/lisp/simple.el b/lisp/simple.el
index 306df96766..857e0fc001 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -8690,7 +8690,7 @@ normal-erase-is-backspace-setup-frame
                (and (not noninteractive)
                     (or (memq system-type '(ms-dos windows-nt))
 			(memq window-system '(w32 ns))
-                        (and (memq window-system '(x))
+                        (and (eq window-system 'x)
                              (fboundp 'x-backspace-delete-keys-p)
                              (x-backspace-delete-keys-p))
                         ;; If the terminal Emacs is running on has erase char
@@ -8701,6 +8701,8 @@ normal-erase-is-backspace-setup-frame
              normal-erase-is-backspace)
            1 0)))))
 
+(declare-function display-symbol-keys-p "frame" (&optional display))
+
 (define-minor-mode normal-erase-is-backspace-mode
   "Toggle the Erase and Delete mode of the Backspace and Delete keys.
 
@@ -8736,8 +8738,7 @@ normal-erase-is-backspace-mode
   (let ((enabled (eq 1 (terminal-parameter
                         nil 'normal-erase-is-backspace))))
 
-    (cond ((or (memq window-system '(x w32 ns pc))
-	       (memq system-type '(ms-dos windows-nt)))
+    (cond ((display-symbol-keys-p)
 	   (let ((bindings
 		  '(([M-delete] [M-backspace])
 		    ([C-M-delete] [C-M-backspace])
-- 
2.21.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0004-Introduce-new-defcustom-for-terminal-CUA-rectangle-c.patch --]
[-- Type: text/x-patch, Size: 2882 bytes --]

From 04766b452e895526f2ca196dad7cf05bab1e61ba Mon Sep 17 00:00:00 2001
From: Alexander Gramiak <agrambot@gmail.com>
Date: Wed, 3 Apr 2019 14:06:45 -0600
Subject: [PATCH 4/4] Introduce new defcustom for terminal CUA rectangle
 commands

This allows a user to set a non-meta modifier for their terminal
should his/her terminal support it. See bug#35058 for background on
this change.

* lisp/emulation/cua-base.el (cua-rectangle-terminal-modifier-key):
New defcustom.

* lisp/emulation/cua-base.el (cua--shift-control-x-prefix): Use new
defcustom.
---
 etc/NEWS                   |  6 ++++++
 lisp/emulation/cua-base.el | 19 ++++++++++++++-----
 2 files changed, 20 insertions(+), 5 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 1e64c0f15f..5c62daf2b9 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1247,6 +1247,12 @@ near the current column in Tabulated Lists (see variables
 +++
 *** 'text-mode-variant' is now obsolete, use 'derived-mode-p' instead.
 
+** CUA mode
+
+*** New defcustom 'cua-rectangle-terminal-modifier-key'
+This defcustom is used instead of forcing the modifier key to
+'meta in a terminal frame.
+
 \f
 * New Modes and Packages in Emacs 27.1
 
diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el
index 302ef12386..105e1ab43d 100644
--- a/lisp/emulation/cua-base.el
+++ b/lisp/emulation/cua-base.el
@@ -427,7 +427,7 @@ cua-rectangle-mark-key
 
 (defcustom cua-rectangle-modifier-key 'meta
   "Modifier key used for rectangle commands bindings.
-On non-window systems, always use the meta modifier.
+On non-window systems, use `cua-rectangle-terminal-modifier-key'.
 Must be set prior to enabling CUA."
   :type '(choice (const :tag "Meta key" meta)
 		 (const :tag "Alt key" alt)
@@ -435,6 +435,16 @@ cua-rectangle-modifier-key
 		 (const :tag "Super key" super))
   :group 'cua)
 
+(defcustom cua-rectangle-terminal-modifier-key 'meta
+  "Modifier key used for rectangle commands bindings in terminals.
+Must be set prior to enabling CUA."
+  :type '(choice (const :tag "Meta key" meta)
+		 (const :tag "Alt key" alt)
+		 (const :tag "Hyper key" hyper)
+		 (const :tag "Super key" super))
+  :group 'cua
+  :version "27.1")
+
 (defcustom cua-enable-rectangle-auto-help t
   "If non-nil, automatically show help for region, rectangle and global mark."
   :type 'boolean
@@ -1237,10 +1247,9 @@ cua--shift-control-x-prefix
 (defun cua--init-keymaps ()
   ;; Cache actual rectangle modifier key.
   (setq cua--rectangle-modifier-key
-	(if (and cua-rectangle-modifier-key
-		 (memq window-system '(x)))
-	    cua-rectangle-modifier-key
-	  'meta))
+	(if (eq (framep (selected-frame)) t)
+	    cua-rectangle-terminal-modifier-key
+	  cua-rectangle-modifier-key))
   ;; C-return always toggles rectangle mark
   (define-key cua-global-keymap cua-rectangle-mark-key	'cua-set-rectangle-mark)
   (unless (eq cua--rectangle-modifier-key 'meta)
-- 
2.21.0