summaryrefslogtreecommitdiff
path: root/eww-conf.el
blob: d6d8bd22fd7a17586569c97a81034f4dd62b3ebd (plain)
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
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
;;; eww-conf.el --- My configurations for Emacs Web Wowser -*- lexical-binding: t; -*-

;;; Author: Durand
;;; Created: 2021-01-20

;;; Commentary:

;; Simple configurations for the great Emacs Web Wowser

;;; Code:

(require 'eww)
(require 'shr)

(setq browse-url-browser-function #'durand-browse-url)
(setq browse-url-secondary-browser-function 'browse-url-default-browser)

(setq eww-bookmarks-directory load-file-directory)

(setq eww-search-prefix "https://searx.jsdurand.xyz/searx/search?q=")
(setq eww-restore-desktop t)
(setq eww-desktop-remove-duplicates t)
(setq eww-suggest-uris '(eww-links-at-point thing-at-point-url-at-point))
(setq eww-browse-url-new-window-is-tab nil)

;;; Open URL in an external browser if given a prefix argument.

(defun durand-browse-url (url &optional arg)
  "Open URL in a browser.
If ARG is nil, open in EWW.  Otherwise, open in an external browser."
  (cond
   (arg (funcall browse-url-secondary-browser-function url))
   ((eww-browse-url url))))

;;; Elpher integration

(use-package "elpher" 'elpher)

(defun eww-open-elpher (old url &rest args)
  "Use Elpher to open the URL if needed."
  (cond
   ((member (url-type (url-generic-parse-url url))
            (list "gemini" "gopher"))
    (elpher-go url))
   ((apply old (cons url args)))))

(advice-add #'eww-browse-url :around #'eww-open-elpher)
(advice-add #'eww :around #'eww-open-elpher)

;;; Use pdf-view to view PDF files if available.

(setq mailcap-prefer-mailcap-viewers nil)

(setq mailcap-user-mime-data
      '(((viewer . pdf-view-mode)
         (type . "application/pdf")
         (test . window-system))
        ((viewer . doc-view-mode)
         (type . "application/pdf")
         (test . window-system))))

;; key-bindings

(define-key global-map (vector ?\s-w) 'durand-eww-map)

;;;###autoload
(fset 'durand-eww-map
      (let ((map (list 'keymap "EWW")))
        (define-key map (vector ?b) #'eww-visit-bookmark)
        (define-key map (vector ?e) #'eww-dwim)
        map))

(define-key eww-link-keymap (kbd "v") nil) ; stop overriding `eww-view-source'
(define-key eww-mode-map (kbd "L") #'eww-list-bookmarks)
(define-key eww-mode-map (vector ?f) #'eww-find-feed)
(define-key eww-mode-map (vector ?b) #'eww-visit-bookmark)
(define-key eww-mode-map (vector ?e) #'eww-dwim)
(define-key eww-mode-map (vector ?o) #'eww-open-in-new-buffer)
(define-key eww-mode-map (vector ?E) #'eww-visit-url-on-page)
(define-key eww-mode-map (vector ?J) #'eww-jump-to-url-on-page)
(define-key eww-mode-map (vector ?m) #'eww-add-bookmark)
(define-key eww-mode-map (vector ?d) #'durand-eww-download)
(define-key dired-mode-map (kbd "E") #'eww-open-file) ; to render local HTML files
(define-key eww-buffers-mode-map (kbd "d") #'eww-bookmark-kill)   ; it actually deletes
(define-key eww-bookmark-mode-map (kbd "d") #'eww-bookmark-kill)  ; same

(setq shr-use-colors nil)             ; t is bad for accessibility
(setq shr-use-fonts nil)              ; t is not for me
(setq shr-max-image-proportion 0.6)
(setq shr-image-animate nil)          ; No GIFs, thank you!
(setq shr-width nil)                  ; check `prot-eww-readable'
(setq shr-discard-aria-hidden t)
(setq shr-cookie-policy nil)

;; This feels quicker.
(cond ((version<= "28" emacs-version))
      ((setq eww-retrieve-command '("wget" "--quiet" "--output-document=-"))))

(define-key eww-mode-map (vector 'C-tab)
  #'durand-eww-goto-search-result)

;;;###autoload
(defun durand-eww-goto-search-result ()
  "Go to the search results on a search page.
Otherwise, just go to the beginning of the page."
  (interactive)
  (save-match-data
    (cond
     ((string-match-p "searx\\." (plist-get eww-data :url))
      (re-search-forward "search results"))
     ((goto-char (point-min)))))
  (recenter 0))

;;; the following are adapted from Protesilaos' dotemacs.

;;;###autoload
(defconst eww-name-separator "-"
  "The separator between the title and the mark EWW in the \
names.")

;;;###autoload
(defun eww-rename-buffer ()
  "Rename EWW buffer using page title or URL.
To be used by `eww-after-render-hook'."
  (let ((name (cond
               ((and (plist-get eww-data :title)
                     (not (string= (plist-get eww-data :title) "")))
                (plist-get eww-data :title))
               ((plist-get eww-data :url)))))
    (rename-buffer (format "*%s %s eww*" name eww-name-separator) t)))

(add-hook 'eww-after-render-hook #'eww-rename-buffer)
(advice-add 'eww-back-url :after #'eww-rename-buffer)
(advice-add 'eww-forward-url :after #'eww-rename-buffer)

;;;###autoload
(defvar eww-visited-history nil
  "History of visited URLs.")

;;;###autoload
(defun eww-record-history ()
  "Store URL in `eww-visited-history'.
To be used by `eww-after-render-hook'."
  (add-to-history 'eww-visited-history (plist-get eww-data :url)))

(add-hook 'eww-after-render-hook #'eww-record-history)
(advice-add 'eww-back-url :after #'eww-record-history)
(advice-add 'eww-forward-url :after #'eww-record-history)

;;;; Commands

;;;###autoload
(defun eww-dwim (url &optional arg)
  "Visit a URL, maybe from `eww-prompt-history', with completion.
With optional prefix ARG (\\[universal-argument]) open URL in a
new eww buffer.
If URL does not look like a valid link, run a web query using
`eww-search-prefix'.
When called from an eww buffer, provide the current link as
default candidate."
  (interactive
   (list
    (completing-read "Run EWW on: "
                     (delete-dups (append eww-visited-history eww-prompt-history))
                     nil nil nil 'eww-prompt-history (plist-get eww-data :url) t)
    current-prefix-arg))
  (eww url (cond (arg 4))))

;;;###autoload
(defun eww-visit-bookmark (&optional arg)
  "Visit bookmarked URL.
With optional prefix ARG (\\[universal-argument]) open URL in a
new EWW buffer."
  (interactive "P")
  (eww-read-bookmarks)
  (let ((candidates (mapcar
                     (lambda (element)
                       (plist-get element :url))
                     eww-bookmarks)))
    (eww (completing-read "Visit EWW bookmark: " candidates)
         (cond (arg 4)))))

;;;###autoload
(defun eww-visit-url-on-page (&optional arg)
  "Visit URL from list of links on the page using completion.
With optional prefix ARG (\\[universal-argument]) open URL in a
new EWW buffer."
  (interactive "P")
  (cond
   ((derived-mode-p 'eww-mode)
    (let (links)
      (save-excursion
        (goto-char (point-max))
        (while (text-property-search-backward 'shr-url nil nil t)
          (cond
           ((and (get-text-property (point) 'shr-url)
                 (not (get-text-property (point) 'eww-form)))
            (setq links
                  (cons (format "%s @ %s"
                                (button-label (point))
                                (propertize (get-text-property (point) 'shr-url) 'face 'link))
                        links))))))
      (let* ((selection (completing-read "Browse URL from page: " links nil t))
             (match-ending (progn (string-match " @ " selection)
                                 (match-end 0)))
             (url (substring-no-properties selection match-ending)))
        (eww url (cond (arg 4))))))))

;;;###autoload
(defun eww-jump-to-url-on-page ()
  "Jump to URL position on the page using completion.
With optional prefix ARG (\\[universal-argument]) open URL in a
new EWW buffer."
  (interactive)
  (cond
   ((derived-mode-p 'eww-mode)
    (let ((links))
      (save-excursion
        (goto-char (point-max))
        (while (text-property-search-backward 'shr-url nil nil t)
          (cond
           ((and (get-text-property (point) 'shr-url)
                 (not (get-text-property (point) 'eww-form)))
            (setq links
                  (cons (format "%s @ %s ~ %d"
                                (button-label (point))
                                (propertize (get-text-property (point) 'shr-url) 'face 'link)
                                (point))
                        links))))))
      (let* ((selection (completing-read "Jump to URL on page: " links nil t))
             (match-ending (progn (string-match " ~ " selection)
                                  (match-end 0)))
             (position (string-to-number
                        (substring-no-properties selection match-ending))))
        (goto-char position)
        (durand-pulse-pulse-line))))))

(defvar eww-occur-feed-regexp
  (concat "\\(rss\\|atom\\)\\+xml.\\(.\\|\n\\)"
          ".*href=[\"']\\(.*?\\)[\"']")
  "Regular expression to match web feeds in HTML source.")

;;;###autoload
(defun eww-find-feed ()
  "Produce bespoke buffer with RSS/Atom links from XML source."
  (interactive)
  (let* ((url (or (plist-get eww-data :start)
                  (plist-get eww-data :contents)
                  (plist-get eww-data :home)
                  (plist-get eww-data :url)))
         (title (or (plist-get eww-data :title) url))
         (source (plist-get eww-data :source))
         (buf-name (format "*feeds: %s %s eww*" title
                           eww-name-separator))
         (inhibit-read-only t)
         (base-url (replace-regexp-in-string "\\(.*/\\)[^/]+\\'" "\\1" url)))
    (cond
     (source
      (with-temp-buffer
        (insert source)
        (occur-1 eww-occur-feed-regexp "\\3" (list (current-buffer)) buf-name))
      ;; Comment by Protesilaos:
      ;; Handle relative URLs, so that we get an absolute URL out of them.
      ;; Findings like "rss.xml" are not particularly helpful.
      ;;
      ;; NOTE 2021-03-31: the base-url heuristic may not always be
      ;; correct, though it has worked in all websites I have tested it
      ;; in.
      (cond
       ((get-buffer buf-name)
        (with-current-buffer (get-buffer buf-name)
          (goto-char (point-min))
          (cond
           ((re-search-forward browse-url-button-regexp nil t))
           ((re-search-forward ".*" nil t)
            (replace-match (concat base-url "\\&"))))))))
     (t
      ;; Sometimes a page has no sources
      (let ((nodes (dom-search
                    (plist-get eww-data :dom)
                    (lambda (node)
                      (and
                       (eq (dom-tag node) 'link)
                       (dom-attr node 'type)
                       (string-match "\\(?:rss\\|atom\\)\\+xml"
                                     (dom-attr node 'type)))))))
        (with-current-buffer (get-buffer-create buf-name)
          (mapc (lambda (node)
                  (insert (dom-attr node 'title)
                          " - "
                          (dom-attr node 'href)
                          "\n"))
                nodes))
        (display-buffer (get-buffer buf-name)))))))

;; REVIEW: the line containing the universal argument looks longer in
;; the source form, and when expanded in the help buffer, it will fit
;; perfectly.  But this does not seem to be the right approach, since
;; this makes it harder to people to read the sources.  Is it possible
;; to process the documentation string in the help buffer, so that the
;; documentation strings look nice in every place.

;;;###autoload
(defun durand-eww-download (&optional url name dir)
  "Download URL to DIR as NAME.
URL defaults to the link at point if any, else to the current
page's URL.

NAME defaults to the title of the current page if it can be
found, else to the last component of the current page's URL, if
any.  In addition, the name will be suitably processed so that it
fits into a file name.

DIR defaults to `eww-download-directory'.

In interactive uses, with a universal argument (\\[universal-argument]), prompt
for URL, NAME, and DIR, providing the default values for the 
users to select."
  (interactive
   (cond
    (current-prefix-arg
     (list (let ((default-url (or (get-text-property (point) 'shr-url)
                                  (eww-current-url))))
             (read-string (cond
                           ((and (stringp default-url)
                                 (not (string= default-url "")))
                            (format "Download URL (default %s): "
                                    default-url))
                           ("Download URL: "))
                          nil nil default-url))
           (let ((default-title
                   (or (plist-get eww-data :title)
                       (file-name-nondirectory
                        (eww-current-url)))))
             (read-string (cond
                           ((and (stringp default-title)
                                 (not (string= default-title "")))
                            (format "Download as (default %s) "
                                    default-title))
                           ("Download as "))
                          nil nil default-title))
           (read-file-name
            "Download to: " eww-download-directory
            eww-download-directory nil nil
            #'file-accessible-directory-p)))
    ((list (or (get-text-property (point) 'shr-url) (eww-current-url))
           (or (plist-get eww-data :title)
               (file-name-nondirectory (eww-current-url)))
           eww-download-directory))))
  ;; eww-download-directory might be a function
  (cond
   ((functionp dir) (setq dir (funcall dir))))
  ;; Check the validity of DIR
  (cond ((and (stringp dir) (not (string= dir ""))
              (file-accessible-directory-p dir)))
        ((and (stringp dir) (not (string= dir ""))
              (file-exists-p dir))
         (user-error "%s is an existing file that is not a directory"
                     dir))
        ((and (stringp dir) (not (string= dir "")))
         ;; create the dir for the user
         (cond ((y-or-n-p "Create a directory to download to? ")
                (make-directory dir t))
               ((user-error "A non-existent directory"))))
        ((user-error "DIR should be a non-empty string, but got %S"
                     dir)))
  ;; Check the validity of NAME
  (cond
   ((and (stringp name) (not (string= name ""))))
   ((let ((default (or (plist-get eww-data :title)
                       (file-name-nondirectory
                        (eww-current-url)))))
      (and (stringp default) (not (string= default ""))
           (setq name default))))
   ((user-error "NAME should be a non-empty string, but got %S"
                name)))
  ;; sluggish the name -- taken from Protesilaos' codes
  (setq name
        (downcase
         (replace-regexp-in-string
          "-$" ""
          (replace-regexp-in-string
           "--+" "-"
           (replace-regexp-in-string
            "\\s-+" "-"
            (replace-regexp-in-string
             "[][{}!@#$%^&*()_=+'\"?,.\|;:~`‘’“”]*" "" name))))))
  
  ;; Check the validity of URL
  (cond
   ((and (stringp url) (not (string= url ""))))
   ((user-error "URL should be a non-empty string, but got %S"
                url)))
  (url-retrieve url #'durand-eww-download-callback
                (list name dir)))

;;;###autoload
(defun durand-eww-download-callback (status name dir)
  "The callback function for `durand-eww-download'.
For the meaning of STATUS, see the documentation of
`url-retrieve'.

For the meanings of NAME and DIR, see the documentation of
`durand-eww-download'."
  (cond
   ((plist-get status :error)
    (user-error "Error: %S" (plist-get status :error))))
  (let ((file (eww-make-unique-file-name name dir)))
    (goto-char (point-min))
    (re-search-forward "\r?\n\r?\n")
    (let ((coding-system-for-write 'no-conversion))
      (write-region (point) (point-max) file))
    (message "Saved %s" file)))

;;; Bookmark integration

;;;; Readbable mode distinction

;; This section modifies the behaviour of `eww-readable' so that when
;; we are viewing readable parts of the webpage, there is a variable
;; saying so.

(defvar durand-eww-readable-p nil
  "If non-nil, we are viewing the readable parts of a webpage.")

(make-variable-buffer-local 'durand-eww-readable-p)

(defun eww-non-readable-h ()
  "Set `durand-eww-readable-p' to nil."
  (setq-local durand-eww-readable-p nil))

(defun eww-readable-h ()
  "Set `durand-eww-readable-p' to t."
  (setq-local durand-eww-readable-p t))

(add-hook 'eww-after-render-hook #'eww-non-readable-h -10)

(advice-add #'eww-readable :after #'eww-readable-h)

;;;; Making records

;; This section defines functions to make bookmarks for EWW buffers
;; and to jump to those bookmarks.

(defun durand-eww-bookmark-make-record ()
  "Return a bookmark record for the current page."
  (cond
   ((not (derived-mode-p 'eww-mode))
    (user-error "Making an EWW bookmark for a non-EWW buffer")))
  (let* ((url (plist-get eww-data :url))
         (title (format "(EWW) %s" (plist-get eww-data :title)))
         (position (point))
         (readablep durand-eww-readable-p)
         (defaults (delq nil (list 'defaults title url))))
    (cond
     ((null url) (user-error "No link for the current page")))
    (append
     (list
      title
      (cons 'location url)
      (cons 'handler #'durand-eww-bookmark-jump)
      (cons 'readablep readablep)
      defaults)
     (bookmark-make-record-default 'no-file nil position))))

;; Copied from Protesilaos' dotemacs
(defun durand-eww-set-bookmark-record-function ()
  "Set appropriate `bookmark-make-record-function'.
Intended for use with `eww-mode-hook'."
  (setq-local
   bookmark-make-record-function #'durand-eww-bookmark-make-record))

(add-hook 'eww-mode-hook #'durand-eww-set-bookmark-record-function)

;;;; Jumping

;; HACK: Use an advice to temporarily override the definition of
;; pop-to-buffer.

(defun durand-pop-to-buffer-advice (buffer &rest args)
  "Set BUFFER and ignore ARGS.
Just a temporary advice to override `pop-to-buffer'."
  (set-buffer buffer))

;; NOTE: It works with jumping in another window.

;; This is added in Emacs-29.
(put 'durand-eww-bookmark-jump 'bookmark-handler-type "EWW")

;;;###autoload
(defun durand-eww-bookmark-jump (bookmark)
  "Jump to BOOKMARK in EWW.
This is intended to be the handler for bookmark records created
by `durand-eww-bookmark-make-record'.

If there is already a buffer visiting the URL of the bookmark,
simply jump to that buffer and try to restore the point there.
Otherwise, fetch URL and afterwards try to restore the point."
  (let ((handler (bookmark-get-handler bookmark))
        (location (bookmark-prop-get bookmark 'location))
        (front (cons 'front-context-string
                     (bookmark-get-front-context-string bookmark)))
        (rear (cons 'rear-context-string
                    (bookmark-get-rear-context-string bookmark)))
        (position (cons 'position (bookmark-get-position bookmark)))
        (eww-buffers
         (delq
          nil
          (mapcar
           (lambda (buffer)
             (cond
              ((and
                (buffer-live-p buffer)
                (provided-mode-derived-p
                 (buffer-local-value
                  'major-mode buffer)
                 'eww-mode))
               buffer)))
           (buffer-list))))
        buffer)
    (cond
     ((and (stringp location)
           (not (string= location ""))
           (eq handler #'durand-eww-bookmark-jump))
      (let (reuse-p)
        (mapc
         (lambda (temp-buffer)
           (cond
            ((string=
              (plist-get
               (buffer-local-value 'eww-data temp-buffer)
               :url)
              location)
             (setq reuse-p temp-buffer)
             (setq buffer temp-buffer))))
         eww-buffers)
        ;; Don't switch to that buffer, otherwise it will cause
        ;; problems if we want to open the bookmark in another window.
        (cond
         (reuse-p
          (set-buffer reuse-p)
          ;; we may use the default handler to restore the position
          ;; here
          (with-current-buffer reuse-p
            (goto-char (cdr position))
            (cond
             ((and
               (stringp (cdr front))
               (search-forward (cdr front) nil t))
              (goto-char (match-beginning 0))))
            (cond
             ((and (stringp (cdr rear))
                   (search-forward (cdr rear) nil t))
              (goto-char (match-end 0))))))
         (t
          ;; HACK, GIANT HACK!
          
          (advice-add #'pop-to-buffer :override
                      #'durand-pop-to-buffer-advice)
          (eww location 4)
          ;; after the `set-buffer' in `eww', the current buffer is
          ;; the buffer we want
          (setq buffer (current-buffer))
          ;; restore the definition of pop-to-buffer...
          (advice-remove
           #'pop-to-buffer #'durand-pop-to-buffer-advice)
          ;; add a hook to restore the position

          ;; make sure each hook function is unique, so that different
          ;; hooks don't interfere with each other.
          (let ((function-symbol
                 (intern
                  (format
                   "eww-render-hook-%s"
                   (bookmark-name-from-full-record
                    (bookmark-get-bookmark bookmark))))))
            (fset function-symbol
                  (lambda ()
                    (remove-hook
                     'eww-after-render-hook function-symbol)
                    ;; if the bookmark records a readable webpage,
                    ;; enter readable mode again.
                    (cond
                     ((bookmark-prop-get bookmark 'readablep)
                      (eww-readable)))
                    (bookmark-default-handler
                     (list
                      "" (cons 'buffer buffer)
                      front rear position))))
            ;; make sure this hook is added after the hook that sets
            ;; the readable mode to nil, so that the readable mode is
            ;; correctly set to t.
            (add-hook 'eww-after-render-hook function-symbol 10))))))
     ((user-error "Cannot jump to this bookmark")))))

(provide 'eww-conf)

;;; eww-conf.el ends here