| commit | author | age | ||
| 76bbd0 | 1 | ;;; org-eww.el --- Store url and kill from Eww mode for Org -*- lexical-binding: t -*- |
| C | 2 | |
| 3 | ;; Copyright (C) 2014-2018 Free Software Foundation, Inc. | |
| 4 | ||
| 5 | ;; Author: Marco Wahl <marcowahlsoft>a<gmailcom> | |
| 6 | ;; Keywords: link, eww | |
| 7 | ;; Homepage: 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 | (require 'org) | |
| 48 | (require 'cl-lib) | |
| 49 | ||
| 50 | (defvar eww-current-title) | |
| 51 | (defvar eww-current-url) | |
| 52 | (defvar eww-data) | |
| 53 | (defvar eww-mode-map) | |
| 54 | ||
| 55 | (declare-function eww-current-url "eww") | |
| 56 | ||
| 57 | ||
| 58 | ;; Store Org-link in eww-mode buffer | |
| 59 | (org-link-set-parameters "eww" :follow #'eww :store #'org-eww-store-link) | |
| 60 | (defun org-eww-store-link () | |
| 61 | "Store a link to the url of an EWW buffer." | |
| 62 | (when (eq major-mode 'eww-mode) | |
| 63 | (org-store-link-props | |
| 64 | :type "eww" | |
| 65 | :link (if (< emacs-major-version 25) | |
| 66 | eww-current-url | |
| 67 | (eww-current-url)) | |
| 68 | :url (url-view-url t) | |
| 69 | :description (if (< emacs-major-version 25) | |
| 70 | (or eww-current-title eww-current-url) | |
| 71 | (or (plist-get eww-data :title) | |
| 72 | (eww-current-url)))))) | |
| 73 | ||
| 74 | ||
| 75 | ;; Some auxiliary functions concerning links in eww buffers | |
| 76 | (defun org-eww-goto-next-url-property-change () | |
| 77 | "Move to the start of next link if exists. | |
| 78 | Otherwise point is not moved. Return point." | |
| 79 | (goto-char | |
| 80 | (or (next-single-property-change (point) 'shr-url) | |
| 81 | (point)))) | |
| 82 | ||
| 83 | (defun org-eww-has-further-url-property-change-p () | |
| 84 | "Non-nil if there is a next url property change." | |
| 85 | (save-excursion | |
| 86 | (not (eq (point) (org-eww-goto-next-url-property-change))))) | |
| 87 | ||
| 88 | (defun org-eww-url-below-point () | |
| 89 | "Return the url below point if there is an url; otherwise, return nil." | |
| 90 | (get-text-property (point) 'shr-url)) | |
| 91 | ||
| 92 | ||
| 93 | (defun org-eww-copy-for-org-mode () | |
| 94 | "Copy current buffer content or active region with `org-mode' style links. | |
| 95 | This will encode `link-title' and `link-location' with | |
| 96 | `org-make-link-string' and insert the transformed text into the | |
| 97 | kill ring, so that it can be yanked into an Org mode buffer with | |
| 98 | links working correctly. | |
| 99 | ||
| 100 | Further lines starting with a star get quoted with a comma to | |
| 101 | keep the structure of the Org file." | |
| 102 | (interactive) | |
| 103 | (let* ((regionp (org-region-active-p)) | |
| 104 | (transform-start (point-min)) | |
| 105 | (transform-end (point-max)) | |
| 106 | return-content | |
| 107 | link-location link-title | |
| 108 | temp-position out-bound) | |
| 109 | (when regionp | |
| 110 | (setq transform-start (region-beginning)) | |
| 111 | (setq transform-end (region-end)) | |
| 112 | ;; Deactivate mark if current mark is activate. | |
| 113 | (when (fboundp 'deactivate-mark) (deactivate-mark))) | |
| 114 | (message "Transforming links...") | |
| 115 | (save-excursion | |
| 116 | (goto-char transform-start) | |
| 117 | (while (and (not out-bound) ; still inside region to copy | |
| 118 | (org-eww-has-further-url-property-change-p)) ; there is a next link | |
| 119 | ;; Store current point before jump next anchor. | |
| 120 | (setq temp-position (point)) | |
| 121 | ;; Move to next anchor when current point is not at anchor. | |
| 122 | (or (org-eww-url-below-point) | |
| 123 | (org-eww-goto-next-url-property-change)) | |
| 124 | (cl-assert | |
| 125 | (org-eww-url-below-point) t | |
| 126 | "program logic error: point must have an url below but it hasn't") | |
| 127 | (if (<= (point) transform-end) ; if point is inside transform bound | |
| 128 | (progn | |
| 129 | ;; Get content between two links. | |
| 130 | (when (< temp-position (point)) | |
| 131 | (setq return-content (concat return-content | |
| 132 | (buffer-substring | |
| 133 | temp-position (point))))) | |
| 134 | ;; Get link location at current point. | |
| 135 | (setq link-location (org-eww-url-below-point)) | |
| 136 | ;; Get link title at current point. | |
| 137 | (setq link-title | |
| 138 | (buffer-substring | |
| 139 | (point) | |
| 140 | (org-eww-goto-next-url-property-change))) | |
| 141 | ;; concat `org-mode' style url to `return-content'. | |
| 142 | (setq return-content | |
| 143 | (concat return-content | |
| 144 | (if (org-string-nw-p link-location) | |
| 145 | ;; Hint: link-location is different | |
| 146 | ;; for form-elements. | |
| 147 | (org-make-link-string link-location link-title) | |
| 148 | link-title)))) | |
| 149 | (goto-char temp-position) ; reset point before jump next anchor | |
| 150 | (setq out-bound t))) ; for break out `while' loop | |
| 151 | ;; Add the rest until end of the region to be copied. | |
| 152 | (when (< (point) transform-end) | |
| 153 | (setq return-content | |
| 154 | (concat return-content | |
| 155 | (buffer-substring (point) transform-end)))) | |
| 156 | ;; Quote lines starting with *. | |
| 157 | (org-kill-new (replace-regexp-in-string "^\\*" ",*" return-content)) | |
| 158 | (message "Transforming links...done, use C-y to insert text into Org mode file")))) | |
| 159 | ||
| 160 | ||
| 161 | ;; Additional keys for eww-mode | |
| 162 | ||
| 163 | (defun org-eww-extend-eww-keymap () | |
| 164 | (define-key eww-mode-map "\C-c\C-x\M-w" 'org-eww-copy-for-org-mode) | |
| 165 | (define-key eww-mode-map "\C-c\C-x\C-w" 'org-eww-copy-for-org-mode)) | |
| 166 | ||
| 167 | (when (and (boundp 'eww-mode-map) | |
| 168 | (keymapp eww-mode-map)) ; eww is already up. | |
| 169 | (org-eww-extend-eww-keymap)) | |
| 170 | ||
| 171 | (add-hook 'eww-mode-hook #'org-eww-extend-eww-keymap) | |
| 172 | ||
| 173 | ||
| 174 | (provide 'org-eww) | |
| 175 | ||
| 176 | ;;; org-eww.el ends here | |
