-
Notifications
You must be signed in to change notification settings - Fork 11
/
Copy pathhsys-www.el
208 lines (188 loc) · 7.94 KB
/
hsys-www.el
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
;;; 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: 18-Jan-24 at 23:59:15 by Mats Lidell
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
;; Copyright (C) 1994-2021 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)
(require 'eww) ;; Must load to override it's function `eww-browse-url' below.
(require 'hbut)
;;; ************************************************************************
;;; Public declarations
;;; ************************************************************************
(defvar hpath:display-where-alist) ; "hpath.el"
(declare-function hpath:remote-available-p "hpath")
(declare-function hpath:remote-p "hpath")
(declare-function hpath:remote-at-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-link-at-point))
(ibut:label-set (eww-link-at-point))
(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 www-url (url)
"Follow a link given by URL.
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'."
(interactive "sURL to follow: ")
(or (stringp url)
(error "(www-url): URL = `%s' but must be a string" 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-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")))
;;;###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 eww-browse-url (url &optional new-window)
"Ask the eww browser to load URL.
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'."
(when (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)
(eww url))
(provide 'hsys-www)
;;; hsys-www.el ends here