* 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).
(require 'ring)
(require 'ansi-color)
+(require 'osc)
(require 'regexp-opt) ;For regexp-opt-charset.
(eval-when-compile (require 'subr-x))
\f
;; 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.
`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)))
\f
;;; Input fontification and indentation through an indirect buffer
--- /dev/null
+;;; 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
--- /dev/null
+;;; 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))))))
projects / emacs.git / commitdiff