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