* doc/emacs/custom.texi (Custom Themes): Fix typo.
[emacs.git] / lisp / net / quickurl.el
blobce9ef55f49906355742aacaa858befa3e56a33a1
1 ;;; quickurl.el --- insert a URL based on text at point in buffer
3 ;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
5 ;; Author: Dave Pearson <davep@davep.org>
6 ;; Maintainer: Dave Pearson <davep@davep.org>
7 ;; Created: 1999-05-28
8 ;; Keywords: hypermedia
10 ;; This file is part of GNU Emacs.
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.
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.
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/>.
25 ;;; Commentary:
27 ;; This package provides a simple method of inserting a URL based on the
28 ;; text at point in the current buffer. This is part of an on-going effort
29 ;; to increase the information I provide people while reducing the amount
30 ;; of typing I need to do. No-doubt there are undiscovered Emacs packages
31 ;; out there that do all of this and do it better, feel free to point me to
32 ;; them, in the mean time I'm having fun playing with Emacs Lisp.
34 ;; The URLs are stored in an external file as a list of either cons cells,
35 ;; or lists. A cons cell entry looks like this:
37 ;; (<Lookup> . <URL>)
39 ;; where <Lookup> is a string that acts as the keyword lookup and <URL> is
40 ;; the URL associated with it. An example might be:
42 ;; ("GNU" . "http://www.gnu.org/")
44 ;; A list entry looks like:
46 ;; (<Lookup> <URL> <Comment>)
48 ;; where <Lookup> and <URL> are the same as with the cons cell and <Comment>
49 ;; is any text you like that describes the URL. This description will be
50 ;; used when presenting a list of URLS using `quickurl-list'. An example
51 ;; might be:
53 ;; ("FSF" "http://www.fsf.org/" "The Free Software Foundation")
55 ;; Given the above, your quickurl file might look like:
57 ;; (("GNU" . "http://www.gnu.org/")
58 ;; ("FSF" "http://www.fsf.org/" "The Free Software Foundation")
59 ;; ("emacs" . "http://www.emacs.org/")
60 ;; ("davep" "http://www.davep.org/" "Dave's homepage"))
62 ;; In case you're wondering about the mixture of cons cells and lists,
63 ;; quickurl started life using just the cons cells, there were no comments.
64 ;; URL comments are a later addition and so there is a mixture to keep
65 ;; backward compatibility with existing URL lists.
67 ;; The name and location of the file is up to you, the default name used by
68 ;; `quickurl' is stored in `quickurl-url-file'.
70 ;; quickurl is always available from:
72 ;; <URL:http://www.davep.org/emacs/quickurl.el>
74 ;;; TODO:
76 ;; o The quickurl-browse-url* functions pretty much duplicate their non
77 ;; browsing friends. It would feel better if a more generic solution could
78 ;; be found.
80 ;;; Code:
82 ;; Things we need:
84 (eval-when-compile (require 'cl-lib))
85 (require 'thingatpt)
86 (require 'pp)
87 (require 'browse-url)
89 ;; Customize options.
91 (defgroup quickurl nil
92 "Insert a URL based on text at point in buffer."
93 :version "21.1"
94 :group 'abbrev
95 :prefix "quickurl-")
97 (defcustom quickurl-url-file (convert-standard-filename "~/.quickurls")
98 "File that contains the URL list."
99 :type 'file
100 :group 'quickurl)
102 (defcustom quickurl-format-function (lambda (url) (format "<URL:%s>" (quickurl-url-url url)))
103 "Function to format the URL before insertion into the current buffer."
104 :type 'function
105 :group 'quickurl)
107 (defcustom quickurl-sort-function (lambda (list)
108 (sort list
109 (lambda (x y)
110 (string<
111 (downcase (quickurl-url-description x))
112 (downcase (quickurl-url-description y))))))
113 "Function to sort the URL list."
114 :type 'function
115 :group 'quickurl)
117 (defcustom quickurl-grab-lookup-function #'current-word
118 "Function to grab the thing to lookup."
119 :type 'function
120 :group 'quickurl)
122 (defcustom quickurl-assoc-function #'assoc-ignore-case
123 "Function to use for alist lookup into `quickurl-urls'."
124 :type 'function
125 :group 'quickurl)
127 (defcustom quickurl-completion-ignore-case t
128 "Should `quickurl-ask' ignore case when doing the input lookup?"
129 :type 'boolean
130 :group 'quickurl)
132 (defcustom quickurl-prefix ";; -*- lisp -*-\n\n"
133 "Text to write to `quickurl-url-file' before writing the URL list."
134 :type 'string
135 :group 'quickurl)
137 (defcustom quickurl-postfix ""
138 "Text to write to `quickurl-url-file' after writing the URL list.
140 See the constant `quickurl-reread-hook-postfix' for some example text that
141 could be used here."
142 :type 'string
143 :group 'quickurl)
145 (defcustom quickurl-list-mode-hook nil
146 "Hooks for `quickurl-list-mode'."
147 :type 'hook
148 :group 'quickurl)
150 ;; Constants.
152 ;;;###autoload
153 (defconst quickurl-reread-hook-postfix
155 ;; Local Variables:
156 ;; eval: (progn (require 'quickurl) (add-hook 'local-write-file-hooks (lambda () (quickurl-read) nil)))
157 ;; End:
159 "Example `quickurl-postfix' text that adds a local variable to the
160 `quickurl-url-file' so that if you edit it by hand it will ensure that
161 `quickurl-urls' is updated with the new URL list.
163 To make use of this do something like:
165 (setq quickurl-postfix quickurl-reread-hook-postfix)
167 in your init file (after loading/requiring quickurl).")
169 ;; Non-customize variables.
171 (defvar quickurl-urls nil
172 "URL alist for use with `quickurl' and `quickurl-ask'.")
174 (defvar quickurl-list-mode-map
175 (let ((map (make-sparse-keymap)))
176 (suppress-keymap map t)
177 (define-key map "a" #'quickurl-list-add-url)
178 (define-key map [(control m)] #'quickurl-list-insert-url)
179 (define-key map "u" #'quickurl-list-insert-naked-url)
180 (define-key map " " #'quickurl-list-insert-with-lookup)
181 (define-key map "l" #'quickurl-list-insert-lookup)
182 (define-key map "d" #'quickurl-list-insert-with-desc)
183 (define-key map [(control g)] #'quickurl-list-quit)
184 (define-key map "q" #'quickurl-list-quit)
185 (define-key map [mouse-2] #'quickurl-list-mouse-select)
186 (define-key map "?" #'describe-mode)
187 map)
188 "Local keymap for a `quickurl-list-mode' buffer.")
190 (defvar quickurl-list-buffer-name "*quickurl-list*"
191 "Name for the URL listing buffer.")
193 (defvar quickurl-list-last-buffer nil
194 "`current-buffer' when `quickurl-list' was called.")
196 ;; Functions for working with a URL entry.
198 (defun quickurl-url-commented-p (url)
199 "Does the URL have a comment?"
200 (listp (cdr url)))
202 (defun quickurl-make-url (keyword url &optional comment)
203 "Create a URL from KEYWORD, URL and (optionally) COMMENT."
204 (if (and comment (not (zerop (length comment))))
205 (list keyword url comment)
206 (cons keyword url)))
208 (defalias 'quickurl-url-keyword #'car
209 "Return the keyword for the URL.
210 \n\(fn URL)")
212 (defun quickurl-url-url (url)
213 "Return the actual URL of the URL.
215 Note that this function is a setfable place."
216 (declare (gv-setter (lambda (store)
217 `(setf (if (quickurl-url-commented-p ,url)
218 (cadr ,url)
219 (cdr ,url))
220 ,store))))
221 (if (quickurl-url-commented-p url)
222 (cadr url)
223 (cdr url)))
225 (defun quickurl-url-comment (url)
226 "Get the comment from a URL.
228 If the URL has no comment an empty string is returned. Also note that this
229 function is a setfable place."
230 (declare
231 (gv-setter (lambda (store)
232 `(if (quickurl-url-commented-p ,url)
233 (if (zerop (length ,store))
234 (setf (cdr ,url) (cadr ,url))
235 (setf (nth 2 ,url) ,store))
236 (unless (zerop (length ,store))
237 (setf (cdr ,url) (list (cdr ,url) ,store)))))))
238 (if (quickurl-url-commented-p url)
239 (nth 2 url)
240 ""))
242 (defun quickurl-url-description (url)
243 "Return a description for the URL.
245 If the URL has a comment then this is returned, otherwise the keyword is
246 returned."
247 (let ((desc (quickurl-url-comment url)))
248 (if (zerop (length desc))
249 (quickurl-url-keyword url)
250 desc)))
252 ;; Main code:
254 (cl-defun quickurl-read (&optional buffer)
255 "`read' the URL list from BUFFER into `quickurl-urls'.
257 BUFFER, if nil, defaults to current buffer.
258 Note that this function moves point to `point-min' before doing the `read'
259 It also restores point after the `read'."
260 (save-excursion
261 (goto-char (point-min))
262 (setq quickurl-urls (funcall quickurl-sort-function
263 (read (or buffer (current-buffer)))))))
265 (defun quickurl-load-urls ()
266 "Load the contents of `quickurl-url-file' into `quickurl-urls'."
267 (when (file-exists-p quickurl-url-file)
268 (with-temp-buffer
269 (insert-file-contents quickurl-url-file)
270 (quickurl-read))))
272 (defun quickurl-save-urls ()
273 "Save the contents of `quickurl-urls' to `quickurl-url-file'."
274 (with-temp-buffer
275 (let ((standard-output (current-buffer)))
276 (princ quickurl-prefix)
277 (pp quickurl-urls)
278 (princ quickurl-postfix)
279 (write-region (point-min) (point-max) quickurl-url-file nil 0))))
281 (defun quickurl-find-url (lookup)
282 "Return URL associated with key LOOKUP.
284 The lookup is done by looking in the alist `quickurl-urls' and the `cons'
285 for the URL is returned. The actual method used to look into the alist
286 depends on the setting of the variable `quickurl-assoc-function'."
287 (funcall quickurl-assoc-function lookup quickurl-urls))
289 (defun quickurl-insert (url &optional silent)
290 "Insert URL, formatted using `quickurl-format-function'.
292 Also display a `message' saying what the URL was unless SILENT is non-nil."
293 (insert (funcall quickurl-format-function url))
294 (unless silent
295 (message "Found %s" (quickurl-url-url url))))
297 ;;;###autoload
298 (cl-defun quickurl (&optional lookup)
299 "Insert a URL based on LOOKUP.
301 If not supplied LOOKUP is taken to be the word at point in the current
302 buffer, this default action can be modified via
303 `quickurl-grab-lookup-function'."
304 (interactive)
305 (when (or lookup
306 (setq lookup (funcall quickurl-grab-lookup-function)))
307 (quickurl-load-urls)
308 (let ((url (quickurl-find-url lookup)))
309 (if (null url)
310 (error "No URL associated with \"%s\"" lookup)
311 (when (looking-at "\\w")
312 (skip-syntax-forward "\\w"))
313 (insert " ")
314 (quickurl-insert url)))))
316 ;;;###autoload
317 (defun quickurl-ask (lookup)
318 "Insert a URL, with `completing-read' prompt, based on LOOKUP."
319 (interactive
320 (list
321 (progn
322 (quickurl-load-urls)
323 (let ((completion-ignore-case quickurl-completion-ignore-case))
324 (completing-read "Lookup: " quickurl-urls nil t)))))
325 (let ((url (quickurl-find-url lookup)))
326 (when url
327 (quickurl-insert url))))
329 (defun quickurl-grab-url ()
330 "Attempt to grab a word/URL pair from point in the current buffer.
332 Point should be somewhere on the URL and the word is taken to be the thing
333 that is returned from calling `quickurl-grab-lookup-function' once a
334 `backward-word' has been issued at the start of the URL.
336 It is assumed that the URL is either \"unguarded\" or is wrapped inside an
337 <URL:...> wrapper."
338 (let ((url (thing-at-point 'url)))
339 (when url
340 (save-excursion
341 (beginning-of-thing 'url)
342 ;; `beginning-of-thing' doesn't take you to the start of a marked-up
343 ;; URL, only to the start of the URL within the "markup". So, we
344 ;; need to do a little more work to get to where we want to be.
345 (when (thing-at-point-looking-at thing-at-point-markedup-url-regexp)
346 (search-backward "<URL:"))
347 (backward-word 1)
348 (let ((word (funcall quickurl-grab-lookup-function)))
349 (when word
350 (quickurl-make-url
351 ;; The grab function may return the word with properties. I don't
352 ;; want the properties. I couldn't find a method of stripping
353 ;; them from a "string" so this will have to do. If you know of
354 ;; a better method of doing this I'd love to know.
355 (with-temp-buffer
356 (insert word)
357 (buffer-substring-no-properties (point-min) (point-max)))
358 url)))))))
360 ;;;###autoload
361 (defun quickurl-add-url (word url comment)
362 "Allow the user to interactively add a new URL associated with WORD.
364 See `quickurl-grab-url' for details on how the default word/URL combination
365 is decided."
366 (interactive (let ((word-url (quickurl-grab-url)))
367 (list (read-string "Word: " (quickurl-url-keyword word-url))
368 (read-string "URL: " (quickurl-url-url word-url))
369 (read-string "Comment: " (quickurl-url-comment word-url)))))
370 (if (zerop (length word))
371 (error "You must specify a WORD for lookup")
372 (quickurl-load-urls)
373 (let* ((current-url (quickurl-find-url word))
374 (add-it (if current-url
375 (if (called-interactively-p 'interactive)
376 (y-or-n-p (format "\"%s\" exists, replace URL? " word))
378 t)))
379 (when add-it
380 (if current-url
381 (progn
382 (setf (quickurl-url-url current-url) url)
383 (setf (quickurl-url-comment current-url) comment))
384 (push (quickurl-make-url word url comment) quickurl-urls))
385 (setq quickurl-urls (funcall quickurl-sort-function quickurl-urls))
386 (quickurl-save-urls)
387 (when (get-buffer quickurl-list-buffer-name)
388 (quickurl-list-populate-buffer))
389 (when (called-interactively-p 'interactive)
390 (message "Added %s" url))))))
392 ;;;###autoload
393 (defun quickurl-browse-url (&optional lookup)
394 "Browse the URL associated with LOOKUP.
396 If not supplied LOOKUP is taken to be the word at point in the
397 current buffer, this default action can be modified via
398 `quickurl-grab-lookup-function'."
399 (interactive)
400 (when (or lookup
401 (setq lookup (funcall quickurl-grab-lookup-function)))
402 (quickurl-load-urls)
403 (let ((url (quickurl-find-url lookup)))
404 (if url
405 (browse-url (quickurl-url-url url))
406 (error "No URL associated with \"%s\"" lookup)))))
408 ;;;###autoload
409 (defun quickurl-browse-url-ask (lookup)
410 "Browse the URL, with `completing-read' prompt, associated with LOOKUP."
411 (interactive (list
412 (progn
413 (quickurl-load-urls)
414 (completing-read "Browse: " quickurl-urls nil t))))
415 (let ((url (quickurl-find-url lookup)))
416 (when url
417 (browse-url (quickurl-url-url url)))))
419 ;;;###autoload
420 (defun quickurl-edit-urls ()
421 "Pull `quickurl-url-file' into a buffer for hand editing."
422 (interactive)
423 (find-file quickurl-url-file))
425 ;; quickurl-list mode.
427 (put 'quickurl-list-mode 'mode-class 'special)
429 ;;;###autoload
430 (defun quickurl-list-mode ()
431 "A mode for browsing the quickurl URL list.
433 The key bindings for `quickurl-list-mode' are:
435 \\{quickurl-list-mode-map}"
436 (interactive)
437 (kill-all-local-variables)
438 (use-local-map quickurl-list-mode-map)
439 (setq major-mode 'quickurl-list-mode
440 mode-name "quickurl list")
441 (run-mode-hooks 'quickurl-list-mode-hook)
442 (setq buffer-read-only t
443 truncate-lines t))
445 ;;;###autoload
446 (defun quickurl-list ()
447 "Display `quickurl-list' as a formatted list using `quickurl-list-mode'."
448 (interactive)
449 (quickurl-load-urls)
450 (unless (string= (buffer-name) quickurl-list-buffer-name)
451 (setq quickurl-list-last-buffer (current-buffer)))
452 (pop-to-buffer quickurl-list-buffer-name)
453 (quickurl-list-populate-buffer)
454 (quickurl-list-mode))
456 (defun quickurl-list-populate-buffer ()
457 "Populate the `quickurl-list' buffer."
458 (with-current-buffer (get-buffer quickurl-list-buffer-name)
459 (let* ((sizes (or (cl-loop for url in quickurl-urls
460 collect (length (quickurl-url-description url)))
461 (list 20)))
462 (fmt (format "%%-%ds %%s\n" (apply #'max sizes)))
463 (inhibit-read-only t))
464 (erase-buffer)
465 (cl-loop for url in quickurl-urls
466 do (let ((start (point)))
467 (insert (format fmt (quickurl-url-description url)
468 (quickurl-url-url url)))
469 (add-text-properties
470 start (1- (point))
471 '(mouse-face highlight
472 help-echo "mouse-2: insert this URL"))))
473 (goto-char (point-min)))))
475 (defun quickurl-list-add-url (word url comment)
476 "Wrapper for `quickurl-add-url' that doesn't guess the parameters."
477 (interactive "sWord: \nsURL: \nsComment: ")
478 (quickurl-add-url word url comment))
480 (defun quickurl-list-quit ()
481 "Kill the buffer named `quickurl-list-buffer-name'."
482 (interactive)
483 (kill-buffer quickurl-list-buffer-name)
484 (switch-to-buffer quickurl-list-last-buffer)
485 (delete-other-windows))
487 (defun quickurl-list-mouse-select (event)
488 "Select the URL under the mouse click."
489 (interactive "e")
490 (goto-char (posn-point (event-end event)))
491 (quickurl-list-insert-url))
493 (defun quickurl-list-insert (type)
494 "Insert the URL under cursor into `quickurl-list-last-buffer'.
495 TYPE dictates what will be inserted, options are:
496 `url' - Insert the URL as <URL:url>
497 `naked-url' - Insert the URL with no formatting
498 `with-lookup' - Insert \"lookup <URL:url>\"
499 `with-desc' - Insert \"description <URL:url>\"
500 `lookup' - Insert the lookup for that URL"
501 (let ((url (nth (count-lines (point-min) (line-beginning-position))
502 quickurl-urls)))
503 (if url
504 (with-current-buffer quickurl-list-last-buffer
505 (insert
506 (pcase type
507 (`url (funcall quickurl-format-function url))
508 (`naked-url (quickurl-url-url url))
509 (`with-lookup (format "%s <URL:%s>"
510 (quickurl-url-keyword url)
511 (quickurl-url-url url)))
512 (`with-desc (format "%S <URL:%s>"
513 (quickurl-url-description url)
514 (quickurl-url-url url)))
515 (`lookup (quickurl-url-keyword url)))))
516 (error "No URL details on that line"))
517 url))
519 (defmacro quickurl-list-make-inserter (type)
520 "Macro to make a key-response function for use in `quickurl-list-mode-map'."
521 `(defun ,(intern (format "quickurl-list-insert-%S" type)) ()
522 ,(format "Insert the result of calling `quickurl-list-insert' with `%s'." type)
523 (interactive)
524 (when (quickurl-list-insert ',type)
525 (quickurl-list-quit))))
527 (quickurl-list-make-inserter url)
528 (quickurl-list-make-inserter naked-url)
529 (quickurl-list-make-inserter with-lookup)
530 (quickurl-list-make-inserter with-desc)
531 (quickurl-list-make-inserter lookup)
533 (provide 'quickurl)
535 ;;; quickurl.el ends here