{{ message }}
Repository navigation
Expand file tree
/
Copy pathhsys-www.el
More file actions
287 lines (262 loc) · 11.4 KB
/
Copy pathhsys-www.el
File metadata and controls
287 lines (262 loc) · 11.4 KB
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
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
;;; hsys-www.el --- GNU Hyperbole support for Emacs World-Wide Web (WWW) browsing -*- lexical-binding: t; -*-
;;
;; Author: Bob Weiner
;;
;; Orig-Date: 7-Apr-94 at 17:17:39 by Bob Weiner
;; Last-Mod: 25-Jul-26 at 23:06:19 by Mats Lidell
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
;; Copyright (C) 1994-2025 Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
;;
;; This file is part of GNU Hyperbole.
;;; Commentary:
;;
;; This module defines an implicit button type and associated action and
;; help types. A press of the Action Key on a unified resource locator
;; (URL) displays the referent for the URL. A press of the Help Key on a
;; URL displays what action the Action Key will take when pressed.
;;
;; Customize the web browser used by setting, `browse-url-browser-function'
;; to a function that invokes the desired browser on the URL. It
;; may be set from the Hyperbole Customization menu. This menu also
;; includes a setting for whether the browser reuses windows or
;; generates new ones.
;;; Code:
;;; ************************************************************************
;;; Other required Elisp libraries
;;; ************************************************************************
(require 'hload-path)
;;; This does not require any particular web browser.
(require 'browse-url)
(eval-when-compile
(require 'eww)) ;; Must load to use its functions in `www-eww-browse-url' below.
(require 'hbut)
;;; ************************************************************************
;;; Public declarations
;;; ************************************************************************
(defvar hpath:display-where-alist) ; "hpath.el"
(declare-function eww--dwim-expand-url "eww" (url))
(declare-function eww-links-at-point "eww")
(declare-function hpath:display-buffer "hpath")
(declare-function hpath:remote-at-p "hpath")
(declare-function hpath:remote-available-p "hpath")
(declare-function hpath:remote-p "hpath")
(declare-function hpath:www-at-p "hpath")
;; Forward declare conditionally defined functions
(declare-function eww-history-property "hsys-www")
(declare-function eww-bookmark-property "hsys-www")
(declare-function eww-link-at-point "hsys-www")
(declare-function shr-link-at-point "hsys-www")
;;; ************************************************************************
;;; Public functions and types
;;; ************************************************************************
;; eww-mode should define these next functions but presently does not,
;; so define them here when needed.
(unless (fboundp 'eww-link-at-point)
(defun shr-link-at-point ()
"Return any shr hyperlink url at point or nil if none."
(get-text-property (point) 'shr-url))
(defun eww-link-at-point ()
"Return any eww web page hyperlink url at point or nil if none."
(shr-link-at-point))
(defun eww-bookmark-property (property)
"Return value of PROPERTY, a symbol, for current eww bookmark line or nil."
(if (eq major-mode 'eww-bookmark-mode)
(plist-get (get-text-property (line-beginning-position) 'eww-bookmark)
property)))
(defun eww-history-property (property)
"Return value of PROPERTY, a symbol, for current eww history line or nil."
(if (eq major-mode 'eww-history-mode)
(plist-get (get-text-property (line-beginning-position) 'eww-history)
property))))
(defib www-url ()
"Follow any non-ftp url (link) at point.
The variable, `browse-url-browser-function', customizes the url browser that
is used.
Valid values of this variable include `browse-url-default-browser' and
`browse-url-generic'."
(cond ((looking-at "\\s-*\\'")
;; Don't match if at the end of the buffer; end of line is
;; handled elsewhere.
nil)
((and (eq major-mode 'eww-mode) (eww-links-at-point))
(let ((push-button (button-at (point))))
;; Set the ibut name to be the text description of the url
(hattr:set 'hbut:current 'name (button-label push-button))
;; Set the ibut lbl-key to be the url
(ibut:label-set (car (eww-links-at-point))
(button-start push-button)
(button-end push-button))
(hact 'eww-follow-link)))
((eq major-mode 'eww-bookmark-mode)
(ibut:label-set (concat (eww-bookmark-property :title)
(if (eww-bookmark-property :url)
(concat " <" (eww-bookmark-property :url) ">"))))
(hact 'eww-bookmark-browse))
((eq major-mode 'eww-history-mode)
(ibut:label-set (concat (eww-history-property :title)
(if (eww-history-property :url)
(concat " <" (eww-history-property :url) ">"))))
(hact 'eww-history-browse))
(t (let ((link-and-pos (hpath:www-at-p t)))
;; Skip ftp URLs which are handled elsewhere.
(if (and link-and-pos (not (hpath:remote-at-p)))
(progn (ibut:label-set link-and-pos)
(hact 'www-url (car link-and-pos))))))))
(defact link-to-url (url &optional _label)
"Follow a link given by URL and optional text _LABEL.
The variable, `browse-url-browser-function', customizes the url browser that
is used. Valid values of this variable include `browse-url-default-browser' and
`browse-url-generic'.
_LABEL is used in `hui:link-possible-types' with the `link-to-url' call and
in `ibut:insert-text' as the name of the implicit button inserted."
(interactive "sURL to follow: ")
(unless (stringp url)
(error "(link-to-url): URL = `%s' but must be a string" url))
(unless (seq-position url ?:)
(setq url (concat "https://" url)))
(if (or (functionp browse-url-browser-function)
;; May be a predicate alist of functions from which to select
(consp browse-url-browser-function))
(let ((browse-url-browser-function
(if (eq browse-url-browser-function #'eww-browse-url)
;; Hyperbole-specific version
#'www-eww-browse-url
browse-url-browser-function))
browse-function-name
browser)
(if (symbolp browse-url-browser-function)
(setq browse-function-name (symbol-name browse-url-browser-function)
browser (and (string-match
"-\\([^-]+\\)\\'"
browse-function-name)
(capitalize (substring browse-function-name
(match-beginning 1)
(match-end 1)))))
(setq browser "default browser"))
(message "Sending %s to %s..." url browser)
(browse-url url)
(message "Sending %s to %s...done" url browser))
(error "(link-to-url): `browse-url-browser-function' must be set to a web browser invoking function")))
;; !! TODO: Duplicate of `link-to-url' defact to consider getting rid of
(defact www-url (url &optional _label)
"Follow a link given by URL and optional text _LABEL.
The variable, `browse-url-browser-function', customizes the url browser that
is used. Valid values of this variable include `browse-url-default-browser' and
`browse-url-generic'.
_LABEL is used in `hui:link-possible-types' with the `link-to-url' call and
in `ibut:insert-text' as the name of the implicit button inserted."
(interactive "sURL to follow: ")
(unless (stringp url)
(error "(www-url): URL = `%s' but must be a string" url))
(unless (seq-position url ?:)
(setq url (concat "https://" url)))
(if (or (functionp browse-url-browser-function)
;; May be a predicate alist of functions from which to select
(consp browse-url-browser-function))
(let ((browse-url-browser-function
(if (eq browse-url-browser-function #'eww-browse-url)
;; Hyperbole-specific version
#'www-eww-browse-url
browse-url-browser-function))
browse-function-name
browser)
(if (symbolp browse-url-browser-function)
(setq browse-function-name (symbol-name browse-url-browser-function)
browser (and (string-match
"-\\([^-]+\\)\\'"
browse-function-name)
(capitalize (substring browse-function-name
(match-beginning 1)
(match-end 1)))))
(setq browser "default browser"))
(message "Sending %s to %s..." url browser)
(browse-url url)
(message "Sending %s to %s...done" url browser))
(error "(www-url): `browse-url-browser-function' must be set to a web browser invoking function")))
(defun www-url-compose-mail (to &optional subject body &rest _ignore)
"Compose a mailto url and open it in the default `browse-url' web browser.
TO is the recipient's email address. Optional SUBJECT and BODY
are included as parameters in the mailto url."
(let ((browse-url-mailto-function browse-url-browser-function)
(mailto (if (string-prefix-p "mailto:" to) to (concat "mailto:" to))))
;; Add subject if provided
(when subject
(setq mailto (concat mailto "?subject=" (url-encode-url subject))))
;; Add body if provided
(when body
(unless subject
(setq mailto (concat mailto "?")))
(setq mailto (concat mailto "&body=" (url-encode-url body))))
(hact 'www-url mailto)))
;;;###autoload
(defun www-url-expand-file-name (path &optional dir)
"Expand and return non-url and non-remote PATH in DIR.
Return http urls unchanged. Normalize remote paths."
(when (listp path)
(setq path (car path)
dir (car (cdr path))))
(if (string-match "\\`www\\.\\|\\`https?:" path)
path
(require 'hpath)
(or (hpath:remote-p path)
(expand-file-name path dir))))
;;;###autoload
(defun www-url-find-file-noselect (path &rest args)
"Find PATH without selecting its buffer.
Handle http urls. ARGS is the optional arguments to
`find-file-noselect'. If PATH is a list ARGS is set to remainder
after that the first element is extracted as the PATH."
(if (listp path)
(setq args (cdr path)
path (car path)))
(let* ((remote-sym (hpath:remote-available-p))
(inhibit-file-name-handlers
(if remote-sym
(append (list 'dired-handler-fn
(intern-soft (concat (symbol-name remote-sym)
"-file-handler-function")))
(and (eq inhibit-file-name-operation 'find-file-noselect)
inhibit-file-name-handlers))
inhibit-file-name-handlers))
(inhibit-file-name-operation 'find-file-noselect))
(if (string-match "\\`www\\.\\|\\`https?:" path)
(progn (require 'hyperbole)
;; Display url.
(hact 'www-url path)
;; return same buffer
(current-buffer))
(apply #'find-file-noselect path args))))
;;;###autoload
(defun www-eww-browse-url (url &optional new-window)
"Ask the eww browser to load URL only when `hyperbole-mode' is active.
Interactively, if the variable `browse-url-new-window-flag' is non-nil,
loads the document in a new buffer tab on the window tab-line. A non-nil
prefix argument reverses the effect of `browse-url-new-window-flag'.
If `tab-bar-mode' is enabled, then whenever a document would
otherwise be loaded in a new buffer, it is loaded in a new tab
in the tab-bar on an existing frame. See more options in
`eww-browse-url-new-window-is-tab'.
Non-interactively, this uses the optional second argument NEW-WINDOW
instead of `browse-url-new-window-flag'."
(require 'eww)
(when (and new-window
(or (eq eww-browse-url-new-window-is-tab t)
(and (eq eww-browse-url-new-window-is-tab 'tab-bar)
tab-bar-mode)))
(let ((tab-bar-new-tab-choice t))
(tab-new)))
(let ((hpath:display-where-alist
(if new-window 'other-window hpath:display-where-alist)))
(hpath:display-buffer
(generate-new-buffer
(format "*eww-%s*" (url-host (url-generic-parse-url
(eww--dwim-expand-url url)))))))
(eww-mode)
(defvar url-allow-non-local-files) ; Defined from Emacs 29.
(let ((url-allow-non-local-files t))
(eww url)))
(provide 'hsys-www)
;;; hsys-www.el ends here
You can’t perform that action at this time.