mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-26 07:33:47 +00:00
Extract support of OSC escape sequences from comint
* lisp/comint.el (osc): Now requires osc.el. (comint-osc-directory-tracker): Alias to osc-directory-tracker. (comint-osc-hyperlink-handler): Alias to osc-hyperlink-handler. (comint-osc-hyperlink-map): Alias to osc-hyperlink-map. (comint-osc-handlers): Alias to osc-handlers. (comint-osc-hyperlink): Alias to osc-hyperlink. (comint-osc-process-output): Rewritten to call osc-apply-on-region. * lisp/osc.el (osc-handlers): Clone comint-osc-handlers. (osc--marker): Clone comint-osc--marker. (osc-apply-on-region): Implementation taken from comint-osc-process-output. (osc-directory-tracker): Clone from comint-osc-directory-tracker. (osc-hyperlink-map): Clone from comint-osc-hyperlink-map. (osc-hyperlink): Clone from comint-osc-hyperlink. (osc-hyperlink--state): Clone from comint-osc-hyperlink--state. (osc-hyperlink-handler): Clone from comint-osc-hyperlink-handler. * test/lisp/osc-tests.el (osc): Test osc-apply-region (bug#57821).
This commit is contained in:
Matthias Meulien
Lars Ingebrigtsen
parent
39cc0c2f23
commit
7354f4e3e6
@ -103,6 +103,7 @@
|
||||
|
||||
(require 'ring)
|
||||
(require 'ansi-color)
|
||||
(require 'osc)
|
||||
(require 'regexp-opt) ;For regexp-opt-charset.
|
||||
(eval-when-compile (require 'subr-x))
|
||||
|
||||
@ -3914,12 +3915,12 @@ REGEXP-GROUP is the regular expression group in REGEXP to use."
|
||||
;; to `comint-osc-handlers' allows a customized treatment of further
|
||||
;; sequences.
|
||||
|
||||
(defvar-local comint-osc-handlers '(("7" . comint-osc-directory-tracker)
|
||||
("8" . comint-osc-hyperlink-handler))
|
||||
"Alist of handlers for OSC escape sequences.
|
||||
See `comint-osc-process-output' for details.")
|
||||
|
||||
(defvar-local comint-osc--marker nil)
|
||||
;; Aliases defined for reverse compatibility
|
||||
(defalias 'comint-osc-handlers 'osc-handlers)
|
||||
(defalias 'comint-osc-directory-tracker 'osc-directory-tracker)
|
||||
(defalias 'comint-osc-hyperlink-handler 'osc-hyperlink-handler)
|
||||
(defalias 'comint-osc-hyperlink 'osc-hyperlink)
|
||||
(defalias 'comint-osc-hyperlink-map 'osc-hyperlink-map)
|
||||
|
||||
(defun comint-osc-process-output (_)
|
||||
"Interpret OSC escape sequences in comint output.
|
||||
@ -3935,81 +3936,10 @@ removed from the buffer. Then, if `command' is a key of the
|
||||
`comint-osc-handlers' alist, the corresponding value, which
|
||||
should be a function, is called with `command' and `text' as
|
||||
arguments, with point where the escape sequence was located."
|
||||
(let ((bound (process-mark (get-buffer-process (current-buffer)))))
|
||||
(save-excursion
|
||||
;; Start one char before last output to catch a possibly stray ESC
|
||||
(goto-char (or comint-osc--marker (1- comint-last-output-start)))
|
||||
(when (eq (char-before) ?\e) (backward-char))
|
||||
(while (re-search-forward "\e]" bound t)
|
||||
(let ((pos0 (match-beginning 0))
|
||||
(code (and (re-search-forward "\\=\\([0-9A-Za-z]*\\);" bound t)
|
||||
(match-string 1)))
|
||||
(pos1 (point)))
|
||||
(if (re-search-forward "\a\\|\e\\\\" bound t)
|
||||
(let ((text (buffer-substring-no-properties
|
||||
pos1 (match-beginning 0))))
|
||||
(setq comint-osc--marker nil)
|
||||
(delete-region pos0 (point))
|
||||
(when-let ((fun (cdr (assoc-string code comint-osc-handlers))))
|
||||
(funcall fun code text)))
|
||||
(put-text-property pos0 bound 'invisible t)
|
||||
(setq comint-osc--marker (copy-marker pos0))))))))
|
||||
|
||||
;; Current directory tracking (OSC 7)
|
||||
|
||||
(declare-function url-host "url/url-parse.el")
|
||||
(declare-function url-type "url/url-parse.el")
|
||||
(declare-function url-filename "url/url-parse.el")
|
||||
(defun comint-osc-directory-tracker (_ text)
|
||||
"Update `default-directory' from OSC 7 escape sequences.
|
||||
|
||||
This function is intended to be included as an entry of
|
||||
`comint-osc-handlers'. You should moreover arrange for your
|
||||
shell to print the appropriate escape sequence at each prompt,
|
||||
say with the following command:
|
||||
|
||||
printf \"\\e]7;file://%s%s\\e\\\\\" \"$HOSTNAME\" \"$PWD\"
|
||||
|
||||
This functionality serves as an alternative to `dirtrack-mode'
|
||||
and `shell-dirtrack-mode'."
|
||||
(let ((url (url-generic-parse-url text)))
|
||||
(when (and (string= (url-type url) "file")
|
||||
(or (null (url-host url))
|
||||
(string= (url-host url) (system-name))))
|
||||
(ignore-errors
|
||||
(cd-absolute (url-unhex-string (url-filename url)))))))
|
||||
|
||||
;; Hyperlink handling (OSC 8)
|
||||
|
||||
(defvar comint-osc-hyperlink-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map "\C-c\r" 'browse-url-button-open)
|
||||
(define-key map [mouse-2] 'browse-url-button-open)
|
||||
(define-key map [follow-link] 'mouse-face)
|
||||
map)
|
||||
"Keymap used by OSC 8 hyperlink buttons.")
|
||||
|
||||
(define-button-type 'comint-osc-hyperlink
|
||||
'keymap comint-osc-hyperlink-map
|
||||
'help-echo (lambda (_ buffer pos)
|
||||
(when-let ((url (get-text-property pos 'browse-url-data buffer)))
|
||||
(format "mouse-2, C-c RET: Open %s" url))))
|
||||
|
||||
(defvar-local comint-osc-hyperlink--state nil)
|
||||
|
||||
(defun comint-osc-hyperlink-handler (_ text)
|
||||
"Create a hyperlink from an OSC 8 escape sequence.
|
||||
This function is intended to be included as an entry of
|
||||
`comint-osc-handlers'."
|
||||
(when comint-osc-hyperlink--state
|
||||
(let ((start (car comint-osc-hyperlink--state))
|
||||
(url (cdr comint-osc-hyperlink--state)))
|
||||
(make-text-button start (point)
|
||||
'type 'comint-osc-hyperlink
|
||||
'browse-url-data url)))
|
||||
(setq comint-osc-hyperlink--state
|
||||
(and (string-match ";\\(.+\\)" text)
|
||||
(cons (point-marker) (match-string-no-properties 1 text)))))
|
||||
(let ((start (1- comint-last-output-start))
|
||||
;; Start one char before last output to catch a possibly stray ESC
|
||||
(bound (process-mark (get-buffer-process (current-buffer)))))
|
||||
(osc-apply-on-region start bound)))
|
||||
|
||||
|
||||
;;; Input fontification and indentation through an indirect buffer
|
||||
|
||||
127
lisp/osc.el
Normal file
127
lisp/osc.el
Normal file
@ -0,0 +1,127 @@
|
||||
;;; osc.el --- Support for OSC escape sequences -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2022 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Augusto Stoffel <arstoffel@gmail.com>
|
||||
;; Matthias Meulien <orontee@gmail.com>
|
||||
;; Maintainer: emacs-devel@gnu.org
|
||||
;; Keywords: processes, terminals, services
|
||||
|
||||
;; This program 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.
|
||||
|
||||
;; This program 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 this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Interpretation of OSC (Operating System Commands) escape
|
||||
;; sequences. Handlers for OSC 7 and 8 (for current directory and
|
||||
;; hyperlinks respectively) are provided.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(defvar-local osc-handlers '(("7" . osc-directory-tracker)
|
||||
("8" . osc-hyperlink-handler))
|
||||
"Alist of handlers for OSC escape sequences.
|
||||
See `osc-apply-on-region' for details.")
|
||||
|
||||
(defvar-local osc--marker nil)
|
||||
;; The function `osc-apply-on-region' can set `osc--marker' to the start
|
||||
;; position of an escape sequence without termination.
|
||||
|
||||
(defun osc-apply-on-region (begin end)
|
||||
"Interpret OSC escape sequences in region.
|
||||
This function search for escape sequences of the forms
|
||||
|
||||
ESC ] command ; text BEL
|
||||
ESC ] command ; text ESC \\
|
||||
|
||||
Every occurrence of such escape sequences is removed from the
|
||||
buffer. Then, if `command' is a key of the local variable
|
||||
`osc-handlers' alist, the corresponding value, which should be a
|
||||
function, is called with `command' and `text' as arguments, with
|
||||
point where the escape sequence was located."
|
||||
(save-excursion
|
||||
(goto-char (or osc--marker begin))
|
||||
(when (eq (char-before) ?\e) (backward-char))
|
||||
(while (re-search-forward "\e]" end t)
|
||||
(let ((pos0 (match-beginning 0))
|
||||
(code (and (re-search-forward "\\=\\([0-9A-Za-z]*\\);" end t)
|
||||
(match-string 1)))
|
||||
(pos1 (point)))
|
||||
(if (re-search-forward "\a\\|\e\\\\" end t)
|
||||
(let ((text (buffer-substring-no-properties
|
||||
pos1 (match-beginning 0))))
|
||||
(setq osc--marker nil)
|
||||
(delete-region pos0 (point))
|
||||
(when-let ((fun (cdr (assoc-string code osc-handlers))))
|
||||
(funcall fun code text)))
|
||||
(put-text-property pos0 end 'invisible t)
|
||||
(setq osc--marker (copy-marker pos0)))))))
|
||||
|
||||
;; Current directory tracking (OSC 7)
|
||||
|
||||
(declare-function url-host "url/url-parse.el")
|
||||
(declare-function url-type "url/url-parse.el")
|
||||
(declare-function url-filename "url/url-parse.el")
|
||||
(defun osc-directory-tracker (_ text)
|
||||
"Update `default-directory' from OSC 7 escape sequences.
|
||||
|
||||
This function is intended to be included as an entry of
|
||||
`osc-handlers'. You should moreover arrange for your shell to
|
||||
print the appropriate escape sequence at each prompt, say with
|
||||
the following command:
|
||||
|
||||
printf \"\\e]7;file://%s%s\\e\\\\\" \"$HOSTNAME\" \"$PWD\"
|
||||
|
||||
This functionality serves as an alternative to `dirtrack-mode'
|
||||
and `shell-dirtrack-mode'."
|
||||
(let ((url (url-generic-parse-url text)))
|
||||
(when (and (string= (url-type url) "file")
|
||||
(or (null (url-host url))
|
||||
(string= (url-host url) (system-name))))
|
||||
(ignore-errors
|
||||
(cd-absolute (url-unhex-string (url-filename url)))))))
|
||||
|
||||
;; Hyperlink handling (OSC 8)
|
||||
|
||||
(defvar osc-hyperlink-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map "\C-c\r" 'browse-url-button-open)
|
||||
(define-key map [mouse-2] 'browse-url-button-open)
|
||||
(define-key map [follow-link] 'mouse-face)
|
||||
map)
|
||||
"Keymap used by OSC 8 hyperlink buttons.")
|
||||
|
||||
(define-button-type 'osc-hyperlink
|
||||
'keymap osc-hyperlink-map
|
||||
'help-echo (lambda (_ buffer pos)
|
||||
(when-let ((url (get-text-property pos 'browse-url-data buffer)))
|
||||
(format "mouse-2, C-c RET: Open %s" url))))
|
||||
|
||||
(defvar-local osc-hyperlink--state nil)
|
||||
|
||||
(defun osc-hyperlink-handler (_ text)
|
||||
"Create a hyperlink from an OSC 8 escape sequence.
|
||||
This function is intended to be included as an entry of
|
||||
`osc-handlers'."
|
||||
(when osc-hyperlink--state
|
||||
(let ((start (car osc-hyperlink--state))
|
||||
(url (cdr osc-hyperlink--state)))
|
||||
(make-text-button start (point)
|
||||
'type 'osc-hyperlink
|
||||
'browse-url-data url)))
|
||||
(setq osc-hyperlink--state
|
||||
(and (string-match ";\\(.+\\)" text)
|
||||
(cons (point-marker) (match-string-no-properties 1 text)))))
|
||||
|
||||
(provide 'osc)
|
||||
;;; osc.el ends here
|
||||
57
test/lisp/osc-tests.el
Normal file
57
test/lisp/osc-tests.el
Normal file
@ -0,0 +1,57 @@
|
||||
;;; osc-tests.el --- Tests for osc.el -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2022 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Matthias Meulien <orontee@gmail.com>
|
||||
;; Keywords:
|
||||
|
||||
;; 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 <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;;
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'osc)
|
||||
(require 'ert)
|
||||
|
||||
(defvar osc-tests--strings
|
||||
`(
|
||||
("Hello World" "Hello World")
|
||||
|
||||
;; window title
|
||||
("Buffer \e]2;A window title\e\\content" "Buffer content")
|
||||
|
||||
;; window title
|
||||
("Unfinished \e]2;window title" "Unfinished \e]2;window title")
|
||||
|
||||
;; current directory
|
||||
("\e]7;file://127.0.0.1/tmp\e\\user@host$ " "user@host$ ")
|
||||
|
||||
;; hyperlink
|
||||
("\e]8;;http://example.com\e\\This is a link\e]8;;\e\\" "This is a link")
|
||||
))
|
||||
;; Don't output those strings to stdout since they may have
|
||||
;; side-effects on the environment
|
||||
|
||||
(ert-deftest osc-tests-apply-region-no-handlers ()
|
||||
(let ((osc-handlers nil))
|
||||
(pcase-dolist (`(,input ,text) osc-tests--strings)
|
||||
(with-temp-buffer
|
||||
(insert input)
|
||||
(osc-apply-on-region (point-min) (point-max))
|
||||
(should (equal (buffer-string) text))))))
|
||||
Loading…
Reference in New Issue
Block a user