contrib/lisp/org-eww.el

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