Control web browsers running under EXWM
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

exwm-wb.el 10KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314
  1. ;;; exwm-wb.el --- Control web browsers running under EXWM. -*- lexical-binding: t -*-
  2. ;; Copyright (C) 2018 Peter Jones <pjones@devalot.com>
  3. ;; Author: Peter Jones <pjones@devalot.com>
  4. ;; Homepage: https://github.com/pjones/exwm-wb
  5. ;; Package-Requires: ((emacs "25.1") (async "1.9") (exwm "0.18"))
  6. ;; Version: 0.1.0
  7. ;;
  8. ;; This file is not part of GNU Emacs.
  9. ;;; Commentary:
  10. ;;
  11. ;; FIXME:
  12. ;;; License:
  13. ;;
  14. ;; Permission is hereby granted, free of charge, to any person obtaining
  15. ;; a copy of this software and associated documentation files (the
  16. ;; "Software"), to deal in the Software without restriction, including
  17. ;; without limitation the rights to use, copy, modify, merge, publish,
  18. ;; distribute, sublicense, and/or sell copies of the Software, and to
  19. ;; permit persons to whom the Software is furnished to do so, subject to
  20. ;; the following conditions:
  21. ;;
  22. ;; The above copyright notice and this permission notice shall be
  23. ;; included in all copies or substantial portions of the Software.
  24. ;;
  25. ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  26. ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
  27. ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
  28. ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
  29. ;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
  30. ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
  31. ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
  32. ;;; Code:
  33. (require 'async)
  34. (require 'browse-url)
  35. (require 'seq)
  36. (require 'exwm)
  37. ;;; Classes
  38. ;;
  39. ;;
  40. (defclass exwm-wb-browser ()
  41. ((name
  42. :initarg :name
  43. :initform nil
  44. :custom string
  45. :documentation
  46. "The name of the browser shown in prompts and menus.")
  47. (class-name
  48. :initarg :class-name
  49. :initform nil
  50. :custom string
  51. :documentation
  52. " The class name property of the browser window exposed by the
  53. `exwm-class-name' variable. Used to detect if the current
  54. window is a browser and which type of browser it is.")
  55. (open-url
  56. :initarg :open-url
  57. :initform nil
  58. :custom function
  59. :documentation
  60. " A function returning a list that can be passed to
  61. `asyn-start-process' to start a new instance/tab of the browser. It
  62. should take a single argument, the URL to open.")
  63. (get-url
  64. :initarg :get-url
  65. :initform nil
  66. :custom function
  67. :documentation
  68. " A function returning the URL being displayed in a browser
  69. window. The EXWM buffer holding the browser will be current when
  70. this function is called.")
  71. (set-url
  72. :initarg :set-url
  73. :initform nil
  74. :custom function
  75. :documentation
  76. " A function that sets the URL of the browser. Its argument will
  77. be the new URL to set in the browser window. The EXWM buffer
  78. holding the browser window will be current when this function is
  79. called.")
  80. (history-back
  81. :initarg :history-back
  82. :initform nil
  83. :custom function
  84. :documentation
  85. " A function to move backwards in the location history.")
  86. (history-forward
  87. :initarg :history-forward
  88. :initform nil
  89. :custom function
  90. :documentation
  91. " A function to move forwards in the location history.")))
  92. (defmethod exwm-wb-browser--open-url ((browser exwm-wb-browser) url new-window)
  93. "Open URL in BROWSER.
  94. If NEW-WINDOW is nil then use the set-url function slot to do
  95. this. Otherwise, when NEW-WINDOW is non-nil, use the open-url
  96. function slot."
  97. (if new-window
  98. (let* ((func (oref browser open-url))
  99. (args (and func (apply func url nil))))
  100. (when args (apply #'async-start-process
  101. (car args) (car args) nil (cdr args))))
  102. (let ((func (oref browser set-url)))
  103. (when func (apply func url nil)))))
  104. ;;; Predefined browsers:
  105. (defconst exwm-wb-surf
  106. (exwm-wb-browser
  107. :name "Surf"
  108. :class-name "Surf"
  109. :open-url (lambda (url) (list "surf" url))
  110. :get-url (lambda () (exwm-wb-get-prop "_SURF_URI"))
  111. :set-url (lambda (url) (exwm-wb-set-prop "_SURF_GO" url))
  112. :history-back (lambda () (exwm-wb-send-keys exwm-wb-surf-back-key))
  113. :history-forward (lambda () (exwm-wb-send-keys exwm-wb-surf-forward-key)))
  114. "The Surf web browser.")
  115. ;;; Customize interface:
  116. (defgroup exwm-wb nil
  117. "A minor mode and helpers for managing web browsers under EXWM."
  118. :version "0.1.0"
  119. :prefix "exwm-wb-"
  120. :group 'applications)
  121. (defcustom exwm-wb-list
  122. (list exwm-wb-surf)
  123. "List of supported browsers.")
  124. (defcustom exwm-wb-surf-back-key [?\C-b]
  125. "The key to send to Surf to make it move back in its history."
  126. :group 'exwm-wb
  127. :type 'key-sequence)
  128. (defcustom exwm-wb-surf-forward-key [?\C-f]
  129. "The key to send to Surf to make it move forward in its history."
  130. :group 'exwm-wb
  131. :type 'key-sequence)
  132. (defcustom exwm-wb-prompt-for-browser nil
  133. "Whether opening a URL should prompt for which browser to use.
  134. Setting this to non-nil means always prompt. The default setting
  135. is to use the first configured browser instead of prompting.
  136. See `exwm-wb-list' for the configured browser list."
  137. :group 'exwm-wb
  138. :type '(repeat FIXME:))
  139. (defcustom exwm-wb-shortcuts
  140. '("https://duckduckgo.com/?q=%s"
  141. "https://www.google.com/search?q=%s"
  142. "https://en.wikipedia.org/w/index.php?title=Special:Search&search=%s&go=Go")
  143. "URLs of frequently visited sites and search engines.
  144. This list is used by the `exwm-wb-open-shortcut' command to
  145. build an interactive prompt for selecting a URL and jumping to it
  146. in a new browser window/tab.
  147. A URL can optionally include a %s format specifier. If such a
  148. URL is selected from the interactive prompt a second prompt will
  149. be show to read a search string. In this mode the %s in the URL
  150. will be substituted for the input from the second prompt
  151. before launching a browser."
  152. :group 'exwm-wb
  153. :type '(repeat (choice string)))
  154. ;;; Internal variables:
  155. (defvar exwm-wb-mode-map
  156. (let ((map (make-sparse-keymap)))
  157. (define-key map (kbd "C-c C-f") #'exwm-wb-history-forward)
  158. (define-key map (kbd "C-c C-b") #'exwm-wb-history-back)
  159. (define-key map (kbd "C-c C-l") #'exwm-wb-open-url)
  160. (define-key map (kbd "C-c C-j") #'exwm-wb-open-shortcut)
  161. map)
  162. "Key map for `exwm-wb-mode'.")
  163. ;;; Functions:
  164. (defun exwm-wb-winid ()
  165. "Get the X11 window ID for the current EXWM buffer."
  166. (if (derived-mode-p 'exwm-mode)
  167. (exwm--buffer->id (current-buffer))
  168. (error "Not a EXWM window")))
  169. (defun exwm-wb-get-prop (name)
  170. "Read window property NAME from the current EXWM buffer."
  171. ;; FIXME: This is a hack stolen from exwm-surf: Copyright (C) 2017
  172. ;; craven@gmx.net without permission.
  173. (let* ((winid (exwm-wb-winid))
  174. (text (shell-command-to-string
  175. (format "xprop -notype -id %s %s" winid name))))
  176. (string-match "\"\\(.*\\)\"" text)
  177. (match-string 1 text)))
  178. (defun exwm-wb-set-prop (name value)
  179. "Set the X11 window property NAME to VALUE for the current EXWM buffer."
  180. (let ((winid (exwm-wb-winid)))
  181. (start-process-shell-command
  182. "xprop" nil (format "xprop -id %s -f %s 8s -set %s \"%s\""
  183. winid name name value))))
  184. (defun exwm-wb-send-keys (keys)
  185. "Send the key sequence KEYS to the current EXWM window."
  186. (when (derived-mode-p 'exwm-mode)
  187. (seq-doseq (key keys)
  188. (exwm-input--fake-key key))))
  189. (defun exwm-wb-choose-browser ()
  190. "Prompt the user to select a browser."
  191. ;; FIXME:
  192. exwm-wb-surf)
  193. (defun exwm-wb-current-browser ()
  194. "Return the browser instance for the current window or nil."
  195. (when (derived-mode-p 'exwm-mode)
  196. (object-assoc exwm-class-name 'class-name exwm-wb-list)))
  197. (defun exwm-wb-funcall (slot arguments)
  198. "Call a function at SLOT with ARGUMENTS for the current browser buffer."
  199. (let* ((browser (exwm-wb-current-browser))
  200. (func (and browser (slot-value browser slot))))
  201. (when func (apply func arguments))))
  202. (defun exwm-wb-url-prompt ()
  203. "Prompt for a URL.
  204. If the current window is a browser, extract a URL from it and use
  205. it as the default answer in the prompt. Otherwise act like
  206. `browse-url-interactive-arg' and try to find a URL around point
  207. to use as the default answer.
  208. Return a list just like `browse-url-interactive-arg' does where
  209. the CAR is the URL read from the user and the CADR is the
  210. new-window flag."
  211. (let ((prompt "URL: ")
  212. (url (exwm-wb-funcall 'get-url nil)))
  213. (if url (list (read-string prompt url)
  214. (not (eq (null browse-url-new-window-flag)
  215. (null current-prefix-arg))))
  216. (browse-url-interactive-arg prompt))))
  217. ;;; Commands:
  218. (defun exwm-wb-open-url (url &optional new-window)
  219. "Open URL in a web browser.
  220. If the current buffer is already a browser window and NEW-WINDOW
  221. is nil, redirect the browser to URL replacing the current
  222. location. Otherwise, when NEW-WINDOW is non-nil, always open a
  223. new browser window/tab."
  224. (interactive (exwm-wb-url-prompt))
  225. (let ((browser (or (and (not new-window) (exwm-wb-current-browser))
  226. (exwm-wb-choose-browser)
  227. exwm-wb-surf)))
  228. (exwm-browser--open-url browser url
  229. (or new-window
  230. (not (exwm-wb-current-browser))))))
  231. (defun exwm-wb-open-shortcut (shortcut &optional new-window)
  232. "Open a shortcut URL in a browser window.
  233. When called interactively prompt for SHORTCUT. If SHORTCUT
  234. contains a %s format placeholder also prompt for a search query.
  235. If NEW-WINDOW is non-nil then display the URL in a new window."
  236. (interactive
  237. (list (completing-read "Shortcut: " exwm-wb-shortcuts)
  238. current-prefix-arg))
  239. (let ((url (if (string-match-p "%s" shortcut)
  240. (format shortcut (read-string "Search Query: "))
  241. shortcut)))
  242. (exwm-wb-open-url url new-window)))
  243. (defun exwm-wb-history-back ()
  244. "Tell the current browser to go to the previous URL in the history."
  245. (interactive)
  246. (exwm-wb-funcall 'history-back nil))
  247. (defun exwm-wb-history-forward ()
  248. "Tell the current browser to go to the next URL in the history."
  249. (interactive)
  250. (exwm-wb-funcall 'history-forward nil))
  251. (define-minor-mode exwm-wb-mode
  252. "Minor mode to interact with a web browser displayed by EXWM."
  253. :group 'exwm-wb
  254. :keymap 'exwm-wb-mode-map)
  255. (defun exwm-wb-mode-maybe-enable ()
  256. "Activate `exwm-wb-mode' if the current buffer is a browser."
  257. (if (exwm-wb-current-browser) (exwm-wb-mode 1)))
  258. ;; Try to automatically enable `exwm-wb-mode' when needed:
  259. (add-hook 'exwm-manage-finish-hook #'exwm-wb-mode-maybe-enable)
  260. (provide 'exwm-wb)
  261. ;;; exwm-wb.el ends here