-;;; quickurl.el --- insert an URL based on text at point in buffer
+;;; quickurl.el --- insert a URL based on text at point in buffer
-;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2016 Free Software Foundation, Inc.
;; Author: Dave Pearson <davep@davep.org>
;; Maintainer: Dave Pearson <davep@davep.org>
;;; Commentary:
;;
-;; This package provides a simple method of inserting an URL based on the
+;; This package provides a simple method of inserting a URL based on the
;; text at point in the current buffer. This is part of an on-going effort
-;; to increase the information I provide people while reducing the ammount
+;; to increase the information I provide people while reducing the amount
;; of typing I need to do. No-doubt there are undiscovered Emacs packages
;; out there that do all of this and do it better, feel free to point me to
;; them, in the mean time I'm having fun playing with Emacs Lisp.
;; Things we need:
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'thingatpt)
(require 'pp)
(require 'browse-url)
;; Customize options.
(defgroup quickurl nil
- "Insert an URL based on text at point in buffer."
+ "Insert a URL based on text at point in buffer."
:version "21.1"
:group 'abbrev
:prefix "quickurl-")
-(defcustom quickurl-url-file (convert-standard-filename "~/.quickurls")
- "*File that contains the URL list."
+(defcustom quickurl-url-file
+ (locate-user-emacs-file "quickurls" ".quickurls")
+ "File that contains the URL list."
+ :version "24.4" ; added locate-user-emacs-file
:type 'file
:group 'quickurl)
(defcustom quickurl-format-function (lambda (url) (format "<URL:%s>" (quickurl-url-url url)))
- "*Function to format the URL before insertion into the current buffer."
+ "Function to format the URL before insertion into the current buffer."
:type 'function
:group 'quickurl)
(string<
(downcase (quickurl-url-description x))
(downcase (quickurl-url-description y))))))
- "*Function to sort the URL list."
+ "Function to sort the URL list."
:type 'function
:group 'quickurl)
(defcustom quickurl-grab-lookup-function #'current-word
- "*Function to grab the thing to lookup."
+ "Function to grab the thing to lookup."
:type 'function
:group 'quickurl)
(defcustom quickurl-assoc-function #'assoc-ignore-case
- "*Function to use for alist lookup into `quickurl-urls'."
+ "Function to use for alist lookup into `quickurl-urls'."
:type 'function
:group 'quickurl)
(defcustom quickurl-completion-ignore-case t
- "*Should `quickurl-ask' ignore case when doing the input lookup?"
+ "Should `quickurl-ask' ignore case when doing the input lookup?"
:type 'boolean
:group 'quickurl)
(defcustom quickurl-prefix ";; -*- lisp -*-\n\n"
- "*Text to write to `quickurl-url-file' before writing the URL list."
+ "Text to write to `quickurl-url-file' before writing the URL list."
:type 'string
:group 'quickurl)
(defcustom quickurl-postfix ""
- "*Text to write to `quickurl-url-file' after writing the URL list.
+ "Text to write to `quickurl-url-file' after writing the URL list.
See the constant `quickurl-reread-hook-postfix' for some example text that
could be used here."
:group 'quickurl)
(defcustom quickurl-list-mode-hook nil
- "*Hooks for `quickurl-list-mode'."
+ "Hooks for `quickurl-list-mode'."
:type 'hook
:group 'quickurl)
(setq quickurl-postfix quickurl-reread-hook-postfix)
-in your ~/.emacs (after loading/requiring quickurl).")
+in your init file (after loading/requiring quickurl).")
;; Non-customize variables.
(defvar quickurl-urls nil
"URL alist for use with `quickurl' and `quickurl-ask'.")
-(defvar quickurl-list-mode-map nil
+(defvar quickurl-list-mode-map
+ (let ((map (make-sparse-keymap)))
+ (suppress-keymap map t)
+ (define-key map "a" #'quickurl-list-add-url)
+ (define-key map [(control m)] #'quickurl-list-insert-url)
+ (define-key map "u" #'quickurl-list-insert-naked-url)
+ (define-key map " " #'quickurl-list-insert-with-lookup)
+ (define-key map "l" #'quickurl-list-insert-lookup)
+ (define-key map "d" #'quickurl-list-insert-with-desc)
+ (define-key map [(control g)] #'quickurl-list-quit)
+ (define-key map "q" #'quickurl-list-quit)
+ (define-key map [mouse-2] #'quickurl-list-mouse-select)
+ (define-key map "?" #'describe-mode)
+ map)
"Local keymap for a `quickurl-list-mode' buffer.")
(defvar quickurl-list-buffer-name "*quickurl-list*"
- "Name for the URL listinig buffer.")
+ "Name for the URL listing buffer.")
(defvar quickurl-list-last-buffer nil
"`current-buffer' when `quickurl-list' was called.")
-;; Functions for working with an URL entry.
+;; Functions for working with a URL entry.
(defun quickurl-url-commented-p (url)
"Does the URL have a comment?"
(listp (cdr url)))
(defun quickurl-make-url (keyword url &optional comment)
- "Create an URL from KEYWORD, URL and (optionaly) COMMENT."
+ "Create a URL from KEYWORD, URL and (optionally) COMMENT."
(if (and comment (not (zerop (length comment))))
(list keyword url comment)
(cons keyword url)))
-(defun quickurl-url-keyword (url)
+(defalias 'quickurl-url-keyword #'car
"Return the keyword for the URL.
-
-Note that this function is a setfable place."
- (car url))
-
-(defsetf quickurl-url-keyword (url) (store)
- `(setf (car ,url) ,store))
+\n\(fn URL)")
(defun quickurl-url-url (url)
"Return the actual URL of the URL.
Note that this function is a setfable place."
+ (declare (gv-setter (lambda (store)
+ `(setf (if (quickurl-url-commented-p ,url)
+ (cadr ,url)
+ (cdr ,url))
+ ,store))))
(if (quickurl-url-commented-p url)
(cadr url)
(cdr url)))
-(defsetf quickurl-url-url (url) (store)
- `
- (if (quickurl-url-commented-p ,url)
- (setf (cadr ,url) ,store)
- (setf (cdr ,url) ,store)))
-
(defun quickurl-url-comment (url)
- "Get the comment from an URL.
+ "Get the comment from a URL.
If the URL has no comment an empty string is returned. Also note that this
function is a setfable place."
+ (declare
+ (gv-setter (lambda (store)
+ `(if (quickurl-url-commented-p ,url)
+ (if (zerop (length ,store))
+ (setf (cdr ,url) (cadr ,url))
+ (setf (nth 2 ,url) ,store))
+ (unless (zerop (length ,store))
+ (setf (cdr ,url) (list (cdr ,url) ,store)))))))
(if (quickurl-url-commented-p url)
(nth 2 url)
""))
-(defsetf quickurl-url-comment (url) (store)
- `
- (if (quickurl-url-commented-p ,url)
- (if (zerop (length ,store))
- (setf (cdr ,url) (cadr ,url))
- (setf (nth 2 ,url) ,store))
- (unless (zerop (length ,store))
- (setf (cdr ,url) (list (cdr ,url) ,store)))))
-
(defun quickurl-url-description (url)
"Return a description for the URL.
;; Main code:
-(defun* quickurl-read (&optional buffer)
+(cl-defun quickurl-read (&optional buffer)
"`read' the URL list from BUFFER into `quickurl-urls'.
BUFFER, if nil, defaults to current buffer.
Note that this function moves point to `point-min' before doing the `read'
It also restores point after the `read'."
(save-excursion
- (setf (point) (point-min))
+ (goto-char (point-min))
(setq quickurl-urls (funcall quickurl-sort-function
(read (or buffer (current-buffer)))))))
(defun quickurl-save-urls ()
"Save the contents of `quickurl-urls' to `quickurl-url-file'."
(with-temp-buffer
- (let ((standard-output (current-buffer)))
+ (let ((standard-output (current-buffer))
+ (print-length nil))
(princ quickurl-prefix)
(pp quickurl-urls)
(princ quickurl-postfix)
(message "Found %s" (quickurl-url-url url))))
;;;###autoload
-(defun* quickurl (&optional lookup)
- "Insert an URL based on LOOKUP.
+(cl-defun quickurl (&optional lookup)
+ "Insert a URL based on LOOKUP.
If not supplied LOOKUP is taken to be the word at point in the current
-buffer, this default action can be modifed via
+buffer, this default action can be modified via
`quickurl-grab-lookup-function'."
(interactive)
(when (or lookup
;;;###autoload
(defun quickurl-ask (lookup)
- "Insert an URL, with `completing-read' prompt, based on LOOKUP."
+ "Insert a URL, with `completing-read' prompt, based on LOOKUP."
(interactive
(list
(progn
(quickurl-insert url))))
(defun quickurl-grab-url ()
- "Attempt to grab a word/url pair from point in the current buffer.
+ "Attempt to grab a word/URL pair from point in the current buffer.
Point should be somewhere on the URL and the word is taken to be the thing
that is returned from calling `quickurl-grab-lookup-function' once a
(defun quickurl-add-url (word url comment)
"Allow the user to interactively add a new URL associated with WORD.
-See `quickurl-grab-url' for details on how the default word/url combination
+See `quickurl-grab-url' for details on how the default word/URL combination
is decided."
(interactive (let ((word-url (quickurl-grab-url)))
(list (read-string "Word: " (quickurl-url-keyword word-url))
"Browse the URL associated with LOOKUP.
If not supplied LOOKUP is taken to be the word at point in the
-current buffer, this default action can be modifed via
+current buffer, this default action can be modified via
`quickurl-grab-lookup-function'."
(interactive)
(when (or lookup
;; quickurl-list mode.
-(unless quickurl-list-mode-map
- (let ((map (make-sparse-keymap)))
- (suppress-keymap map t)
- (define-key map "a" #'quickurl-list-add-url)
- (define-key map [(control m)] #'quickurl-list-insert-url)
- (define-key map "u" #'quickurl-list-insert-naked-url)
- (define-key map " " #'quickurl-list-insert-with-lookup)
- (define-key map "l" #'quickurl-list-insert-lookup)
- (define-key map "d" #'quickurl-list-insert-with-desc)
- (define-key map [(control g)] #'quickurl-list-quit)
- (define-key map "q" #'quickurl-list-quit)
- (define-key map [mouse-2] #'quickurl-list-mouse-select)
- (define-key map "?" #'describe-mode)
- (setq quickurl-list-mode-map map)))
-
(put 'quickurl-list-mode 'mode-class 'special)
;;;###autoload
-(defun quickurl-list-mode ()
+(define-derived-mode quickurl-list-mode fundamental-mode "quickurl list"
"A mode for browsing the quickurl URL list.
The key bindings for `quickurl-list-mode' are:
\\{quickurl-list-mode-map}"
- (interactive)
- (kill-all-local-variables)
- (use-local-map quickurl-list-mode-map)
- (setq major-mode 'quickurl-list-mode
- mode-name "quickurl list")
- (run-mode-hooks 'quickurl-list-mode-hook)
(setq buffer-read-only t
truncate-lines t))
(defun quickurl-list-populate-buffer ()
"Populate the `quickurl-list' buffer."
(with-current-buffer (get-buffer quickurl-list-buffer-name)
- (let ((buffer-read-only nil)
- (fmt (format "%%-%ds %%s\n"
- (apply #'max (or (loop for url in quickurl-urls
- collect (length (quickurl-url-description url)))
- (list 20))))))
- (setf (buffer-string) "")
- (loop for url in quickurl-urls
- do (let ((start (point)))
- (insert (format fmt (quickurl-url-description url)
- (quickurl-url-url url)))
- (add-text-properties start (1- (point))
- '(mouse-face highlight
- help-echo "mouse-2: insert this URL"))))
- (setf (point) (point-min)))))
+ (let* ((sizes (or (cl-loop for url in quickurl-urls
+ collect (length (quickurl-url-description url)))
+ (list 20)))
+ (fmt (format "%%-%ds %%s\n" (apply #'max sizes)))
+ (inhibit-read-only t))
+ (erase-buffer)
+ (cl-loop for url in quickurl-urls
+ do (let ((start (point)))
+ (insert (format fmt (quickurl-url-description url)
+ (quickurl-url-url url)))
+ (add-text-properties
+ start (1- (point))
+ '(mouse-face highlight
+ help-echo "mouse-2: insert this URL"))))
+ (goto-char (point-min)))))
(defun quickurl-list-add-url (word url comment)
"Wrapper for `quickurl-add-url' that doesn't guess the parameters."
(defun quickurl-list-mouse-select (event)
"Select the URL under the mouse click."
(interactive "e")
- (setf (point) (posn-point (event-end event)))
+ (goto-char (posn-point (event-end event)))
(quickurl-list-insert-url))
(defun quickurl-list-insert (type)
`with-lookup' - Insert \"lookup <URL:url>\"
`with-desc' - Insert \"description <URL:url>\"
`lookup' - Insert the lookup for that URL"
- (let ((url (nth (save-excursion
- (beginning-of-line)
- (count-lines (point-min) (point)))
+ (let ((url (nth (count-lines (point-min) (line-beginning-position))
quickurl-urls)))
(if url
(with-current-buffer quickurl-list-last-buffer
(insert
- (case type
- ('url (funcall quickurl-format-function url))
- ('naked-url (quickurl-url-url url))
- ('with-lookup (format "%s <URL:%s>"
+ (pcase type
+ (`url (funcall quickurl-format-function url))
+ (`naked-url (quickurl-url-url url))
+ (`with-lookup (format "%s <URL:%s>"
(quickurl-url-keyword url)
(quickurl-url-url url)))
- ('with-desc (format "%S <URL:%s>"
+ (`with-desc (format "%S <URL:%s>"
(quickurl-url-description url)
(quickurl-url-url url)))
- ('lookup (quickurl-url-keyword url)))))
+ (`lookup (quickurl-url-keyword url)))))
(error "No URL details on that line"))
url))
(provide 'quickurl)
-;; arch-tag: a8183ea5-80c2-4082-a7d1-b0fdf2da467e
;;; quickurl.el ends here