mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-14 01:50:22 -08:00
bc511a64f6
Most of this change is to boilerplate commentary such as license URLs. This change was prompted by ftp://ftp.gnu.org's going-away party, planned for November. Change these FTP URLs to https://ftp.gnu.org instead. Make similar changes for URLs to other organizations moving away from FTP. Also, change HTTP to HTTPS for URLs to gnu.org and fsf.org when this works, as this will further help defend against man-in-the-middle attacks (for this part I omitted the MS-DOS and MS-Windows sources and the test tarballs to keep the workload down). HTTPS is not fully working to lists.gnu.org so I left those URLs alone for now.
183 lines
7.4 KiB
EmacsLisp
183 lines
7.4 KiB
EmacsLisp
;;; org-w3m.el --- Support from Copy and Paste From w3m -*- lexical-binding: t; -*-
|
|
|
|
;; Copyright (C) 2008-2017 Free Software Foundation, Inc.
|
|
|
|
;; Author: Andy Stewart <lazycat dot manatee at gmail dot com>
|
|
;; Keywords: outlines, hypermedia, calendar, wp
|
|
;; Homepage: http://orgmode.org
|
|
;;
|
|
;; This file is part of GNU Emacs.
|
|
;;
|
|
;; This program 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.
|
|
|
|
;; This program 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:
|
|
|
|
;; This file implements copying HTML content from a w3m buffer and
|
|
;; transforming the text on the fly so that it can be pasted into an
|
|
;; Org buffer with hot links. It will also work for regions in gnus
|
|
;; buffers that have been washed with w3m.
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;
|
|
;;; Acknowledgments:
|
|
|
|
;; Richard Riley <rileyrgdev at googlemail dot com>
|
|
;;
|
|
;; The idea of transforming the HTML content with Org syntax is
|
|
;; proposed by Richard, I'm just coding it.
|
|
;;
|
|
|
|
;;; Code:
|
|
|
|
(require 'org)
|
|
|
|
(defvar w3m-current-url)
|
|
(defvar w3m-current-title)
|
|
|
|
(org-link-set-parameters "w3m" :store #'org-w3m-store-link)
|
|
(defun org-w3m-store-link ()
|
|
"Store a link to a w3m buffer."
|
|
(when (eq major-mode 'w3m-mode)
|
|
(org-store-link-props
|
|
:type "w3m"
|
|
:link w3m-current-url
|
|
:url (url-view-url t)
|
|
:description (or w3m-current-title w3m-current-url))))
|
|
|
|
(defun org-w3m-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-make-link-string', and insert the transformed test into the kill ring,
|
|
so that it can be yanked into an Org buffer with links working correctly."
|
|
(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.
|
|
(if (fboundp 'deactivate-mark) (deactivate-mark)))
|
|
(message "Transforming links...")
|
|
(save-excursion
|
|
(goto-char transform-start)
|
|
(while (and (not out-bound) ; still inside region to copy
|
|
(not (org-w3m-no-next-link-p))) ; no next link current buffer
|
|
;; store current point before jump next anchor
|
|
(setq temp-position (point))
|
|
;; move to next anchor when current point is not at anchor
|
|
(or (get-text-property (point) 'w3m-href-anchor) (org-w3m-get-next-link-start))
|
|
(if (<= (point) transform-end) ; if point is inside transform bound
|
|
(progn
|
|
;; get content between two links.
|
|
(if (> (point) temp-position)
|
|
(setq return-content (concat return-content
|
|
(buffer-substring
|
|
temp-position (point)))))
|
|
;; get link location at current point.
|
|
(setq link-location (get-text-property (point) 'w3m-href-anchor))
|
|
;; get link title at current point.
|
|
(setq link-title (buffer-substring (point)
|
|
(org-w3m-get-anchor-end)))
|
|
;; concat `org-mode' style url to `return-content'.
|
|
(setq return-content (concat return-content
|
|
(org-make-link-string
|
|
link-location 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
|
|
(if (< (point) transform-end)
|
|
(setq return-content
|
|
(concat return-content
|
|
(buffer-substring (point) transform-end))))
|
|
(org-kill-new return-content)
|
|
(message "Transforming links...done, use C-y to insert text into Org file")
|
|
(message "Copy with link transformation complete."))))
|
|
|
|
(defun org-w3m-get-anchor-start ()
|
|
"Move cursor to the start of current anchor. Return point."
|
|
;; get start position of anchor or current point
|
|
(goto-char (or (previous-single-property-change (point) 'w3m-anchor-sequence)
|
|
(point))))
|
|
|
|
(defun org-w3m-get-anchor-end ()
|
|
"Move cursor to the end of current anchor. Return point."
|
|
;; get end position of anchor or point
|
|
(goto-char (or (next-single-property-change (point) 'w3m-anchor-sequence)
|
|
(point))))
|
|
|
|
(defun org-w3m-get-next-link-start ()
|
|
"Move cursor to the start of next link. Return point."
|
|
(catch 'reach
|
|
(while (next-single-property-change (point) 'w3m-anchor-sequence)
|
|
;; jump to next anchor
|
|
(goto-char (next-single-property-change (point) 'w3m-anchor-sequence))
|
|
(when (get-text-property (point) 'w3m-href-anchor)
|
|
;; return point when current is valid link
|
|
(throw 'reach nil))))
|
|
(point))
|
|
|
|
(defun org-w3m-get-prev-link-start ()
|
|
"Move cursor to the start of previous link. Return point."
|
|
(catch 'reach
|
|
(while (previous-single-property-change (point) 'w3m-anchor-sequence)
|
|
;; jump to previous anchor
|
|
(goto-char (previous-single-property-change (point) 'w3m-anchor-sequence))
|
|
(when (get-text-property (point) 'w3m-href-anchor)
|
|
;; return point when current is valid link
|
|
(throw 'reach nil))))
|
|
(point))
|
|
|
|
(defun org-w3m-no-next-link-p ()
|
|
"Whether there is no next link after the cursor.
|
|
Return t if there is no next link; otherwise, return nil."
|
|
(save-excursion
|
|
(equal (point) (org-w3m-get-next-link-start))))
|
|
|
|
(defun org-w3m-no-prev-link-p ()
|
|
"Whether there is no previous link after the cursor.
|
|
Return t if there is no previous link; otherwise, return nil."
|
|
(save-excursion
|
|
(equal (point) (org-w3m-get-prev-link-start))))
|
|
|
|
;; Install keys into the w3m keymap
|
|
(defvar w3m-mode-map)
|
|
(defvar w3m-minor-mode-map)
|
|
(when (and (boundp 'w3m-mode-map)
|
|
(keymapp w3m-mode-map))
|
|
(define-key w3m-mode-map "\C-c\C-x\M-w" 'org-w3m-copy-for-org-mode)
|
|
(define-key w3m-mode-map "\C-c\C-x\C-w" 'org-w3m-copy-for-org-mode))
|
|
(when (and (boundp 'w3m-minor-mode-map)
|
|
(keymapp w3m-minor-mode-map))
|
|
(define-key w3m-minor-mode-map "\C-c\C-x\M-w" 'org-w3m-copy-for-org-mode)
|
|
(define-key w3m-minor-mode-map "\C-c\C-x\C-w" 'org-w3m-copy-for-org-mode))
|
|
(add-hook
|
|
'w3m-mode-hook
|
|
(lambda ()
|
|
(define-key w3m-mode-map "\C-c\C-x\M-w" 'org-w3m-copy-for-org-mode)
|
|
(define-key w3m-mode-map "\C-c\C-x\C-w" 'org-w3m-copy-for-org-mode)))
|
|
(add-hook
|
|
'w3m-minor-mode-hook
|
|
(lambda ()
|
|
(define-key w3m-minor-mode-map "\C-c\C-x\M-w" 'org-w3m-copy-for-org-mode)
|
|
(define-key w3m-minor-mode-map "\C-c\C-x\C-w" 'org-w3m-copy-for-org-mode)))
|
|
|
|
(provide 'org-w3m)
|
|
|
|
;;; org-w3m.el ends here
|