diff options
Diffstat (limited to 'elpa/org-9.5.2/ol-eww.el')
| -rw-r--r-- | elpa/org-9.5.2/ol-eww.el | 181 |
1 files changed, 181 insertions, 0 deletions
diff --git a/elpa/org-9.5.2/ol-eww.el b/elpa/org-9.5.2/ol-eww.el new file mode 100644 index 0000000..e9ffee6 --- /dev/null +++ b/elpa/org-9.5.2/ol-eww.el @@ -0,0 +1,181 @@ +;;; ol-eww.el --- Store URL and kill from Eww mode -*- lexical-binding: t -*- + +;; Copyright (C) 2014-2021 Free Software Foundation, Inc. + +;; Author: Marco Wahl <marcowahlsoft>a<gmailcom> +;; Keywords: link, eww +;; Homepage: https://orgmode.org + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; 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. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; 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 +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + + +;;; Commentary: + +;; When this module is active `org-store-link' (often on key C-c l) in +;; an EWW buffer stores a link to the current url of the eww buffer. + +;; In an EWW buffer function `org-eww-copy-for-org-mode' kills either +;; a region or the whole buffer if no region is set and transforms the +;; text on the fly so that it can be pasted into an Org buffer with +;; hot links. + +;; 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. + + +;;; Code: +(require 'ol) +(require 'cl-lib) +(require 'eww) + +;; For Emacsen < 25. +(defvar eww-current-title) +(defvar eww-current-url) + + +;; Store Org link in Eww mode buffer +(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)) + +(defun org-eww-store-link () + "Store a link to the url of an EWW buffer." + (when (eq major-mode 'eww-mode) + (org-link-store-props + :type "eww" + :link (if (< emacs-major-version 25) + eww-current-url + (eww-current-url)) + :url (url-view-url t) + :description (if (< emacs-major-version 25) + (or eww-current-title eww-current-url) + (or (plist-get eww-data :title) + (eww-current-url)))))) + + +;; Some auxiliary functions concerning links in Eww buffers +(defun org-eww-goto-next-url-property-change () + "Move to the start of next link if exists. +Otherwise point is not moved. Return point." + (goto-char + (or (next-single-property-change (point) 'shr-url) + (point)))) + +(defun org-eww-has-further-url-property-change-p () + "Non-nil if there is a next url property change." + (save-excursion + (not (eq (point) (org-eww-goto-next-url-property-change))))) + +(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 +`org-link-make-string' and insert the transformed text into the +kill ring, so that it can be yanked into an Org mode buffer with +links working correctly. + +Further lines starting with a star get quoted with a comma to +keep the structure of the Org file." + (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. + (when (fboundp 'deactivate-mark) (deactivate-mark))) + (message "Transforming links...") + (save-excursion + (goto-char transform-start) + (while (and (not out-bound) ; still inside region to copy + (org-eww-has-further-url-property-change-p)) ; there is a next link + ;; Store current point before jump next anchor. + (setq temp-position (point)) + ;; Move to next anchor when current point is not at anchor. + (or (org-eww-url-below-point) + (org-eww-goto-next-url-property-change)) + (cl-assert + (org-eww-url-below-point) t + "program logic error: point must have an url below but it hasn't") + (if (<= (point) transform-end) ; if point is inside transform bound + (progn + ;; 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. + (setq link-location (org-eww-url-below-point)) + ;; Get link title at current point. + (setq link-title + (buffer-substring + (point) + (org-eww-goto-next-url-property-change))) + ;; concat `org-mode' style url to `return-content'. + (setq return-content + (concat return-content + (if (org-string-nw-p link-location) + ;; Hint: link-location is different + ;; for form-elements. + (org-link-make-string link-location link-title) + link-title)))) + (goto-char temp-position) ; reset point before jump next anchor + (setq out-bound t))) ; for break out `while' loop + ;; 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")))) + + +;; 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)) + +(add-hook 'eww-mode-hook #'org-eww-extend-eww-keymap) + + +(provide 'ol-eww) + +;;; ol-eww.el ends here |