2019-03-01 19:01:32 -05:00
|
|
|
|
;;; ol-eww.el --- Store URL and kill from Eww mode -*- lexical-binding: t -*-
|
2014-09-23 03:46:34 -04:00
|
|
|
|
|
2022-01-01 15:10:55 -05:00
|
|
|
|
;; Copyright (C) 2014-2022 Free Software Foundation, Inc.
|
2014-09-23 03:46:34 -04:00
|
|
|
|
|
|
|
|
|
;; Author: Marco Wahl <marcowahlsoft>a<gmailcom>
|
|
|
|
|
;; Keywords: link, eww
|
2021-09-26 03:44:29 -04:00
|
|
|
|
;; URL: https://orgmode.org
|
2017-07-05 14:08:35 -04:00
|
|
|
|
|
2016-08-19 20:59:56 -04:00
|
|
|
|
;; This file is part of GNU Emacs.
|
2017-07-05 14:08:35 -04:00
|
|
|
|
|
|
|
|
|
;; GNU Emacs is free software: you can redistribute it and/or modify
|
2014-09-23 03:46:34 -04:00
|
|
|
|
;; it under the terms of the GNU General Public License as published by
|
|
|
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
|
|
|
;; (at your option) any later version.
|
|
|
|
|
|
2017-07-05 14:08:35 -04:00
|
|
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
2014-09-23 03:46:34 -04:00
|
|
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
|
|
;; GNU General Public License for more details.
|
|
|
|
|
|
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
2017-09-13 18:52:52 -04:00
|
|
|
|
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
2014-09-23 03:46:34 -04:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;; Commentary:
|
|
|
|
|
|
|
|
|
|
;; When this module is active `org-store-link' (often on key C-c l) in
|
2018-02-16 15:16:15 -05:00
|
|
|
|
;; an EWW buffer stores a link to the current url of the eww buffer.
|
2014-09-23 03:46:34 -04:00
|
|
|
|
|
2018-02-16 15:16:15 -05:00
|
|
|
|
;; In an EWW buffer function `org-eww-copy-for-org-mode' kills either
|
2014-10-07 10:07:15 -04:00
|
|
|
|
;; a region or the whole buffer if no region is set and transforms the
|
2016-08-23 16:13:56 -04:00
|
|
|
|
;; text on the fly so that it can be pasted into an Org buffer with
|
|
|
|
|
;; hot links.
|
2014-09-23 03:46:34 -04:00
|
|
|
|
|
2014-10-07 10:07:15 -04:00
|
|
|
|
;; C-c C-x C-w (and also C-c C-x M-w) trigger
|
|
|
|
|
;; `org-eww-copy-for-org-mode'.
|
|
|
|
|
|
|
|
|
|
;; Hint: A lot of code of this module comes from module org-w3m which
|
|
|
|
|
;; has been written by Andy Steward based on the idea of Richard
|
|
|
|
|
;; Riley. Thanks!
|
|
|
|
|
|
|
|
|
|
;; Potential: Since the code for w3m and eww is so similar one could
|
|
|
|
|
;; try to refactor.
|
2014-09-23 03:46:34 -04:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;; Code:
|
2018-11-26 18:04:41 -05:00
|
|
|
|
(require 'ol)
|
2016-08-19 20:59:56 -04:00
|
|
|
|
(require 'cl-lib)
|
2020-02-17 05:28:50 -05:00
|
|
|
|
(require 'eww)
|
2016-08-19 20:59:56 -04:00
|
|
|
|
|
2014-10-07 10:07:15 -04:00
|
|
|
|
|
2019-03-01 19:01:32 -05:00
|
|
|
|
;; Store Org link in Eww mode buffer
|
2020-02-17 05:28:50 -05:00
|
|
|
|
(org-link-set-parameters "eww"
|
|
|
|
|
:follow #'org-eww-open
|
|
|
|
|
:store #'org-eww-store-link)
|
|
|
|
|
|
|
|
|
|
(defun org-eww-open (url _)
|
|
|
|
|
"Open URL with Eww in the current buffer."
|
|
|
|
|
(eww url))
|
|
|
|
|
|
2014-09-23 03:46:34 -04:00
|
|
|
|
(defun org-eww-store-link ()
|
2018-02-16 15:16:15 -05:00
|
|
|
|
"Store a link to the url of an EWW buffer."
|
2014-09-23 03:46:34 -04:00
|
|
|
|
(when (eq major-mode 'eww-mode)
|
2018-11-26 18:04:41 -05:00
|
|
|
|
(org-link-store-props
|
2014-09-23 03:46:34 -04:00
|
|
|
|
:type "eww"
|
2021-10-04 23:43:14 -04:00
|
|
|
|
:link (eww-current-url)
|
2014-09-23 03:46:34 -04:00
|
|
|
|
:url (url-view-url t)
|
2021-10-04 23:43:14 -04:00
|
|
|
|
:description (or (plist-get eww-data :title)
|
|
|
|
|
(eww-current-url)))))
|
2014-09-23 03:46:34 -04:00
|
|
|
|
|
2014-10-07 10:07:15 -04:00
|
|
|
|
|
2019-03-01 19:01:32 -05:00
|
|
|
|
;; Some auxiliary functions concerning links in Eww buffers
|
2014-10-07 10:07:15 -04:00
|
|
|
|
(defun org-eww-goto-next-url-property-change ()
|
2016-08-08 05:23:24 -04:00
|
|
|
|
"Move to the start of next link if exists.
|
|
|
|
|
Otherwise point is not moved. Return point."
|
2014-10-07 10:07:15 -04:00
|
|
|
|
(goto-char
|
|
|
|
|
(or (next-single-property-change (point) 'shr-url)
|
|
|
|
|
(point))))
|
|
|
|
|
|
2016-01-09 17:14:47 -05:00
|
|
|
|
(defun org-eww-has-further-url-property-change-p ()
|
2016-08-08 05:23:24 -04:00
|
|
|
|
"Non-nil if there is a next url property change."
|
2014-10-07 10:07:15 -04:00
|
|
|
|
(save-excursion
|
2016-01-09 17:14:47 -05:00
|
|
|
|
(not (eq (point) (org-eww-goto-next-url-property-change)))))
|
2014-10-07 10:07:15 -04:00
|
|
|
|
|
|
|
|
|
(defun org-eww-url-below-point ()
|
|
|
|
|
"Return the url below point if there is an url; otherwise, return nil."
|
|
|
|
|
(get-text-property (point) 'shr-url))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun org-eww-copy-for-org-mode ()
|
|
|
|
|
"Copy current buffer content or active region with `org-mode' style links.
|
|
|
|
|
This will encode `link-title' and `link-location' with
|
2018-11-26 18:04:41 -05:00
|
|
|
|
`org-link-make-string' and insert the transformed text into the
|
2018-04-26 03:56:45 -04:00
|
|
|
|
kill ring, so that it can be yanked into an Org mode buffer with
|
|
|
|
|
links working correctly.
|
2015-07-11 06:01:02 -04:00
|
|
|
|
|
2018-04-26 03:56:45 -04:00
|
|
|
|
Further lines starting with a star get quoted with a comma to
|
|
|
|
|
keep the structure of the Org file."
|
2014-10-07 10:07:15 -04:00
|
|
|
|
(interactive)
|
|
|
|
|
(let* ((regionp (org-region-active-p))
|
|
|
|
|
(transform-start (point-min))
|
|
|
|
|
(transform-end (point-max))
|
|
|
|
|
return-content
|
|
|
|
|
link-location link-title
|
|
|
|
|
temp-position out-bound)
|
|
|
|
|
(when regionp
|
|
|
|
|
(setq transform-start (region-beginning))
|
|
|
|
|
(setq transform-end (region-end))
|
|
|
|
|
;; Deactivate mark if current mark is activate.
|
2021-09-26 15:29:25 -04:00
|
|
|
|
(deactivate-mark))
|
2014-10-07 10:07:15 -04:00
|
|
|
|
(message "Transforming links...")
|
|
|
|
|
(save-excursion
|
|
|
|
|
(goto-char transform-start)
|
2016-08-08 05:28:12 -04:00
|
|
|
|
(while (and (not out-bound) ; still inside region to copy
|
2016-01-09 17:14:47 -05:00
|
|
|
|
(org-eww-has-further-url-property-change-p)) ; there is a next link
|
2016-08-08 05:28:12 -04:00
|
|
|
|
;; Store current point before jump next anchor.
|
2014-10-07 10:07:15 -04:00
|
|
|
|
(setq temp-position (point))
|
2016-08-08 05:28:12 -04:00
|
|
|
|
;; Move to next anchor when current point is not at anchor.
|
2014-10-07 10:07:15 -04:00
|
|
|
|
(or (org-eww-url-below-point)
|
|
|
|
|
(org-eww-goto-next-url-property-change))
|
2016-08-19 20:59:56 -04:00
|
|
|
|
(cl-assert
|
|
|
|
|
(org-eww-url-below-point) t
|
|
|
|
|
"program logic error: point must have an url below but it hasn't")
|
2016-08-08 05:28:12 -04:00
|
|
|
|
(if (<= (point) transform-end) ; if point is inside transform bound
|
2014-10-07 10:07:15 -04:00
|
|
|
|
(progn
|
2016-08-08 05:28:12 -04:00
|
|
|
|
;; Get content between two links.
|
|
|
|
|
(when (< temp-position (point))
|
|
|
|
|
(setq return-content (concat return-content
|
|
|
|
|
(buffer-substring
|
|
|
|
|
temp-position (point)))))
|
|
|
|
|
;; Get link location at current point.
|
2014-10-07 10:07:15 -04:00
|
|
|
|
(setq link-location (org-eww-url-below-point))
|
2016-08-08 05:28:12 -04:00
|
|
|
|
;; Get link title at current point.
|
2014-10-07 10:07:15 -04:00
|
|
|
|
(setq link-title
|
|
|
|
|
(buffer-substring
|
|
|
|
|
(point)
|
|
|
|
|
(org-eww-goto-next-url-property-change)))
|
|
|
|
|
;; concat `org-mode' style url to `return-content'.
|
2017-02-12 03:00:56 -05:00
|
|
|
|
(setq return-content
|
|
|
|
|
(concat return-content
|
2018-04-14 13:30:17 -04:00
|
|
|
|
(if (org-string-nw-p link-location)
|
|
|
|
|
;; Hint: link-location is different
|
|
|
|
|
;; for form-elements.
|
2018-11-26 18:04:41 -05:00
|
|
|
|
(org-link-make-string link-location link-title)
|
2017-02-12 03:00:56 -05:00
|
|
|
|
link-title))))
|
2016-08-08 05:28:12 -04:00
|
|
|
|
(goto-char temp-position) ; reset point before jump next anchor
|
2018-04-14 13:30:17 -04:00
|
|
|
|
(setq out-bound t))) ; for break out `while' loop
|
2016-08-08 05:28:12 -04:00
|
|
|
|
;; Add the rest until end of the region to be copied.
|
|
|
|
|
(when (< (point) transform-end)
|
|
|
|
|
(setq return-content
|
|
|
|
|
(concat return-content
|
|
|
|
|
(buffer-substring (point) transform-end))))
|
|
|
|
|
;; Quote lines starting with *.
|
|
|
|
|
(org-kill-new (replace-regexp-in-string "^\\*" ",*" return-content))
|
|
|
|
|
(message "Transforming links...done, use C-y to insert text into Org mode file"))))
|
2014-10-07 10:07:15 -04:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; Additional keys for eww-mode
|
|
|
|
|
|
|
|
|
|
(defun org-eww-extend-eww-keymap ()
|
|
|
|
|
(define-key eww-mode-map "\C-c\C-x\M-w" 'org-eww-copy-for-org-mode)
|
|
|
|
|
(define-key eww-mode-map "\C-c\C-x\C-w" 'org-eww-copy-for-org-mode))
|
|
|
|
|
|
|
|
|
|
(when (and (boundp 'eww-mode-map)
|
|
|
|
|
(keymapp eww-mode-map)) ; eww is already up.
|
|
|
|
|
(org-eww-extend-eww-keymap))
|
|
|
|
|
|
2016-08-08 05:28:12 -04:00
|
|
|
|
(add-hook 'eww-mode-hook #'org-eww-extend-eww-keymap)
|
2014-10-07 10:07:15 -04:00
|
|
|
|
|
2014-09-23 03:46:34 -04:00
|
|
|
|
|
2019-03-01 19:01:32 -05:00
|
|
|
|
(provide 'ol-eww)
|
2014-09-23 03:46:34 -04:00
|
|
|
|
|
2019-03-01 19:01:32 -05:00
|
|
|
|
;;; ol-eww.el ends here
|