modern_lisp-machine/emacs.d/extensions/emacs-everywhere.el

;;; emacs-everywhere.el --- System-wide popup windows for quick edits -*- lexical-binding: t; -*-

;; Copyright (C) 2021 TEC

;; Author: TEC <https://github.com/tecosaur>
;; Maintainer: TEC <contact@tecosaur.net>
;; Created: February 06, 2021
;; Modified: February 06, 2021
;; Version: 0.1.0
;; Keywords: convenience, frames
;; Homepage: https://github.com/tecosaur/emacs-everywhere
;; Package-Requires: ((emacs "26.3"))

;;; License:

;; This file is part of org-pandoc-import, which is not part of GNU Emacs.
;; SPDX-License-Identifier: GPL-3.0-or-later

;;; Commentary:

;;  System-wide popup Emacs windows for quick edits

;;; Code:

(require 'cl-lib)
(require 'server)

(defgroup emacs-everywhere ()
  "Customise group for Emacs-everywhere."
  :group 'convenience)

(define-obsolete-variable-alias
  'emacs-everywhere-paste-p 'emacs-everywhere-paste-command "0.1.0")
(defalias 'emacs-everywhere-call 'emacs-everywhere--call)
(make-obsolete 'emacs-everywhere-call "Now private API" "0.2.0")
(define-obsolete-variable-alias
  'emacs-everywhere-return-converted-org-to-gfm
  'emacs-everywhere-convert-org-to-gfm "0.2.0")
(defvaralias 'emacs-everywhere-mode-initial-map 'emacs-everywhere--initial-mode-map)
(make-obsolete-variable 'emacs-everywhere-mode-initial-map "Now private API" "0.2.0")
(defalias 'emacs-everywhere-erase-buffer 'emacs-everywhere--erase-buffer)
(make-obsolete 'emacs-everywhere-erase-buffer "Now private API" "0.2.0")
(defalias 'emacs-everywhere-finish-or-ctrl-c-ctrl-c 'emacs-everywhere--finish-or-ctrl-c-ctrl-c)
(make-obsolete 'emacs-everywhere-finish-or-ctrl-c-ctrl-c "Now private API" "0.2.0")
(defalias 'emacs-everywhere-app-info-linux 'emacs-everywhere--app-info-linux)
(make-obsolete 'emacs-everywhere-app-info-linux "Now private API" "0.2.0")
(defalias 'emacs-everywhere-app-info-osx 'emacs-everywhere--app-info-osx)
(make-obsolete 'emacs-everywhere-app-info-osx "Now private API" "0.2.0")
(defalias 'emacs-everywhere-app-info-windows 'emacs-everywhere--app-info-windows)
(make-obsolete 'emacs-everywhere-app-info-windows "Now private API" "0.2.0")
(defalias 'emacs-everywhere-ensure-oscascript-compiled 'emacs-everywhere--ensure-oscascript-compiled)
(make-obsolete 'emacs-everywhere-ensure-oscascript-compiled "Now private API" "0.2.0")

(defvar emacs-everywhere--display-server
  (cond
   ((eq system-type 'darwin) '(quartz . nil))
   ((memq system-type '(ms-dos windows-nt cygwin)) '(windows . nil))
   ((eq system-type 'gnu/linux)
    (cons
     (if (getenv "WAYLAND_DISPLAY") 'wayland 'x11)
     (intern (or (getenv "XDG_CURRENT_DESKTOP") "unknown"))))
   (t '(unknown . nil)))
  "The detected display server.")

(defcustom emacs-everywhere-paste-command
  (pcase (car emacs-everywhere--display-server)
    ('quartz (list "osascript" "-e" "tell application \"System Events\" to keystroke \"v\" using command down"))
    ('windows
     (list "powershell" "-NoProfile" "-Command"
           "& {(New-Object -ComObject wscript.shell).SendKeys(\"^v\")}"))
    ('x11 (list "xdotool" "key" "--clearmodifiers" "Shift+Insert"))
    ('wayland (list "ydotool" "key" "42:1" "110:1" "42:0" "110:0"))
    ('unknown
     (list "notify-send"
           "No paste command defined for emacs-everywhere"
           "-a" "Emacs" "-i" "emacs")))
  "Command to trigger a system paste from the clipboard.
This is given as a list in the form (CMD ARGS...).

To not run any command, set to nil."
  :type '(set (repeat string) (const nil))
  :group 'emacs-everywhere)

(defcustom emacs-everywhere-copy-command
  (pcase (car emacs-everywhere--display-server)
    ('x11 (list "xclip" "-selection" "clipboard" "%f"))
    ('wayland
     (list "sh" "-c" "wl-copy < %f"))
    ('windows
     (list "Powershell" "-NoProfile" "-Command" "& { Get-Content %f | clip }")))
  "Command to write to the system clipboard from a file (%f).
This is given as a list in the form (CMD ARGS...).
In the arguments, \"%f\" is treated as a placeholder for the path
to the file.

When nil, nothing is executed.

`gui-select-text' is always called on the buffer content, however experience
suggests that this can be somewhat flakey, and so an extra step to make sure
it worked can be a good idea."
  :type '(set (repeat string) (const nil))
  :group 'emacs-everywhere)

(defcustom emacs-everywhere-window-focus-command
  (pcase emacs-everywhere--display-server
    (`(quartz . ,_) (list "osascript" "-e" "tell application \"%w\" to activate"))
    (`(windows . ,_) (list "powershell" "-NoProfile" "-command"
                           "& {Add-Type 'using System; using System.Runtime.InteropServices; public class Tricks { [DllImport(\"user32.dll\")] public static extern bool SetForegroundWindow(IntPtr hWnd); }'; [tricks]::SetForegroundWindow(%w) }"))
    (`(x11 . ,_) (list "xdotool" "windowactivate" "--sync" "%w"))
    (`(wayland . KDE) (list "kdotool" "windowactivate" "%w"))) ; No --sync
  "Command to refocus the active window when emacs-everywhere was triggered.
This is given as a list in the form (CMD ARGS...).
In the arguments, \"%w\" is treated as a placeholder for the window ID,
as returned by `emacs-everywhere-app-id'.

When nil, nothing is executed, and pasting is not attempted."
  :type '(set (repeat string) (const nil))
  :group 'emacs-everywhere)

(defcustom emacs-everywhere-markdown-windows
  '("Reddit" "Stack Exchange" "Stack Overflow" ; Sites
    "Discord" "Element" "Slack" "HedgeDoc" "HackMD" "Zulip" ; Web Apps
    "Pull Request" "Issue" "Comparing .*\\.\\.\\.") ; Github
  "For use with `emacs-everywhere-markdown-p'.
Patterns which are matched against the window title."
  :type '(rep string)
  :group 'emacs-everywhere)

(defcustom emacs-everywhere-markdown-apps
  '("Discord" "Element" "Fractal" "NeoChat" "Slack")
  "For use with `emacs-everywhere-markdown-p'.
Patterns which are matched against the app name."
  :type '(rep string)
  :group 'emacs-everywhere)

(defcustom emacs-everywhere-frame-name-format "Emacs Everywhere :: %s — %s"
  "Format string used to produce the frame name.
Formatted with the app name, and truncated window name."
  :type 'string
  :group 'emacs-everywhere)

(defcustom emacs-everywhere-major-mode-function
  (cond
   ((executable-find "pandoc") #'org-mode)
   ((fboundp 'markdown-mode) #'emacs-everywhere-major-mode-org-or-markdown)
   (t #'text-mode))
  "Function which sets the major mode for the Emacs Everywhere buffer.

When set to `org-mode', pandoc is used to convert from markdown to Org
when applicable."
  :type 'function
  :options '(org-mode
             emacs-everywhere-major-mode-org-or-markdown
             text-mode)
  :group 'emacs-everywhere)

(defcustom emacs-everywhere-init-hooks
  '(emacs-everywhere-set-frame-name
    emacs-everywhere-set-frame-position
    emacs-everywhere-apply-major-mode
    emacs-everywhere-insert-selection
    emacs-everywhere-remove-trailing-whitespace
    emacs-everywhere-init-spell-check)
  "Hooks to be run before function `emacs-everywhere-mode'."
  :type 'hook
  :group 'emacs-everywhere)

(defcustom emacs-everywhere-final-hooks
  '(emacs-everywhere-convert-org-to-gfm
    emacs-everywhere-remove-trailing-whitespace)
  "Hooks to be run just before content is copied."
  :type 'hook
  :group 'emacs-everywhere)

(defcustom emacs-everywhere-frame-parameters
  `((name . "emacs-everywhere")
    (fullscreen . nil) ; Helps on GNOME at least
    (width . 80)
    (height . 12))
  "Parameters `make-frame' recognises to apply to the emacs-everywhere frame."
  :type 'list
  :group 'emacs-everywhere)

(defcustom emacs-everywhere-top-padding 0.2
  "Use the header-line to introduce this fraction of a line as padding.
Set to nil to disable."
  :type '(choice (const nil :tag "No padding") number)
  :group 'emacs-everywhere)

(defcustom emacs-everywhere-file-dir
  temporary-file-directory
  "The default dir for`emacs-everywhere-filename-function'-generated temp files."
  :type 'string
  :group 'emacs-everywhere)

(defcustom emacs-everywhere-file-patterns
  (let ((default-directory emacs-everywhere-file-dir))
    (list (concat "^" (regexp-quote (file-truename "emacs-everywhere-")))
          ;; For qutebrowser 'editor.command' support
          (concat "^" (regexp-quote (file-truename "qutebrowser-editor-")))))
  "A list of file regexps to activate `emacs-everywhere-mode' for."
  :type '(repeat regexp)
  :group 'emacs-everywhere)

(defcustom emacs-everywhere-pandoc-md-args
  '("-f" "markdown-auto_identifiers" "-t" "org")
  "Arguments supplied to pandoc when converting text from Markdown to Org."
  :type '(repeat string)
  :group 'emacs-everywhere)

(defcustom emacs-everywhere-clipboard-sleep-delay 0.01
  "Waiting period to wait to propagate clipboard actions."
  :type 'number
  :group 'emacs-everywhere)

(defun emacs-everywhere-temp-filename (app-info)
  "Generate a temp file based on APP-INFO."
  (concat "emacs-everywhere-"
          (format-time-string "%Y%m%d-%H%M%S-" (current-time))
          (emacs-everywhere-app-class app-info)))

(defcustom emacs-everywhere-filename-function
  #'emacs-everywhere-temp-filename
  "A function which generates a file name for the buffer.
The function is passed the result of `emacs-everywhere-app-info'.
Make sure that it will be matched by `emacs-everywhere-file-patterns'."
  :type 'function
  :group 'emacs-everywhere)

(defcustom emacs-everywhere-app-info-function
  (pcase emacs-everywhere--display-server
    (`(quartz . ,_) #'emacs-everywhere--app-info-osx)
    (`(windows . ,_) #'emacs-everywhere--app-info-windows)
    (`(x11 . ,_) #'emacs-everywhere--app-info-linux-x11)
    (`(wayland . KDE) #'emacs-everywhere--app-info-linux-kde))
  "Function that asks the system for information on the current foreground app.
On most systems, this should be set to a sensible default, but it
may not be set on less common configurations. If unset, a custom
app-info function can be used — see the various
emacs-everywhere--app-info-* functions for reference."
  :type 'function
  :group 'emacs-everywhere)

;; Semi-internal variables

(defconst emacs-everywhere-osascript-accessibility-error-message
  "osascript is not allowed assistive access"
  "String to search for to determine if Emacs does not have accessibility rights.")

(defvar-local emacs-everywhere-current-app nil
  "The current `emacs-everywhere-app'.")
;; Prevents buffer-local variable from being unset by major mode changes
(put 'emacs-everywhere-current-app 'permanent-local t)

(defvar-local emacs-everywhere--contents nil)

;; Make the byte-compiler happier

(declare-function org-in-src-block-p "org")
(declare-function org-ctrl-c-ctrl-c "org")
(declare-function org-export-to-buffer "ox")
(declare-function evil-insert-state "evil-states")
(declare-function spell-fu-buffer "spell-fu")
(declare-function markdown-mode "markdown-mode")
(declare-function w32-shell-execute "w32fns.c")

;;; Primary functionality

;;;###autoload
(defun emacs-everywhere (&optional file line column)
  "Launch the emacs-everywhere frame from emacsclient.
This may open FILE at a particular LINE and COLUMN, if specified."
  (let* ((app-info (emacs-everywhere-app-info))
         (param (emacs-everywhere-command-param app-info file line column))
         (param-string (combine-and-quote-strings param)))
    (pcase system-type
      ((or 'ms-dos 'windows-nt 'cygwin)
       (w32-shell-execute "open" "emacsclientw" param-string 1))
      (_ (apply #'call-process "emacsclient" nil 0 nil param)))))

(defun emacs-everywhere-command-param (app-info &optional file line column)
  "Generate arguments for calling emacsclient.
The arguments are based on a particular APP-INFO. Optionally, a FILE can be
specified, and also a particular LINE and COLUMN."
  (delq
   nil (list
        (when (server-running-p)
          (if server-use-tcp
              (concat "--server-file="
                      (if (memq system-type '(ms-dos windows-nt cygwin))
                          (expand-file-name server-name server-auth-dir)
                        (shell-quote-argument
                         (expand-file-name server-name server-auth-dir))))
            (concat "--socket-name="
                    (if (memq system-type '(ms-dos windows-nt cygwin))
                        (expand-file-name server-name server-auth-dir)
                      (shell-quote-argument
                       (expand-file-name server-name server-socket-dir))))))
        "-c" "-F"
        (prin1-to-string
         (cons (cons 'emacs-everywhere-app app-info)
               emacs-everywhere-frame-parameters))

        (cond ((and line column) (format "+%d:%d" line column))
              (line              (format "+%d" line)))

        (or file
            (expand-file-name
             (funcall emacs-everywhere-filename-function app-info)
             emacs-everywhere-file-dir)))))

(defun emacs-everywhere-file-p (file)
  "Return non-nil if FILE should be handled by emacs-everywhere.
This matches FILE against `emacs-everywhere-file-patterns'."
  (let ((file (file-truename file)))
    (cl-some (lambda (pattern) (string-match-p pattern file))
             emacs-everywhere-file-patterns)))

;;;###autoload
(defun emacs-everywhere-initialise ()
  "Entry point for the executable.
APP is an `emacs-everywhere-app' struct."
  (let ((file (buffer-file-name (buffer-base-buffer))))
    (when (and file (emacs-everywhere-file-p file))
      (let ((app (or (frame-parameter nil 'emacs-everywhere-app)
                     (emacs-everywhere-app-info))))
        (setq-local emacs-everywhere-current-app app)
        (with-demoted-errors "Emacs Everywhere: error running init hooks, %s"
          (run-hooks 'emacs-everywhere-init-hooks))
        (emacs-everywhere-mode 1)
        (setq emacs-everywhere--contents (buffer-string))))))

;;;###autoload
(add-hook 'server-visit-hook #'emacs-everywhere-initialise)
(add-hook 'server-done-hook #'emacs-everywhere-finish)

(defvar emacs-everywhere--initial-mode-map
  (let ((keymap (make-sparse-keymap)))
    (define-key keymap (kbd "DEL") #'emacs-everywhere--erase-buffer)
    (define-key keymap (kbd "C-SPC") #'emacs-everywhere--erase-buffer)
    keymap)
  "Transient keymap invoked when an emacs-everywhere buffer is first created.
Set to nil to prevent this transient map from activating in emacs-everywhere
buffers.")

(define-minor-mode emacs-everywhere-mode
  "Tweak the current buffer to add some emacs-everywhere considerations."
  :init-value nil
  :lighter " EE"
  :keymap `((,(kbd "C-c C-c") . emacs-everywhere--finish-or-ctrl-c-ctrl-c)
            (,(kbd "C-x 5 0") . emacs-everywhere-finish)
            (,(kbd "C-c C-k") . emacs-everywhere-abort))
  (when emacs-everywhere-mode
    ;; line breaking
    (turn-off-auto-fill)
    (visual-line-mode t)
    ;; DEL/C-SPC to clear (first keystroke only)
    (when (keymapp emacs-everywhere--initial-mode-map)
      (set-transient-map emacs-everywhere--initial-mode-map))
    ;; Header line
    (when emacs-everywhere-top-padding
      (setq-local header-line-format "")
      (face-remap-set-base
       'header-line (list :height emacs-everywhere-top-padding)))
    ;; Replace "When done with a buffer type 'C-x #'" message
    (run-at-time
     nil nil
     (lambda ()
       (message "When done with this buffer type %s (or %s to abort)"
                (propertize "C-c C-c" 'face 'help-key-binding)
                (propertize "C-c C-k" 'face 'help-key-binding))))))

(defun emacs-everywhere-apply-major-mode ()
  "Call `emacs-everywhere-major-mode-function'."
  (funcall emacs-everywhere-major-mode-function))

(defun emacs-everywhere--erase-buffer ()
  "Delete the contents of the current buffer."
  (interactive)
  (delete-region (point-min) (point-max)))

(defun emacs-everywhere--finish-or-ctrl-c-ctrl-c ()
  "Finish emacs-everywhere session or invoke `org-ctrl-c-ctrl-c' in `org-mode'."
  (interactive)
  (if (and (eq major-mode 'org-mode)
           (org-in-src-block-p))
      (org-ctrl-c-ctrl-c)
    (emacs-everywhere-finish)))

(defun emacs-everywhere-finish (&optional abort)
  "Copy buffer content, close emacs-everywhere window, and maybe paste.
Must only be called within a emacs-everywhere buffer.
Never paste content when ABORT is non-nil."
  (interactive)
  (when emacs-everywhere-mode
    (when (equal emacs-everywhere--contents (buffer-string))
      (setq abort t))
    (unless abort
      (run-hooks 'emacs-everywhere-final-hooks)
      (gui-select-text (buffer-string))
      (gui-backend-set-selection 'PRIMARY (buffer-string))
      (when emacs-everywhere-copy-command ; handle clipboard finicklyness
        (let ((inhibit-message t)
              (require-final-newline nil)
              write-file-functions)
          (write-file buffer-file-name)
          (apply #'call-process (car emacs-everywhere-copy-command)
                 nil nil nil
                 (mapcar (lambda (arg)
                           (replace-regexp-in-string "%f" buffer-file-name arg))
                         (cdr emacs-everywhere-copy-command))))))
    (sleep-for emacs-everywhere-clipboard-sleep-delay) ; prevents weird multi-second pause, lets clipboard info propagate
    (when emacs-everywhere-window-focus-command
      (let ((window-id (emacs-everywhere-app-id emacs-everywhere-current-app)))
        (apply #'call-process (car emacs-everywhere-window-focus-command)
               nil nil nil
               (mapcar (lambda (arg)
                         (replace-regexp-in-string "%w" window-id arg))
                       (cdr emacs-everywhere-window-focus-command)))
        ;; The frame only has this parameter if this package initialized the temp
        ;; file its displaying. Otherwise, it was created by another program, likely
        ;; a browser with direct EDITOR support, like qutebrowser.
        (when (and (frame-parameter nil 'emacs-everywhere-app)
                   emacs-everywhere-paste-command
                   (not abort))
          (apply #'call-process (car emacs-everywhere-paste-command)
                 nil nil nil (cdr emacs-everywhere-paste-command)))))
    ;; Clean up after ourselves in case the buffer survives `server-buffer-done'
    ;; (b/c `server-existing-buffer' is non-nil).
    (emacs-everywhere-mode -1)
    (server-buffer-done (current-buffer))))

(defun emacs-everywhere-abort ()
  "Abort current emacs-everywhere session."
  (interactive)
  (set-buffer-modified-p nil)
  (emacs-everywhere-finish t))

;;; Window info

(cl-defstruct emacs-everywhere-app
  "Metadata about the last focused window before emacs-everywhere was invoked."
  id class title geometry)

(defun emacs-everywhere-app-info ()
  "Return information on the active window.
This runs `emacs-everywhere-app-info-function' and lightly reformats the app title."
  (if (functionp emacs-everywhere-app-info-function)
      (let ((w (funcall emacs-everywhere-app-info-function)))
        (setf (emacs-everywhere-app-title w)
              (replace-regexp-in-string
               (format " ?-[A-Za-z0-9 ]*%s"
                       (regexp-quote (emacs-everywhere-app-class w)))
               ""
               (replace-regexp-in-string
                "[^[:ascii:]]+" "-" (emacs-everywhere-app-title w))))
        w)
    (user-error "No app-info function is set, see `emacs-everywhere-app-info-function'")))

(defun emacs-everywhere--call (command &rest args)
  "Execute COMMAND with ARGS synchronously."
  (with-temp-buffer
    (apply #'call-process command nil t nil (remq nil args))
    (when (and (eq system-type 'darwin)
               (string-match-p emacs-everywhere-osascript-accessibility-error-message (buffer-string)))
      (call-process "osascript" nil nil nil
                    "-e" (format "display alert \"emacs-everywhere\" message \"Emacs has not been granted accessibility permissions, cannot run emacs-everywhere!
Please go to 'System Preferences > Security & Privacy > Privacy > Accessibility' and allow Emacs.\"" ))
      (error "MacOS accessibility error, aborting"))
    (string-trim (buffer-string))))

(defun emacs-everywhere--app-info-linux ()
  "Return information on the active window, on Linux."
  (pcase emacs-everywhere--display-server
    (`(x11 . ,_) (emacs-everywhere--app-info-linux-x11))
    (`(wayland . KDE) (emacs-everywhere--app-info-linux-kde))
    (_ (user-error "Unable to fetch app info with display server %S" emacs-everywhere--display-server))))

(defun emacs-everywhere--app-info-linux-x11 ()
  "Return information on the current active window, on a Linux X11 sessions."
  (let ((window-id (emacs-everywhere--call "xdotool" "getactivewindow")))
    (let ((app-name
           (car (split-string-and-unquote
                 (string-trim-left
                  (emacs-everywhere--call "xprop" "-id" window-id "WM_CLASS")
                  "[^ ]+ = \"[^\"]+\", "))))
          (window-title
           (car (split-string-and-unquote
                 (string-trim-left
                  (emacs-everywhere--call "xprop" "-id" window-id "_NET_WM_NAME")
                  "[^ ]+ = "))))
          (window-geometry
           (let ((info (mapcar (lambda (line)
                                 (split-string line ":" nil "[ \t]+"))
                               (split-string
                                (emacs-everywhere--call "xwininfo" "-id" window-id) "\n"))))
             (mapcar #'string-to-number
                     (list (cadr (assoc "Absolute upper-left X" info))
                           (cadr (assoc "Absolute upper-left Y" info))
                           (cadr (assoc "Relative upper-left X" info))
                           (cadr (assoc "Relative upper-left Y" info))
                           (cadr (assoc "Width" info))
                           (cadr (assoc "Height" info)))))))
      (setq window-geometry
            (list
             (if (= (nth 0 window-geometry) (nth 2 window-geometry))
                 (nth 0 window-geometry)
               (- (nth 0 window-geometry) (nth 2 window-geometry)))
             (if (= (nth 1 window-geometry) (nth 3 window-geometry))
                 (nth 1 window-geometry)
               (- (nth 1 window-geometry) (nth 3 window-geometry)))
             (nth 4 window-geometry)
             (nth 5 window-geometry)))
      (make-emacs-everywhere-app
       :id window-id
       :class app-name
       :title window-title
       :geometry window-geometry))))

(defun emacs-everywhere--app-info-linux-kde ()
  "Return information on the current active window, on a Linux KDE sessions."
  (let ((window-id (emacs-everywhere--call "kdotool" "getactivewindow")))
    (let ((app-name
           (car (last (split-string (emacs-everywhere--call "kdotool" "getwindowclassname" window-id) "\\."))))
          (window-title
           (emacs-everywhere--call "kdotool" "getwindowname" window-id))
          (window-geometry
           (let ((geom (mapcar
                        (lambda (line) (split-string line "[:,x] ?"))
                        (split-string (string-trim-left
                                       (emacs-everywhere--call "kdotool" "getwindowgeometry" window-id) "[^P]+")
                                      "\n" nil " +"))))
             (mapcar #'string-to-number
                     (list (cadr (assoc "Position" geom))
                           (caddr (assoc "Position" geom))
                           (cadr (assoc "Geometry" geom))
                           (caddr (assoc "Geometry" geom)))))))
      (make-emacs-everywhere-app
       :id window-id
       :class app-name
       :title window-title
       :geometry window-geometry))))

(defvar emacs-everywhere--dir (file-name-directory load-file-name))

(defun emacs-everywhere--app-info-osx ()
  "Return information on the active window, on osx."
  (emacs-everywhere--ensure-oscascript-compiled)
  (let ((default-directory emacs-everywhere--dir))
    (let ((app-name (emacs-everywhere--call
                     "osascript" "app-name"))
          (window-title (emacs-everywhere--call
                         "osascript" "window-title"))
          (window-geometry (mapcar #'string-to-number
                                   (split-string
                                    (emacs-everywhere--call
                                     "osascript" "window-geometry") ", "))))
      (make-emacs-everywhere-app
       :id app-name
       :class app-name
       :title window-title
       :geometry window-geometry))))

(defun emacs-everywhere--ensure-oscascript-compiled (&optional force)
  "Ensure that compiled oscascript files are present.
Will always compile when FORCE is non-nil."
  (unless (and (file-exists-p "app-name")
               (file-exists-p "window-geometry")
               (file-exists-p "window-title")
               (not force))
    (let ((default-directory emacs-everywhere--dir)
          (app-name
           "tell application \"System Events\"
    set frontAppName to name of first application process whose frontmost is true
end tell
return frontAppName")
          (window-geometry
           "tell application \"System Events\"
     set frontWindow to front window of (first application process whose frontmost is true)
     set windowPosition to (get position of frontWindow)
     set windowSize to (get size of frontWindow)
end tell
return windowPosition & windowSize")
          (window-title
           "set windowTitle to \"\"
tell application \"System Events\"
     set frontAppProcess to first application process whose frontmost is true
end tell
tell frontAppProcess
    if count of windows > 0 then
        set windowTitle to name of front window
    end if
end tell
return windowTitle"))
      (dolist (script `(("app-name" . ,app-name)
                        ("window-geometry" . ,window-geometry)
                        ("window-title" . ,window-title)))
        (write-region (cdr script) nil (concat (car script) ".applescript"))
        (shell-command (format "osacompile -r scpt:128 -t osas -o %s %s"
                               (car script) (concat (car script) ".applescript")))))))

(defun emacs-everywhere--app-info-windows ()
  "Return information on the active window, on Windows."
  (let* ((window-id (emacs-everywhere--call
                     "powershell"
                     "-NoProfile"
                     "-Command"
                     "& {Add-Type 'using System; using System.Runtime.InteropServices; public class Tricks { [DllImport(\"user32.dll\")] public static extern IntPtr GetForegroundWindow(); }'; [tricks]::GetForegroundWindow() }"))
         (window-title (emacs-everywhere--call
                        "powershell"
                        "-NoProfile"
                        "-Command"
                        (format "& {Add-Type 'using System; using System.Runtime.InteropServices; public class Tricks { [DllImport(\"user32.dll\")] public static extern int GetWindowText(IntPtr hWnd, System.Text.StringBuilder text, int count); [DllImport(\"user32.dll\")] public static extern int GetWindowTextLength(IntPtr hWnd); }'; $length = ([tricks]::GetWindowTextLength(%s)); $sb = New-Object System.Text.StringBuilder $length; [tricks]::GetWindowText(%s, $sb, $length + 1) > $null; $sb.ToString() }" window-id window-id)))
         (window-class (emacs-everywhere--call
                        "powershell"
                        "-NoProfile"
                        "-Command"
                        (format "(Get-Item (Get-Process | ? { $_.mainwindowhandle -eq %s }).Path).VersionInfo.ProductName" window-id)))
         (window-geometry (split-string
                           (emacs-everywhere--call
                            "powershell"
                            "-NoProfile"
                            "-Command"
                            (format "& {Add-Type 'using System; using System.Runtime.InteropServices; public struct tagRECT { public int left; public int top; public int right; public int bottom; } public class Tricks { [DllImport(\"user32.dll\")] public static extern int GetWindowRect(IntPtr hWnd, out tagRECT lpRect); }'; $rect = New-Object -TypeName tagRECT; [tricks]::GetWindowRect(%s, [ref]$rect) > $null; $rect.left; $rect.top; $rect.right - $rect.left; $rect.bottom - $rect.top }" window-id)))))
    (make-emacs-everywhere-app
     :id window-id
     :class window-class
     :title window-title
     :geometry window-geometry)))

;;; Secondary functionality

(defun emacs-everywhere-set-frame-name ()
  "Set the frame name based on `emacs-everywhere-frame-name-format'."
  (set-frame-name
   (format emacs-everywhere-frame-name-format
           (emacs-everywhere-app-class emacs-everywhere-current-app)
           (truncate-string-to-width
            (emacs-everywhere-app-title emacs-everywhere-current-app)
            45 nil nil "…"))))

(defun emacs-everywhere-remove-trailing-whitespace ()
  "Move point to the end of the buffer, and remove all trailing whitespace."
  (goto-char (max-char))
  (delete-trailing-whitespace)
  (delete-char (- (skip-chars-backward "\n"))))

(defun emacs-everywhere-set-frame-position ()
  "Set the size and position of the emacs-everywhere frame."
  (cl-destructuring-bind (x . y) (mouse-absolute-pixel-position)
    (set-frame-position (selected-frame)
                        (- x 100)
                        (- y 50))))

(defun emacs-everywhere-insert-selection--windows ()
  "Insert selection on MS-Windows by simulating C-c and C-v."
  (let ((window-id (emacs-everywhere-app-id emacs-everywhere-current-app))
        (emacs-window-id (emacs-everywhere--call
                          "powershell"
                          "-NoProfile"
                          "-Command"
                          "& {Add-Type 'using System; using System.Runtime.InteropServices; public class Tricks { [DllImport(\"user32.dll\")] public static extern IntPtr GetForegroundWindow(); }'; [tricks]::GetForegroundWindow() }")))
    (apply #'call-process (car emacs-everywhere-window-focus-command)
           nil nil nil
           (mapcar (lambda (arg)
                     (replace-regexp-in-string "%w" window-id arg))
                   (cdr emacs-everywhere-window-focus-command)))
    (apply #'call-process "powershell"
           nil nil nil '("-NoProfile" "-Command" "& {(New-Object -ComObject wscript.shell).SendKeys('^c')}"))
    (apply #'call-process (car emacs-everywhere-window-focus-command)
           nil nil nil
           (mapcar (lambda (arg)
                     (replace-regexp-in-string "%w" emacs-window-id arg))
                   (cdr emacs-everywhere-window-focus-command))))
  (yank))

(defun emacs-everywhere-insert-selection ()
  "Insert the last text selection into the buffer."
  (pcase system-type
    ('darwin (progn
               (call-process "osascript" nil nil nil
                             "-e" "tell application \"System Events\" to keystroke \"c\" using command down")
               (sleep-for emacs-everywhere-clipboard-sleep-delay) ; lets clipboard info propagate
               (yank)))
    ((or 'ms-dos 'windows-nt 'cygwin)
     (emacs-everywhere-insert-selection--windows))
    (_ (when-let ((selection (gui-get-selection 'PRIMARY 'UTF8_STRING)))
         (gui-backend-set-selection 'PRIMARY "")
         (insert selection))))
  (when (and (eq major-mode 'org-mode)
             (emacs-everywhere-markdown-p)
             (executable-find "pandoc"))
    (apply #'call-process-region
           (point-min) (point-max) "pandoc"
           nil nil nil
           emacs-everywhere-pandoc-md-args)
    (deactivate-mark) (goto-char (point-max)))
  (cond ((bound-and-true-p evil-local-mode) (evil-insert-state))))

(defun emacs-everywhere-init-spell-check ()
  "Run a spell check function on the buffer, using a relevant enabled mode."
  (cond ((bound-and-true-p spell-fu-mode) (spell-fu-buffer))
        ((bound-and-true-p flyspell-mode) (flyspell-buffer))))

(defun emacs-everywhere-markdown-p ()
  "Return t if the original window is recognised as markdown-flavoured."
  (let ((title (emacs-everywhere-app-title emacs-everywhere-current-app))
        (class (emacs-everywhere-app-class emacs-everywhere-current-app)))
    (or (cl-some (lambda (pattern)
                   (string-match-p pattern title))
                 emacs-everywhere-markdown-windows)
        (cl-some (lambda (pattern)
                   (string-match-p pattern class))
                 emacs-everywhere-markdown-apps))))

(defun emacs-everywhere-major-mode-org-or-markdown ()
  "Use markdow-mode, when window is recognised as markdown-flavoured.
Otherwise use `org-mode'."
  (if (emacs-everywhere-markdown-p)
      (markdown-mode)
    (org-mode)))

(defcustom emacs-everywhere-org-export-options
  "#+property: header-args :exports both
#+options: toc:nil\n"
  "A string inserted at the top of the Org buffer prior to export.
This is with the purpose of setting #+property and #+options parameters.

Should end in a newline to avoid interfering with the buffer content."
  :type 'string
  :group 'emacs-everywhere)

(defvar org-export-show-temporary-export-buffer)
(defun emacs-everywhere-convert-org-to-gfm ()
  "When appropriate, convert org buffer to markdown."
  (when (and (eq major-mode 'org-mode)
             (emacs-everywhere-markdown-p))
    (goto-char (point-min))
    (insert emacs-everywhere-org-export-options)
    (let (org-export-show-temporary-export-buffer)
      (require 'ox-md)
      (org-export-to-buffer (if (featurep 'ox-gfm) 'gfm 'md) (current-buffer)))))

(defun emacs-everywhere--required-executables ()
  "Return a list of cons cells, each giving a required executable and its purpose."
  (let* ((var-cmds
          (list (cons "paste" emacs-everywhere-paste-command)
                (cons "copy" emacs-everywhere-copy-command)
                (cons "focus window" emacs-everywhere-window-focus-command)
                (list "pandoc conversion" "pandoc")))
         (de-cmds
          (pcase emacs-everywhere--display-server
            (`(x11 . ,_)
             (list (list "app info" "xdotool")
                   (list "app info" "xprop")
                   (list "app info" "xwininfo")))
            (`(wayland . KDE)
             (list (list "app info" "kdotool")))))
         (feat-cmds
          (append var-cmds de-cmds))
         executable-list)
      (dolist (feat-cmd (delq nil feat-cmds))
        (when (cdr feat-cmd)
          (when (and (equal (cadr feat-cmd) "sh")
                     (equal (caddr feat-cmd) "-c"))
            (setcdr feat-cmd (split-string (cadddr feat-cmd))))
          (push (cons (cadr feat-cmd) (car feat-cmd))
                executable-list)))
      executable-list))

(defun emacs-everywhere-check-health ()
  "Check whether emacs-everywhere has everything it needs."
  (interactive)
  (switch-to-buffer
   (get-buffer-create "*Emacs Everywhere health check*"))
  (read-only-mode 1)
  (with-silent-modifications
    (erase-buffer)
    (let ((required-cmds
           (emacs-everywhere--required-executables)))
      (insert (propertize "Emacs Everywhere system health check\n" 'face 'outline-1)
              "operating system: " (propertize (symbol-name system-type) 'face 'font-lock-type-face)
              ", display server: " (propertize (symbol-name (car emacs-everywhere--display-server)) 'face 'font-lock-type-face)
              (and (cdr emacs-everywhere--display-server)
                   (concat "/" (propertize (symbol-name (cdr emacs-everywhere--display-server)) 'face 'font-lock-type-face)))
              "\n")
      (dolist (req-cmd required-cmds)
        (if (not (cdr req-cmd))
            (insert
             (propertize (format "• %s (unavailible)\n" (cdr req-cmd)) 'face 'font-lock-comment-face))
          (insert
           (propertize (format "• %s " (cdr req-cmd))
                       'face `(:inherit outline-4 :height ,(face-attribute 'default :height)))
           "requires "
           (propertize (car req-cmd) 'face 'font-lock-constant-face)
           (if (executable-find (car req-cmd))
               (propertize " ✓ installed" 'face 'success)
             (propertize " ✗ missing" 'face 'error))
           "\n"))))))

(provide 'emacs-everywhere)
;;; emacs-everywhere.el ends here