Mercurial > emacs
annotate lisp/org/org-w3m.el @ 110682:ba6a1c230532
gnus-html.el (gnus-html-prefetch-images): Adjust regexp to avoid regexp backtrace overflows.
author | Katsumi Yamaoka <yamaoka@jpl.org> |
---|---|
date | Fri, 01 Oct 2010 13:33:03 +0000 |
parents | a150e8a14679 |
children | 5cb272c831e8 |
rev | line source |
---|---|
100268 | 1 ;;; org-w3m.el --- Support from copy and paste from w3m to Org-mode |
2 | |
106815 | 3 ;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc. |
100268 | 4 |
5 ;; Author: Andy Stewart <lazycat dot manatee at gmail dot com> | |
6 ;; Keywords: outlines, hypermedia, calendar, wp | |
7 ;; Homepage: http://orgmode.org | |
109462
a150e8a14679
Install version 7.01 of Org-mode
Carsten Dominik <carsten.dominik@gmail.com>
parents:
107863
diff
changeset
|
8 ;; Version: 7.01 |
100268 | 9 ;; |
10 ;; This file is part of GNU Emacs. | |
11 ;; | |
12 ;; GNU Emacs is free software: you can redistribute it and/or modify | |
13 ;; it under the terms of the GNU General Public License as published by | |
14 ;; the Free Software Foundation, either version 3 of the License, or | |
15 ;; (at your option) any later version. | |
16 | |
17 ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 ;; GNU General Public License for more details. | |
21 | |
22 ;; You should have received a copy of the GNU General Public License | |
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
24 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
25 ;; | |
26 ;;; Commentary: | |
27 | |
28 ;; This file implements copying HTML content from a w3m buffer and | |
105973
b7d8222914b4
2009-11-13 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
105341
diff
changeset
|
29 ;; transforming the text on the fly so that it can be pasted into |
100268 | 30 ;; an org-mode buffer with hot links. It will also work for regions |
109462
a150e8a14679
Install version 7.01 of Org-mode
Carsten Dominik <carsten.dominik@gmail.com>
parents:
107863
diff
changeset
|
31 ;; in gnus buffers that have been washed with w3m. |
100268 | 32 |
33 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
34 ;; | |
109462
a150e8a14679
Install version 7.01 of Org-mode
Carsten Dominik <carsten.dominik@gmail.com>
parents:
107863
diff
changeset
|
35 ;;; Acknowledgments: |
100268 | 36 |
37 ;; Richard Riley <rileyrgdev at googlemail dot com> | |
38 ;; | |
100458
ba23e35d3eaf
2008-12-17 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100448
diff
changeset
|
39 ;; The idea of transforming the HTML content with org-mode style is |
ba23e35d3eaf
2008-12-17 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100448
diff
changeset
|
40 ;; proposed by Richard, I'm just coding it. |
100268 | 41 ;; |
42 | |
109462
a150e8a14679
Install version 7.01 of Org-mode
Carsten Dominik <carsten.dominik@gmail.com>
parents:
107863
diff
changeset
|
43 ;;; Code: |
a150e8a14679
Install version 7.01 of Org-mode
Carsten Dominik <carsten.dominik@gmail.com>
parents:
107863
diff
changeset
|
44 |
100268 | 45 (require 'org) |
46 | |
47 (defun org-w3m-copy-for-org-mode () | |
48 "Copy current buffer content or active region with `org-mode' style links. | |
49 This will encode `link-title' and `link-location' with | |
50 `org-make-link-string', and insert the transformed test into the kill ring, | |
51 so that it can be yanked into an Org-mode buffer with links working correctly." | |
52 (interactive) | |
101458
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
53 (let* ((regionp (org-region-active-p)) |
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
54 (transform-start (point-min)) |
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
55 (transform-end (point-max)) |
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
56 return-content |
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
57 link-location link-title |
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
58 temp-position out-bound) |
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
59 (when regionp |
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
60 (setq transform-start (region-beginning)) |
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
61 (setq transform-end (region-end)) |
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
62 ;; Deactivate mark if current mark is activate. |
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
63 (if (fboundp 'deactivate-mark) (deactivate-mark))) |
100268 | 64 (message "Transforming links...") |
65 (save-excursion | |
66 (goto-char transform-start) | |
101458
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
67 (while (and (not out-bound) ; still inside region to copy |
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
68 (not (org-w3m-no-next-link-p))) ; no next link current buffer |
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
69 ;; store current point before jump next anchor |
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
70 (setq temp-position (point)) |
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
71 ;; move to next anchor when current point is not at anchor |
109462
a150e8a14679
Install version 7.01 of Org-mode
Carsten Dominik <carsten.dominik@gmail.com>
parents:
107863
diff
changeset
|
72 (or (get-text-property (point) 'w3m-href-anchor) (org-w3m-get-next-link-start)) |
101458
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
73 (if (<= (point) transform-end) ; if point is inside transform bound |
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
74 (progn |
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
75 ;; get content between two links. |
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
76 (if (> (point) temp-position) |
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
77 (setq return-content (concat return-content |
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
78 (buffer-substring |
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
79 temp-position (point))))) |
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
80 ;; get link location at current point. |
109462
a150e8a14679
Install version 7.01 of Org-mode
Carsten Dominik <carsten.dominik@gmail.com>
parents:
107863
diff
changeset
|
81 (setq link-location (get-text-property (point) 'w3m-href-anchor)) |
101458
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
82 ;; get link title at current point. |
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
83 (setq link-title (buffer-substring (point) |
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
84 (org-w3m-get-anchor-end))) |
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
85 ;; concat `org-mode' style url to `return-content'. |
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
86 (setq return-content (concat return-content |
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
87 (org-make-link-string |
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
88 link-location link-title)))) |
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
89 (goto-char temp-position) ; reset point before jump next anchor |
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
90 (setq out-bound t) ; for break out `while' loop |
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
91 )) |
100458
ba23e35d3eaf
2008-12-17 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100448
diff
changeset
|
92 ;; add the rest until end of the region to be copied |
100268 | 93 (if (< (point) transform-end) |
101458
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
94 (setq return-content |
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
95 (concat return-content |
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
96 (buffer-substring (point) transform-end)))) |
104164
ac1a55cc2c38
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
101757
diff
changeset
|
97 (org-kill-new return-content) |
100268 | 98 (message "Transforming links...done, use C-y to insert text into Org-mode file") |
99 (message "Copy with link transformation complete.")))) | |
100 | |
101 (defun org-w3m-get-anchor-start () | |
101458
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
102 "Move cursor to the start of current anchor. Return point." |
100268 | 103 ;; get start position of anchor or current point |
104 (goto-char (or (previous-single-property-change (point) 'w3m-anchor-sequence) | |
101458
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
105 (point)))) |
100268 | 106 |
107 (defun org-w3m-get-anchor-end () | |
101458
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
108 "Move cursor to the end of current anchor. Return point." |
100268 | 109 ;; get end position of anchor or point |
110 (goto-char (or (next-single-property-change (point) 'w3m-anchor-sequence) | |
111 (point)))) | |
112 | |
113 (defun org-w3m-get-next-link-start () | |
101458
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
114 "Move cursor to the start of next link. Return point." |
100268 | 115 (catch 'reach |
116 (while (next-single-property-change (point) 'w3m-anchor-sequence) | |
117 ;; jump to next anchor | |
118 (goto-char (next-single-property-change (point) 'w3m-anchor-sequence)) | |
109462
a150e8a14679
Install version 7.01 of Org-mode
Carsten Dominik <carsten.dominik@gmail.com>
parents:
107863
diff
changeset
|
119 (when (get-text-property (point) 'w3m-href-anchor) |
101458
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
120 ;; return point when current is valid link |
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
121 (throw 'reach nil)))) |
100268 | 122 (point)) |
123 | |
124 (defun org-w3m-get-prev-link-start () | |
105973
b7d8222914b4
2009-11-13 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
105341
diff
changeset
|
125 "Move cursor to the start of previous link. Return point." |
100268 | 126 (catch 'reach |
127 (while (previous-single-property-change (point) 'w3m-anchor-sequence) | |
128 ;; jump to previous anchor | |
129 (goto-char (previous-single-property-change (point) 'w3m-anchor-sequence)) | |
109462
a150e8a14679
Install version 7.01 of Org-mode
Carsten Dominik <carsten.dominik@gmail.com>
parents:
107863
diff
changeset
|
130 (when (get-text-property (point) 'w3m-href-anchor) |
101458
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
131 ;; return point when current is valid link |
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
132 (throw 'reach nil)))) |
100268 | 133 (point)) |
134 | |
135 (defun org-w3m-no-next-link-p () | |
101458
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
136 "Whether there is no next link after the cursor. |
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
137 Return t if there is no next link; otherwise, return nil." |
100268 | 138 (save-excursion |
139 (equal (point) (org-w3m-get-next-link-start)))) | |
140 | |
141 (defun org-w3m-no-prev-link-p () | |
101458
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
142 "Whether there is no previous link after the cursor. |
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
143 Return t if there is no previous link; otherwise, return nil." |
100268 | 144 (save-excursion |
145 (equal (point) (org-w3m-get-prev-link-start)))) | |
146 | |
147 ;; Install keys into the w3m keymap | |
148 (defvar w3m-mode-map) | |
149 (defvar w3m-minor-mode-map) | |
150 (when (and (boundp 'w3m-mode-map) | |
101458
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
151 (keymapp w3m-mode-map)) |
100268 | 152 (define-key w3m-mode-map "\C-c\C-x\M-w" 'org-w3m-copy-for-org-mode) |
153 (define-key w3m-mode-map "\C-c\C-x\C-w" 'org-w3m-copy-for-org-mode)) | |
154 (when (and (boundp 'w3m-minor-mode-map) | |
101458
36abe982e7cd
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
Carsten Dominik <dominik@science.uva.nl>
parents:
100908
diff
changeset
|
155 (keymapp w3m-minor-mode-map)) |
100268 | 156 (define-key w3m-minor-mode-map "\C-c\C-x\M-w" 'org-w3m-copy-for-org-mode) |
157 (define-key w3m-minor-mode-map "\C-c\C-x\C-w" 'org-w3m-copy-for-org-mode)) | |
158 (add-hook | |
159 'w3m-mode-hook | |
160 (lambda () | |
161 (define-key w3m-mode-map "\C-c\C-x\M-w" 'org-w3m-copy-for-org-mode) | |
162 (define-key w3m-mode-map "\C-c\C-x\C-w" 'org-w3m-copy-for-org-mode))) | |
163 (add-hook | |
164 'w3m-minor-mode-hook | |
165 (lambda () | |
166 (define-key w3m-minor-mode-map "\C-c\C-x\M-w" 'org-w3m-copy-for-org-mode) | |
167 (define-key w3m-minor-mode-map "\C-c\C-x\C-w" 'org-w3m-copy-for-org-mode))) | |
168 | |
169 (provide 'org-w3m) | |
170 | |
171 ;; arch-tag: 851d7447-488d-49f0-a14d-46c092e84352 | |
172 | |
173 ;;; org-w3m.el ends here |