unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
blob 224981a8564cd4aee0c5c4ee2fcc0759664a2519 4921 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
 
;;; 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

debug log:

solving 224981a856 ...
found 224981a856 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).