unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
blob 619972dab1420b971f488074bd373aea3466bd98 5395 bytes (raw)
name: lisp/osc.el 	 # note: path name is non-authoritative(*)

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
 
;;; 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 2, 7 and 8 (for window title, current
;; directory and hyperlinks respectively) are provided.

;;; Code:

(defvar-local osc-handlers '(("2" . osc-window-title-handler)
                             ("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)))))))

;; Window title handling (OSC 2)

(defvar-local osc-window-title nil)
(defun osc-window-title-handler (_ text)
  "Set value of `osc-window-title' from an OSC 2 escape sequence.
The variable `osc-window-title' can be referred to in
`frame-title-format' to dynamically set the frame title.

This function is intended to be included as an entry of
`osc-handlers'."
  (setq osc-window-title text))

;; 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

debug log:

solving 619972dab1 ...
found 619972dab1 in https://git.savannah.gnu.org/cgit/emacs.git

(*) Git path names are given by the tree(s) the blob belongs to.
    Blobs themselves have no identifier aside from the hash of its contents.^

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).