From: miha--- via "Bug reports for GNU Emacs, the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>
To: Eli Zaretskii <eliz@gnu.org>
Cc: 51940@debbugs.gnu.org
Subject: bug#51940: 29.0.50; [PATCH] Fontification and indentation in M-x shell and ielm
Date: Thu, 18 Nov 2021 14:32:52 +0100 [thread overview]
Message-ID: <87pmqxeghn.fsf@miha-pc> (raw)
In-Reply-To: <83ee7dyar2.fsf@gnu.org>
[-- Attachment #1.1: Type: text/plain, Size: 1244 bytes --]
Eli Zaretskii <eliz@gnu.org> writes:
>> Date: Thu, 18 Nov 2021 10:47:37 +0100
>> From: miha--- via "Bug reports for GNU Emacs,
>> the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>
>>
>> Please find the attached patches which enable fontification and
>> indentation in M-x shell and ielm. The main fontification and
>> indentation machinery is implemented in comint.el and should be general
>> enough for use by other comint derived modes. It works by making an
>> indirect buffer, putting it in a suitable major mode (sh-mode in
>> M-x shell buffers, for example) and fontifying and indenting user input
>> that buffer.
>
> Thanks.
>
> One general comment about the doc strings:
>
>> +(defvar-local comint-indirect-setup-function nil
>> + "Function to set up an indirect buffer.
>
> here and elsewhere in the changes, please modify the first sentence of
> the doc strings so that they don't sound too general. "Set up an
> indirect buffer" doesn't hint on the fact that this is for comint
> buffers, not in general about indirect buffers. The same problem
> exists with many doc strings in these patches.
Okay, attached are revised patches with improved doc strings and a fixed
commit message.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: 0001-Implement-a-general-input-fontification-mechanism-fo.patch --]
[-- Type: text/x-patch, Size: 10768 bytes --]
From 6b5a52475642b707c7f0cc0f871f6540d8a0aa73 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Miha=20Rihtar=C5=A1i=C4=8D?= <miha@kamnitnik.top>
Date: Mon, 15 Nov 2021 22:51:51 +0100
Subject: [PATCH 1/5] Implement a general input fontification mechanism for
comint modes
* lisp/comint.el
(comint-indirect-setup-function): New variable for comint derived
major modes to customize.
(comint-fl-mode): New minor mode that fontifies input text through an
indirect buffer.
(comint-indirect-setup-hook):
(comint--indirect-buffer):
(comint--fl-saved-jit-lock-contextually):
(comint--fl-on):
(comint--fl-off):
(comint--fl-ppss-flush-indirect):
(comint--fl-fontify-region):
(comint--intersect-regions):
(comint-indirect-buffer):
(comint--indirect-cleanup): New functions and buffer-local variables.
---
lisp/comint.el | 223 +++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 223 insertions(+)
diff --git a/lisp/comint.el b/lisp/comint.el
index 544f0b8b82..7709178afd 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -1931,6 +1931,7 @@ comint-send-input
(when comint-highlight-input
(add-text-properties beg end
'( font-lock-face comint-highlight-input
+ comint--fl-inhibit-fontification t
front-sticky t )))
(unless comint-use-prompt-regexp
;; Give old user input a field property of `input', to
@@ -4042,6 +4043,228 @@ comint-osc-hyperlink-handler
(cons (point-marker) (match-string-no-properties 1 text)))))
\f
+;;; Input fontification through an indirect buffer
+;;============================================================================
+;;
+;; Modes derived from `comint-mode' can set up fontification input
+;; text with the help of an indirect buffer whose major mode and
+;; font-lock settings are set accordingly.
+
+(defvar-local comint-indirect-setup-function nil
+ "Function to set up an indirect comint fontification buffer.
+This function is called by `comint-indirect-buffer' with zero
+arguments after making an indirect buffer. It is usually set to
+a major-mode command whose font-locking is desired for input
+text. In order to prevent possible mode hooks from running, the
+variable `delay-mode-hooks' is set to t prior to calling this
+function and `change-major-mode-hook' along with
+`after-change-major-mode-hook' are bound to nil.")
+
+(defcustom comint-indirect-setup-hook nil
+ "Hook run after setting up an indirect comint fontification buffer.
+It is run after the indirect buffer is set up for fontification
+of input regions."
+ :group 'comint
+ :type 'hook
+ :version "29.1")
+
+(defvar-local comint--indirect-buffer nil
+ "Indirect buffer used for input fontification.")
+
+(defvar-local comint--fl-saved-jit-lock-contextually nil)
+
+(define-minor-mode comint-fl-mode
+ "Enable input fontification.
+Input fontification happens through an indirect buffer created
+with `comint-indirect-buffer', which see.
+
+This function signals an error if `comint-use-prompt-regexp' is
+non-nil because input fontification isn't compatible with this
+setting."
+ :lighter nil
+ (if comint-fl-mode
+ (let ((success nil))
+ (unwind-protect
+ (progn
+ (comint--fl-on)
+ (setq success t))
+ (unless success
+ (setq comint-fl-mode nil)
+ (comint--fl-off))))
+ (comint--fl-off)))
+
+(defun comint--fl-on ()
+ "Enable input fontification for the current buffer."
+ (comint--fl-off)
+
+ (when comint-use-prompt-regexp
+ (error
+ "Input fontification is incompatible with `comint-use-prompt-regexp'"))
+
+ (add-function :around (local 'font-lock-fontify-region-function)
+ #'comint--fl-fontify-region)
+ ;; `before-change-functions' are only run in the current buffer and
+ ;; not in its indirect buffers, which means that we must manually
+ ;; flush ppss cache
+ (add-hook 'before-change-functions
+ #'comint--fl-ppss-flush-indirect 99 t)
+
+ ;; Set up contextual fontification
+ (unless (booleanp jit-lock-contextually)
+ (setq comint--fl-saved-jit-lock-contextually
+ jit-lock-contextually)
+ (setq-local jit-lock-contextually t)
+ (when jit-lock-mode
+ (jit-lock-mode t))))
+
+(defun comint--fl-off ()
+ "Disable input fontification for the current buffer."
+ (remove-function (local 'font-lock-fontify-region-function)
+ #'comint--fl-fontify-region)
+ (remove-hook 'before-change-functions
+ #'comint--fl-ppss-flush-indirect t)
+
+ ;; Reset contextual fontification
+ (when comint--fl-saved-jit-lock-contextually
+ (setq-local jit-lock-contextually
+ comint--fl-saved-jit-lock-contextually)
+ (setq comint--fl-saved-jit-lock-contextually nil)
+ (when jit-lock-mode
+ (jit-lock-mode t)))
+
+ (font-lock-flush))
+
+(defun comint--fl-ppss-flush-indirect (beg &rest rest)
+ (when-let ((buf (comint-indirect-buffer t)))
+ (with-current-buffer buf
+ (when (memq #'syntax-ppss-flush-cache before-change-functions)
+ (apply #'syntax-ppss-flush-cache beg rest)))))
+
+(defun comint--fl-fontify-region (fun beg end verbose)
+ "Around advice for `font-lock-fontify-region-function'.
+Fontify region between BEG and END. First, highlight it using
+FUN. Then highlight only the input text in the region with the
+help of an indirect buffer. VERBOSE is passed to the
+fontify-region functions. Skip fontification of input regions
+with non-nil `comint--fl-inhibit-fontification' text property."
+ (pcase (funcall fun beg end verbose)
+ (`(jit-lock-bounds ,beg1 . ,end1)
+ (setq beg beg1 end end1)))
+ (pcase
+ (let ((min (point-min))
+ (max (point-max)))
+ (with-current-buffer (comint-indirect-buffer)
+ (narrow-to-region min max)
+ (comint--intersect-regions
+ nil (lambda (beg end)
+ (unless (get-text-property
+ beg 'comint--fl-inhibit-fontification)
+ (font-lock-fontify-region beg end verbose)))
+ beg end)))
+ (`((jit-lock-bounds ,beg1 . ,_) . (jit-lock-bounds ,_ . ,end1))
+ (setq beg (min beg beg1))
+ (setq end (max end end1))))
+
+ `(jit-lock-bounds ,beg . ,end))
+
+(defun comint--intersect-regions (fun-output fun-input beg end)
+ "Iterate over output and input regions between BEG and END.
+Divide the region specified by BEG and END into smaller regions
+that cover either process output (its 'field property is 'output)
+or input (all remaining text). Interchangeably call FUN-OUTPUT on
+each output region, and FUN-INPUT on each input region.
+
+FUN-OUTPUT and FUN-INPUT are passed two arguments, the beginning
+and end of the smaller region. Before calling each function,
+narrow the buffer to the surrounding process output or input. You
+can also pass nil as either function to skip its corresponding
+regions.
+
+Return a cons cell of return values of the first and last
+function called, or nil, if no function was called (if BEG = END)."
+ (let ((beg1 beg)
+ (end1 (copy-marker nil t))
+ (return-beg nil) (return-end nil)
+ (is-output (eq (get-text-property beg 'field) 'output)))
+ (setq end (copy-marker end t))
+
+ (while (< beg1 end)
+ (set-marker
+ end1 (or (if is-output
+ (text-property-not-all beg1 end 'field 'output)
+ (text-property-any beg1 end 'field 'output))
+ end))
+ (when-let ((fun (if is-output fun-output fun-input)))
+ (save-restriction
+ (let ((beg2 beg1)
+ (end2 end1))
+ (when (= beg2 beg)
+ (setq beg2 (field-beginning beg2)))
+ (when (= end2 end)
+ (setq end2 (field-end end2)))
+ ;; Narrow to the whole field surrounding the region
+ (narrow-to-region beg2 end2))
+ (setq return-end (list (funcall fun beg1
+ (marker-position end1)))))
+ (unless return-beg
+ (setq return-beg return-end)))
+ (setq beg1 (marker-position end1))
+ (setq is-output (not is-output)))
+
+ (set-marker end nil)
+ (set-marker end1 nil)
+ (when return-beg
+ (cons (car return-beg) (car return-end)))))
+
+(defun comint-indirect-buffer (&optional no-create)
+ "Return an indirect comint fontification buffer.
+If an indirect buffer for the current buffer already exists,
+return it, otherwise create it first and set it up by calling
+`comint-indirect-setup-function' with zero arguments, turning on
+font-lock, and running `comint-indirect-setup-hook'. This setup
+happens with `delay-mode-hooks' set to t in order to prevent
+possible SETUP-FUN's mode hooks from running.
+
+If an indirect buffer doesn't exist and NO-CREATE is non-nil,
+return nil."
+ (or
+ comint--indirect-buffer
+ (unless no-create
+ (let ((setup-hook
+ (if (local-variable-p 'comint-indirect-setup-hook)
+ (list comint-indirect-setup-hook)))
+ (setup-fun comint-indirect-setup-function))
+
+ (add-hook 'change-major-mode-hook #'comint--indirect-cleanup
+ nil t)
+
+ (with-current-buffer
+ (setq comint--indirect-buffer
+ (make-indirect-buffer
+ (current-buffer)
+ (generate-new-buffer-name
+ (concat " " (buffer-name) "-comint-indirect"))))
+ (setq-local delay-mode-hooks t)
+ (when setup-fun
+ (let ((change-major-mode-hook nil)
+ (after-change-major-mode-hook nil))
+ (funcall setup-fun)))
+ (setq-local font-lock-dont-widen t)
+ (setq-local font-lock-support-mode nil)
+ (font-lock-mode)
+ (when setup-hook
+ (setq-local comint-indirect-setup-hook
+ (car setup-hook)))
+ (run-hooks 'comint-indirect-setup-hook))
+ comint--indirect-buffer))))
+
+(defun comint--indirect-cleanup ()
+ (when comint--indirect-buffer
+ (kill-buffer comint--indirect-buffer)
+ (setq comint--indirect-buffer nil)))
+
+\f
+
;;; Converting process modes to use comint mode
;;============================================================================
;; The code in the Emacs 19 distribution has all been modified to use comint
--
2.34.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.3: 0002-Input-fontification-for-M-x-shell.patch --]
[-- Type: text/x-patch, Size: 3264 bytes --]
From 960dffce408027fd2e20f3b9f9c7e4a35c860833 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Miha=20Rihtar=C5=A1i=C4=8D?= <miha@kamnitnik.top>
Date: Mon, 15 Nov 2021 23:13:03 +0100
Subject: [PATCH 2/5] Input fontification for M-x shell
* lisp/shell.el (shell-comint-fl-enable): New user option to control
input fontification.
(shell-indirect-setup-hook): New hook.
(shell-mode): Set up and enable input fontification.
---
lisp/shell.el | 40 ++++++++++++++++++++++++++++++++++++++++
1 file changed, 40 insertions(+)
diff --git a/lisp/shell.el b/lisp/shell.el
index 370532ea46..a91a59f070 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -306,6 +306,22 @@ shell-input-autoexpand
(const :tag "on" t))
:group 'shell)
+(defcustom shell-comint-fl-enable t
+ "Enable highlighting of input in shell buffers.
+This variable only has effect when the shell is started. Use the
+command `comint-fl-mode' to toggle highlighting of input."
+ :type 'boolean
+ :group 'shell
+ :safe 'booleanp
+ :version "29.1")
+
+(defcustom shell-indirect-setup-hook nil
+ "Hook run after setting up an indirect shell fontification buffer."
+ :type 'boolean
+ :group 'shell
+ :safe 'booleanp
+ :version "29.1")
+
(defvar shell-dirstack nil
"List of directories saved by pushd in this buffer's shell.
Thus, this does not include the shell's current directory.")
@@ -516,6 +532,8 @@ shell-completion-vars
(put 'shell-mode 'mode-class 'special)
+(defvar sh-shell-file)
+
(define-derived-mode shell-mode comint-mode "Shell"
"Major mode for interacting with an inferior shell.
\\<shell-mode-map>
@@ -572,6 +590,11 @@ shell-mode
control whether input and output cause the window to scroll to the end of the
buffer."
:interactive nil
+ :after-hook
+ (and (null comint-use-prompt-regexp)
+ shell-comint-fl-enable
+ (comint-fl-mode))
+
(setq comint-prompt-regexp shell-prompt-pattern)
(shell-completion-vars)
(setq-local paragraph-separate "\\'")
@@ -591,6 +614,19 @@ shell-mode
(setq-local ansi-color-apply-face-function #'shell-apply-ansi-color)
(shell-reapply-ansi-color)
+ (add-hook 'comint-indirect-setup-hook
+ #'shell-indirect-setup-hook 'append t)
+ (setq comint-indirect-setup-function
+ (let ((shell shell--start-prog))
+ (lambda ()
+ (require 'sh-script)
+ (cl-letf
+ (((default-value 'sh-shell-file)
+ (or shell sh-shell-file))
+ (inhibit-message t)
+ (message-log-max nil))
+ (sh-mode)))))
+
;; This is not really correct, since the shell buffer does not really
;; edit this directory. But it is useful in the buffer list and menus.
(setq list-buffers-directory (expand-file-name default-directory))
@@ -645,6 +681,10 @@ shell-mode
": [[:digit:]]+:[[:digit:]]+;")))
(comint-read-input-ring t)))
+(defun shell-indirect-setup-hook ()
+ "Run `shell-indirect-setup-hook'."
+ (run-hooks 'shell-indirect-setup-hook))
+
(defun shell-apply-ansi-color (beg end face)
"Apply FACE as the ansi-color face for the text between BEG and END."
(when face
--
2.34.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.4: 0003-Input-fontification-for-M-x-ielm.patch --]
[-- Type: text/x-patch, Size: 2453 bytes --]
From 2ec0286b5697bfc469afcc8e915e2c090b06f5fb Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Miha=20Rihtar=C5=A1i=C4=8D?= <miha@kamnitnik.top>
Date: Mon, 15 Nov 2021 23:16:23 +0100
Subject: [PATCH 3/5] Input fontification for M-x ielm
* lisp/ielm.el (ielm-comint-fl-enable): New user option to control
input fontification.
(ielm-indirect-setup-hook): New hook.
(inferior-emacs-lisp-mode): Set up and enable input fontification.
---
lisp/ielm.el | 28 ++++++++++++++++++++++++++++
1 file changed, 28 insertions(+)
diff --git a/lisp/ielm.el b/lisp/ielm.el
index 39820a893a..d792bd871d 100644
--- a/lisp/ielm.el
+++ b/lisp/ielm.el
@@ -472,6 +472,26 @@ ielm-set-pm
;; Set the process mark in the current buffer to POS.
(set-marker (process-mark (get-buffer-process (current-buffer))) pos))
+;;; Input fontification
+
+(defcustom ielm-comint-fl-enable t
+ "Enable highlighting of input in ielm buffers.
+This variable only has effect when the shell is started. Use the
+command `comint-fl-mode' to toggle highlighting of input."
+ :type 'boolean
+ :safe 'booleanp
+ :version "29.1")
+
+(defcustom ielm-indirect-setup-hook nil
+ "Hook run after setting up an indirect ielm fontification buffer."
+ :type 'boolean
+ :safe 'booleanp
+ :version "29.1")
+
+(defun ielm-indirect-setup-hook ()
+ "Run `ielm-indirect-setup-hook'."
+ (run-hooks 'ielm-indirect-setup-hook))
+
;;; Major mode
(define-derived-mode inferior-emacs-lisp-mode comint-mode "IELM"
@@ -526,6 +546,10 @@ inferior-emacs-lisp-mode
Customized bindings may be defined in `ielm-map', which currently contains:
\\{ielm-map}"
:syntax-table emacs-lisp-mode-syntax-table
+ :after-hook
+ (and (null comint-use-prompt-regexp)
+ ielm-comint-fl-enable
+ (comint-fl-mode))
(setq comint-prompt-regexp (concat "^" (regexp-quote ielm-prompt)))
(setq-local paragraph-separate "\\'")
@@ -564,6 +588,10 @@ inferior-emacs-lisp-mode
(setq-local font-lock-defaults
'(ielm-font-lock-keywords nil nil ((?: . "w") (?- . "w") (?* . "w"))))
+ (add-hook 'comint-indirect-setup-hook
+ #'ielm-indirect-setup-hook 'append t)
+ (setq comint-indirect-setup-function #'emacs-lisp-mode)
+
;; A dummy process to keep comint happy. It will never get any input
(unless (comint-check-proc (current-buffer))
;; Was cat, but on non-Unix platforms that might not exist, so
--
2.34.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.5: 0004-Highlight-non-existent-commands-in-M-x-shell.patch --]
[-- Type: text/x-patch, Size: 11057 bytes --]
From a30796d8bafd3cea96f58339a4258ad25890f683 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Miha=20Rihtar=C5=A1i=C4=8D?= <miha@kamnitnik.top>
Date: Mon, 15 Nov 2021 23:21:03 +0100
Subject: [PATCH 4/5] Highlight non-existent commands in M-x shell
* lisp/shell.el (shell-mode): Enable highlighting of non-existent
commands if requested.
(shell-highlight-undef-aliases):
(shell-highlight-undef-remote-file-name-inhibit-cache): New user
options.
(shell-highlight-undef-mode): New minor mode.
(shell-highlight-undef-defined-face):
(shell-highlight-undef-undefined-face):
(shell-highlight-undef-alias-face): New faces.
(shell-highlight-undef--exec-cache):
(shell-highlight-undef--face):
(shell-highlight-undef-keywords):
(shell-highlight-undef-regexp):
(shell-highlight-undef--executable-find):
(shell-highlight-undef-matcher):
(shell-highlight-undef--indirect):
(shell-highlight--setup):
(shell-highlight-undef-reset-mode): New functions and buffer local
variables.
---
lisp/shell.el | 227 +++++++++++++++++++++++++++++++++++++++++++++++++-
1 file changed, 224 insertions(+), 3 deletions(-)
diff --git a/lisp/shell.el b/lisp/shell.el
index a91a59f070..274716f68a 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -322,6 +322,16 @@ shell-indirect-setup-hook
:safe 'booleanp
:version "29.1")
+(defcustom shell-highlight-undef-enable nil
+ "Enable highlighting of undefined commands in shell buffers.
+This variable only has effect when the shell is started. Use the
+command `shell-highlight-undef-mode' to toggle highlighting of
+undefined commands."
+ :type 'boolean
+ :group 'shell
+ :safe 'booleanp
+ :version "29.1")
+
(defvar shell-dirstack nil
"List of directories saved by pushd in this buffer's shell.
Thus, this does not include the shell's current directory.")
@@ -591,9 +601,11 @@ shell-mode
buffer."
:interactive nil
:after-hook
- (and (null comint-use-prompt-regexp)
- shell-comint-fl-enable
- (comint-fl-mode))
+ (unless comint-use-prompt-regexp
+ (if shell-comint-fl-enable
+ (comint-fl-mode))
+ (if shell-highlight-undef-enable
+ (shell-highlight-undef-mode)))
(setq comint-prompt-regexp shell-prompt-pattern)
(shell-completion-vars)
@@ -1471,6 +1483,215 @@ shell-narrow-to-prompt
(point-max)
(shell--prompt-begin-position))))))
+;;; Highlight undefined commands
+;;
+;; To highlight non-existent commands, customize
+;; `shell-highlight-undef-enable' to t. To highlight some commands as
+;; aliases, add them to `shell-highlight-undef-aliases'.
+
+(defcustom shell-highlight-undef-aliases nil
+ "List of commands to highlight as a command alias."
+ :group 'shell
+ :type '(repeat string)
+ :version "29.1")
+
+(defface shell-highlight-undef-defined-face
+ '((t :inherit 'font-lock-function-name-face))
+ "Face used for existent commands."
+ :group 'shell
+ :version "29.1")
+
+(defface shell-highlight-undef-undefined-face
+ '((t :inherit 'font-lock-warning-face))
+ "Face used for non-existent commands."
+ :group 'shell
+ :version "29.1")
+
+(defface shell-highlight-undef-alias-face
+ '((t :inherit 'font-lock-variable-name-face))
+ "Face used for command aliases."
+ :group 'shell
+ :version "29.1")
+
+(defcustom shell-highlight-undef-remote-file-name-inhibit-cache nil
+ "Whether to use cache for finding remote executables.
+See `remote-file-name-inhibit-cache' for description."
+ :group 'faces
+ :type '(choice
+ (const :tag "Do not inhibit file name cache" nil)
+ (const :tag "Do not use file name cache" t)
+ (integer :tag "Do not use file name cache"
+ :format "Do not use file name cache older than %v seconds"
+ :value 10))
+ :version "29.1")
+
+(defvar shell--highlight-undef-exec-cache nil
+ "Cache of executable files found in `exec-path'.
+An alist, whose elements are of the form
+\(REMOTE TIME EXECUTABLES), where REMOTE is a string, returned by
+`file-remote-p', TIME is the return value of `float-time' end
+EXECUTABLES is a hash table with keys being the base-names of
+executable files.
+
+Cache expiry is controlled by the user option
+`remote-file-name-inhibit-cache'.")
+
+(defvar shell--highlight-undef-face 'shell-highlight-undef-defined-face)
+
+(defvar shell-highlight-undef-keywords
+ `((,#'shell-highlight-undef-matcher 6 shell--highlight-undef-face)))
+
+(defvar-local shell-highlight-undef-regexp regexp-unmatchable)
+
+(defun shell--highlight-undef-executable-find (command)
+ "Return non-nil if COMMAND is found in `exec-path'.
+Similar to `executable-find', but use cache stored in
+`shell--highlight-undef-exec-cache'."
+ (let ((remote (file-remote-p default-directory))
+ as ret found-in-cache delta-time)
+ (if (null remote)
+ (executable-find command)
+
+ (setq delta-time
+ shell-highlight-undef-remote-file-name-inhibit-cache)
+
+ (pcase (setq as (assoc remote shell--highlight-undef-exec-cache))
+ (`(,_ ,time ,hash)
+ (when (pcase delta-time
+ ((pred numberp) (<= (float-time) (+ time delta-time)))
+ ('t nil)
+ ('nil t))
+ (setq ret (gethash command hash))
+ (setq found-in-cache t)))
+ (_ (setq as (list remote 0 (make-hash-table :test #'equal)))
+ (push as shell--highlight-undef-exec-cache)))
+
+ (if found-in-cache
+ ret
+ ;; Build cache
+ (setcar (cdr as) (float-time))
+ (let ((hash (clrhash (caddr as))))
+ (dolist (dir (exec-path))
+ (pcase-dolist (`(,f . ,attr)
+ (condition-case nil
+ (directory-files-and-attributes
+ (concat remote dir) nil nil 'nosort 'integer)
+ (file-error nil)))
+ ;; Approximation. Assume every non-directory file in $PATH is an
+ ;; executable. Alternatively, we could check
+ ;; `file-executable-p', but doing so for every file in $PATH is
+ ;; slow on remote machines.
+ (unless (eq t (file-attribute-type attr))
+ (puthash f t hash))))
+ (gethash command hash))))))
+
+(defun shell-highlight-undef-matcher (end)
+ "Matcher used to highlight commands up to END."
+ (when (re-search-forward shell-highlight-undef-regexp end t)
+ (save-match-data
+ (let ((cmd (match-string 6))
+ (beg (match-beginning 6)))
+ (setq shell--highlight-undef-face
+ (let* ((buf (buffer-base-buffer))
+ (default-directory
+ (if buf (buffer-local-value 'default-directory buf)
+ default-directory)))
+ (cond
+ ;; Don't highlight command output. Mostly useful if
+ ;; `comint-fl-mode' is disabled.
+ ((text-property-any beg (point) 'field 'output)
+ nil)
+ ((member cmd shell-highlight-undef-aliases)
+ 'shell-highlight-undef-alias-face)
+ ;; Check if it contains a directory separator
+ ((file-name-directory cmd)
+ (when (file-name-absolute-p cmd)
+ (setq cmd (concat
+ (or (bound-and-true-p comint-file-name-prefix)
+ (file-remote-p default-directory))
+ cmd)))
+ (if (or (file-executable-p cmd)
+ (file-directory-p cmd))
+ 'shell-highlight-undef-defined-face
+ 'shell-highlight-undef-undefined-face))
+ ((shell--highlight-undef-executable-find cmd)
+ 'shell-highlight-undef-defined-face)
+ (t 'shell-highlight-undef-undefined-face))))))
+ t))
+
+(defvar-local shell--highlight-undef-indirect nil
+ "Whether we are using a `comint-fl-mode' indirect buffer.")
+
+(declare-function sh-feature "sh-script" (alist &optional function))
+(defvar sh-leading-keywords)
+(defvar sh-other-keywords)
+
+(define-minor-mode shell-highlight-undef-mode
+ "Highlight undefined shell commands and aliases."
+ :init-value nil
+ (if shell--highlight-undef-indirect
+ (progn
+ (setq shell--highlight-undef-indirect nil)
+ (when-let ((buf (comint-indirect-buffer t)))
+ (with-current-buffer buf
+ (font-lock-remove-keywords nil shell-highlight-undef-keywords))))
+ (font-lock-remove-keywords nil shell-highlight-undef-keywords))
+ (remove-hook 'comint-fl-mode-hook
+ #'shell-highlight-undef-reset-mode t)
+ (remove-hook 'comint-indirect-setup-hook #'shell--highlight-undef-setup t)
+
+ (when shell-highlight-undef-mode
+ (when comint-use-prompt-regexp
+ (setq shell-highlight-undef-mode nil)
+ (error
+ "`shell-highlight-undef-mode' is incompatible with `comint-use-prompt-regexp'"))
+
+ (require 'sh-script)
+
+ (let ((regexp
+ ;; Adapted from `sh-font-lock-keywords-1'
+ (concat
+ "\\("
+ "[;(){}`|&]"
+ (if comint-fl-mode
+ ;; `comint-fl-mode' already puts point-min on end of
+ ;; prompt
+ ""
+ (concat "\\|" comint-prompt-regexp))
+ "\\|^"
+ "\\)"
+ "[ \t]*\\(\\("
+ (regexp-opt (sh-feature sh-leading-keywords) t)
+ "[ \t]+\\)?"
+ (regexp-opt (append (sh-feature sh-leading-keywords)
+ (sh-feature sh-other-keywords))
+ t)
+ "[ \t]+\\)?\\_<\\(\\(?:\\s_\\|\\sw\\|/\\)+\\)\\_>")))
+ (cond (comint-fl-mode
+ (setq shell--highlight-undef-indirect t)
+ (if-let ((buf (comint-indirect-buffer t)))
+ (with-current-buffer buf
+ (shell--highlight-undef-setup regexp))
+ (add-hook 'comint-indirect-setup-hook
+ (lambda ()
+ (shell--highlight-undef-setup regexp))
+ nil t)))
+ (t (shell--highlight-undef-setup regexp))))
+
+ (add-hook 'comint-fl-mode-hook
+ #'shell-highlight-undef-reset-mode nil t))
+
+ (font-lock-flush))
+
+(defun shell--highlight-undef-setup (regexp)
+ (font-lock-add-keywords nil shell-highlight-undef-keywords t)
+ (setq shell-highlight-undef-regexp regexp))
+
+(defun shell-highlight-undef-reset-mode ()
+ "If `shell-highlight-undef-mode' is on, turn it off and on."
+ (when shell-highlight-undef-mode
+ (shell-highlight-undef-mode 1)))
+
(provide 'shell)
;;; shell.el ends here
--
2.34.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.6: 0005-Input-indentation-for-M-x-shell.patch --]
[-- Type: text/x-patch, Size: 6757 bytes --]
From 7fb17ea46239f514b43ac179b17f76a31bee6650 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Miha=20Rihtar=C5=A1i=C4=8D?= <miha@kamnitnik.top>
Date: Mon, 15 Nov 2021 23:37:36 +0100
Subject: [PATCH 5/5] Input indentation for M-x shell
* lisp/comint.el
(comint-indent-input-line):
(comint-indent-input-line-default):
(comint-indent-input-region):
(comint-indent-input-region-default): New functions that implement a
general mechanism for input indentation through an indirect buffer in
comint derived major modes.
* lisp/shell.el (shell-mode): Set up input indentation according to
sh-mode.
---
lisp/comint.el | 93 +++++++++++++++++++++++++++++++++++++++++++++-----
lisp/shell.el | 4 +++
2 files changed, 89 insertions(+), 8 deletions(-)
diff --git a/lisp/comint.el b/lisp/comint.el
index 7709178afd..0d115e7c70 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -4043,21 +4043,21 @@ comint-osc-hyperlink-handler
(cons (point-marker) (match-string-no-properties 1 text)))))
\f
-;;; Input fontification through an indirect buffer
+;;; Input fontification and indentation through an indirect buffer
;;============================================================================
;;
-;; Modes derived from `comint-mode' can set up fontification input
-;; text with the help of an indirect buffer whose major mode and
-;; font-lock settings are set accordingly.
+;; Modes derived from `comint-mode' can set up fontification and
+;; indentation of input text with the help of an indirect buffer whose
+;; major mode and font-lock settings are set accordingly.
(defvar-local comint-indirect-setup-function nil
"Function to set up an indirect comint fontification buffer.
This function is called by `comint-indirect-buffer' with zero
arguments after making an indirect buffer. It is usually set to
-a major-mode command whose font-locking is desired for input
-text. In order to prevent possible mode hooks from running, the
-variable `delay-mode-hooks' is set to t prior to calling this
-function and `change-major-mode-hook' along with
+a major-mode command whose font-locking and indentation are
+desired for input text. In order to prevent possible mode hooks
+from running, the variable `delay-mode-hooks' is set to t prior
+to calling this function and `change-major-mode-hook' along with
`after-change-major-mode-hook' are bound to nil.")
(defcustom comint-indirect-setup-hook nil
@@ -4216,6 +4216,83 @@ comint--intersect-regions
(when return-beg
(cons (car return-beg) (car return-end)))))
+(defun comint-indent-input-line (fun)
+ "Indent current process output or input line.
+If point is on output, call FUN, otherwise indent the current
+line in the indirect buffer created by `comint-indirect-buffer',
+which see."
+ (if (or comint-use-prompt-regexp
+ (eq (get-text-property (point) 'field) 'output))
+ (funcall fun)
+ (let ((point (point))
+ (min (point-min))
+ (max (point-max)))
+ (unwind-protect
+ (with-current-buffer (comint-indirect-buffer)
+ (narrow-to-region min max)
+ (goto-char point)
+ (narrow-to-region (field-beginning) (field-end))
+ (unwind-protect (funcall indent-line-function)
+ (setq point (point))))
+ (goto-char point)))))
+
+(defun comint-indent-input-region (fun start end)
+ "Indent process output and input regions between START and END.
+Output text between START and END is indented with FUN and input
+text is indented in the indirect buffer created by
+`comint-indirect-buffer', which see."
+ (if comint-use-prompt-regexp
+ (funcall fun start end)
+ (let ((opoint (copy-marker (point)))
+ final-point)
+ (unwind-protect
+ (comint--intersect-regions
+ (lambda (start end)
+ (goto-char opoint)
+ (if (= opoint (point))
+ (unwind-protect (funcall fun start end)
+ (setq final-point (copy-marker (point))))
+ (funcall fun start end)))
+ (lambda (start end)
+ (let ((min (point-min))
+ (max (point-max))
+ (final-point1 nil))
+ (unwind-protect
+ (with-current-buffer (comint-indirect-buffer)
+ (narrow-to-region min max)
+ (goto-char opoint)
+ (if (= opoint (point))
+ (unwind-protect
+ (funcall indent-region-function start end)
+ (setq final-point1 (point)))
+ (funcall indent-region-function start end)))
+ (when final-point1
+ (setq final-point (copy-marker final-point1))))))
+ start end)
+ (if final-point
+ (progn
+ (goto-char final-point)
+ (set-marker final-point nil))
+ (goto-char opoint))
+ (set-marker opoint nil)))))
+
+(defun comint-indent-input-line-default ()
+ "Indent current process output or input line.
+If point is on output, indent the current line according to the
+default value of `indent-line-function', otherwise indent the
+current line in the indirect buffer created by
+`comint-indirect-buffer', which see."
+ (comint-indent-input-line (default-value 'indent-line-function)))
+
+(defun comint-indent-input-region-default (start end)
+ "Indent process output and input regions between START and END.
+Output text between START and END is indented according to the
+default value of `indent-region-function' and input text is
+indented in the indirect buffer created by
+`comint-indirect-buffer', which see."
+ (comint-indent-input-region (default-value 'indent-line-function)
+ start end))
+
(defun comint-indirect-buffer (&optional no-create)
"Return an indirect comint fontification buffer.
If an indirect buffer for the current buffer already exists,
diff --git a/lisp/shell.el b/lisp/shell.el
index 274716f68a..0662b77c55 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -639,6 +639,10 @@ shell-mode
(message-log-max nil))
(sh-mode)))))
+ (setq-local indent-line-function #'comint-indent-input-line-default)
+ (setq-local indent-region-function
+ #'comint-indent-input-region-default)
+
;; This is not really correct, since the shell buffer does not really
;; edit this directory. But it is useful in the buffer list and menus.
(setq list-buffers-directory (expand-file-name default-directory))
--
2.34.0
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 861 bytes --]
next prev parent reply other threads:[~2021-11-18 13:32 UTC|newest]
Thread overview: 6+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-11-18 9:47 bug#51940: 29.0.50; [PATCH] Fontification and indentation in M-x shell and ielm miha--- via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-11-18 11:16 ` Eli Zaretskii
2021-11-18 13:32 ` miha--- via Bug reports for GNU Emacs, the Swiss army knife of text editors [this message]
2021-11-25 10:42 ` Eli Zaretskii
2021-11-28 12:20 ` miha--- via Bug reports for GNU Emacs, the Swiss army knife of text editors
2022-09-09 18:14 ` Lars Ingebrigtsen
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87pmqxeghn.fsf@miha-pc \
--to=bug-gnu-emacs@gnu.org \
--cc=51940@debbugs.gnu.org \
--cc=eliz@gnu.org \
--cc=miha@kamnitnik.top \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.