ol-eww.el (6101B)
1 ;;; ol-eww.el --- Store URL and kill from Eww mode -*- lexical-binding: t -*- 2 3 ;; Copyright (C) 2014-2023 Free Software Foundation, Inc. 4 5 ;; Author: Marco Wahl <marcowahlsoft>a<gmailcom> 6 ;; Keywords: link, eww 7 ;; URL: https://orgmode.org 8 9 ;; This file is part of GNU Emacs. 10 11 ;; GNU Emacs is free software: you can redistribute it and/or modify 12 ;; it under the terms of the GNU General Public License as published by 13 ;; the Free Software Foundation, either version 3 of the License, or 14 ;; (at your option) any later version. 15 16 ;; GNU Emacs is distributed in the hope that it will be useful, 17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 ;; GNU General Public License for more details. 20 21 ;; You should have received a copy of the GNU General Public License 22 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 23 24 25 ;;; Commentary: 26 27 ;; When this module is active `org-store-link' (often on key C-c l) in 28 ;; an EWW buffer stores a link to the current url of the eww buffer. 29 30 ;; In an EWW buffer function `org-eww-copy-for-org-mode' kills either 31 ;; a region or the whole buffer if no region is set and transforms the 32 ;; text on the fly so that it can be pasted into an Org buffer with 33 ;; hot links. 34 35 ;; C-c C-x C-w (and also C-c C-x M-w) trigger 36 ;; `org-eww-copy-for-org-mode'. 37 38 ;; Hint: A lot of code of this module comes from module org-w3m which 39 ;; has been written by Andy Steward based on the idea of Richard 40 ;; Riley. Thanks! 41 42 ;; Potential: Since the code for w3m and eww is so similar one could 43 ;; try to refactor. 44 45 46 ;;; Code: 47 48 (require 'org-macs) 49 (org-assert-version) 50 51 (require 'ol) 52 (require 'cl-lib) 53 (require 'eww) 54 55 56 ;; Store Org link in Eww mode buffer 57 (org-link-set-parameters "eww" 58 :follow #'org-eww-open 59 :store #'org-eww-store-link) 60 61 (defun org-eww-open (url _) 62 "Open URL with Eww in the current buffer." 63 (eww url)) 64 65 (defun org-eww-store-link () 66 "Store a link to the url of an EWW buffer." 67 (when (eq major-mode 'eww-mode) 68 (org-link-store-props 69 :type "eww" 70 :link (eww-current-url) 71 :url (url-view-url t) 72 :description (or (plist-get eww-data :title) 73 (eww-current-url))))) 74 75 76 ;; Some auxiliary functions concerning links in Eww buffers 77 (defun org-eww-goto-next-url-property-change () 78 "Move to the start of next link if exists. 79 Otherwise point is not moved. Return point." 80 (goto-char 81 (or (next-single-property-change (point) 'shr-url) 82 (point)))) 83 84 (defun org-eww-has-further-url-property-change-p () 85 "Non-nil if there is a next url property change." 86 (save-excursion 87 (not (eq (point) (org-eww-goto-next-url-property-change))))) 88 89 (defun org-eww-url-below-point () 90 "Return the url below point if there is an url; otherwise, return nil." 91 (get-text-property (point) 'shr-url)) 92 93 94 (defun org-eww-copy-for-org-mode () 95 "Copy current buffer content or active region with `org-mode' style links. 96 This will encode `link-title' and `link-location' with 97 `org-link-make-string' and insert the transformed text into the 98 kill ring, so that it can be yanked into an Org mode buffer with 99 links working correctly. 100 101 Further lines starting with a star get quoted with a comma to 102 keep the structure of the Org file." 103 (interactive) 104 (let* ((regionp (org-region-active-p)) 105 (transform-start (point-min)) 106 (transform-end (point-max)) 107 return-content 108 link-location link-title 109 temp-position out-bound) 110 (when regionp 111 (setq transform-start (region-beginning)) 112 (setq transform-end (region-end)) 113 ;; Deactivate mark if current mark is activate. 114 (deactivate-mark)) 115 (message "Transforming links...") 116 (save-excursion 117 (goto-char transform-start) 118 (while (and (not out-bound) ; still inside region to copy 119 (org-eww-has-further-url-property-change-p)) ; there is a next link 120 ;; Store current point before jump next anchor. 121 (setq temp-position (point)) 122 ;; Move to next anchor when current point is not at anchor. 123 (or (org-eww-url-below-point) 124 (org-eww-goto-next-url-property-change)) 125 (cl-assert 126 (org-eww-url-below-point) t 127 "program logic error: point must have an url below but it hasn't") 128 (if (<= (point) transform-end) ; if point is inside transform bound 129 (progn 130 ;; Get content between two links. 131 (when (< temp-position (point)) 132 (setq return-content (concat return-content 133 (buffer-substring 134 temp-position (point))))) 135 ;; Get link location at current point. 136 (setq link-location (org-eww-url-below-point)) 137 ;; Get link title at current point. 138 (setq link-title 139 (buffer-substring 140 (point) 141 (org-eww-goto-next-url-property-change))) 142 ;; concat `org-mode' style url to `return-content'. 143 (setq return-content 144 (concat return-content 145 (if (org-string-nw-p link-location) 146 ;; Hint: link-location is different 147 ;; for form-elements. 148 (org-link-make-string link-location link-title) 149 link-title)))) 150 (goto-char temp-position) ; reset point before jump next anchor 151 (setq out-bound t))) ; for break out `while' loop 152 ;; Add the rest until end of the region to be copied. 153 (when (< (point) transform-end) 154 (setq return-content 155 (concat return-content 156 (buffer-substring (point) transform-end)))) 157 ;; Quote lines starting with *. 158 (org-kill-new (replace-regexp-in-string "^\\*" ",*" return-content)) 159 (message "Transforming links...done, use C-y to insert text into Org mode file")))) 160 161 162 ;; Additional keys for eww-mode 163 164 (defun org-eww-extend-eww-keymap () 165 (define-key eww-mode-map "\C-c\C-x\M-w" 'org-eww-copy-for-org-mode) 166 (define-key eww-mode-map "\C-c\C-x\C-w" 'org-eww-copy-for-org-mode)) 167 168 (when (and (boundp 'eww-mode-map) 169 (keymapp eww-mode-map)) ; eww is already up. 170 (org-eww-extend-eww-keymap)) 171 172 (add-hook 'eww-mode-hook #'org-eww-extend-eww-keymap) 173 174 175 (provide 'ol-eww) 176 177 ;;; ol-eww.el ends here