diff options
Diffstat (limited to 'lisp/obsolete/quickurl.el')
| -rw-r--r-- | lisp/obsolete/quickurl.el | 523 |
1 files changed, 523 insertions, 0 deletions
diff --git a/lisp/obsolete/quickurl.el b/lisp/obsolete/quickurl.el new file mode 100644 index 00000000000..61cae43a88a --- /dev/null +++ b/lisp/obsolete/quickurl.el @@ -0,0 +1,523 @@ +;;; quickurl.el --- insert a URL based on text at point in buffer -*- lexical-binding: t; -*- + +;; Copyright (C) 1999-2022 Free Software Foundation, Inc. + +;; Author: Dave Pearson <davep@davep.org> +;; Created: 1999-05-28 +;; Keywords: hypermedia + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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. + +;; GNU Emacs 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 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 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. +;; +;; The URLs are stored in an external file as a list of either cons cells, +;; or lists. A cons cell entry looks like this: +;; +;; (<Lookup> . <URL>) +;; +;; where <Lookup> is a string that acts as the keyword lookup and <URL> is +;; the URL associated with it. An example might be: +;; +;; ("GNU" . "https://www.gnu.org/") +;; +;; A list entry looks like: +;; +;; (<Lookup> <URL> <Comment>) +;; +;; where <Lookup> and <URL> are the same as with the cons cell and <Comment> +;; is any text you like that describes the URL. This description will be +;; used when presenting a list of URLS using `quickurl-list'. An example +;; might be: +;; +;; ("FSF" "https://www.fsf.org/" "The Free Software Foundation") +;; +;; Given the above, your quickurl file might look like: +;; +;; (("GNU" . "https://www.gnu.org/") +;; ("FSF" "https://www.fsf.org/" "The Free Software Foundation") +;; ("emacs" . "https://www.emacs.org/") +;; ("davep" "http://www.davep.org/" "Dave's homepage")) +;; +;; In case you're wondering about the mixture of cons cells and lists, +;; quickurl started life using just the cons cells, there were no comments. +;; URL comments are a later addition and so there is a mixture to keep +;; backward compatibility with existing URL lists. +;; +;; The name and location of the file is up to you, the default name used by +;; `quickurl' is stored in `quickurl-url-file'. +;; +;; quickurl is always available from: +;; +;; <URL:http://www.davep.org/emacs/quickurl.el> + +;;; TODO: +;; +;; o The quickurl-browse-url* functions pretty much duplicate their non +;; browsing friends. It would feel better if a more generic solution could +;; be found. + +;;; Code: + +;; Things we need: + +(eval-when-compile (require 'cl-lib)) +(require 'thingatpt) +(require 'pp) +(require 'browse-url) + +;; Customize options. + +(defgroup quickurl nil + "Insert a URL based on text at point in buffer." + :version "21.1" + :group 'abbrev + :prefix "quickurl-") + +(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) + +(defcustom quickurl-format-function #'quickurl-format-url + "Function to format the URL before insertion into the current buffer." + :type 'function) + +(defcustom quickurl-sort-function #'quickurl-sort-urls + "Function to sort the URL list." + :type 'function) + +(defcustom quickurl-grab-lookup-function #'current-word + "Function to grab the thing to lookup." + :type 'function) + +(defun quickurl--assoc-function (key alist) + "Default function for `quickurl-assoc-function'." + (assoc-string key alist t)) + +(defcustom quickurl-assoc-function #'quickurl--assoc-function + "Function to use for alist lookup into `quickurl-urls'." + :version "26.1" ; was the obsolete assoc-ignore-case + :type 'function) + +(defcustom quickurl-completion-ignore-case t + "Should `quickurl-ask' ignore case when doing the input lookup?" + :type 'boolean) + +(defcustom quickurl-prefix ";; -*- lisp -*-\n\n" + "Text to write to `quickurl-url-file' before writing the URL list." + :type 'string) + +(defcustom quickurl-postfix "" + "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." + :type 'string) + +(defcustom quickurl-list-mode-hook nil + "Hooks for `quickurl-list-mode'." + :type 'hook) + +;; Constants. + +;;;###autoload +(defconst quickurl-reread-hook-postfix + " +;; Local Variables: +;; eval: (progn (require 'quickurl) (add-hook 'write-file-functions (lambda () (quickurl-read) nil) nil t)) +;; End: +" + "Example `quickurl-postfix' text that adds a local variable to the +`quickurl-url-file' so that if you edit it by hand it will ensure that +`quickurl-urls' is updated with the new URL list. + +To make use of this do something like: + + (setq quickurl-postfix quickurl-reread-hook-postfix) + +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-keymap quickurl-list-mode-map + :doc "Local keymap for a `quickurl-list-mode' buffer." + "a" #'quickurl-list-add-url + "RET" #'quickurl-list-insert-url + "u" #'quickurl-list-insert-naked-url + "SPC" #'quickurl-list-insert-with-lookup + "l" #'quickurl-list-insert-lookup + "d" #'quickurl-list-insert-with-desc + "C-g" #'quickurl-list-quit + "q" #'quickurl-list-quit + "<mouse-2>" #'quickurl-list-mouse-select) + +(defvar quickurl-list-buffer-name "*quickurl-list*" + "Name for the URL listing buffer.") + +(defvar quickurl-list-last-buffer nil + "`current-buffer' when `quickurl-list' was called.") + +;; 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 a URL from KEYWORD, URL and (optionally) COMMENT." + (if (and comment (not (zerop (length comment)))) + (list keyword url comment) + (cons keyword url))) + +(defalias 'quickurl-url-keyword #'car + "Return the keyword for the URL. +\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))) + +(defun quickurl-url-comment (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) + "")) + +(defun quickurl-url-description (url) + "Return a description for the URL. + +If the URL has a comment then this is returned, otherwise the keyword is +returned." + (let ((desc (quickurl-url-comment url))) + (if (zerop (length desc)) + (quickurl-url-keyword url) + desc))) + +;; Main code: + +(defun quickurl-format-url (url) + (format "<URL:%s>" (quickurl-url-url url))) + +(defun quickurl-sort-urls (list) + "Sort URLs in LIST according to their `quickurl-url-description'." + (sort list + (lambda (x y) + (string< + (downcase (quickurl-url-description x)) + (downcase (quickurl-url-description y)))))) + +(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 + (goto-char (point-min)) + (setq quickurl-urls (funcall quickurl-sort-function + (read (or buffer (current-buffer))))))) + +(defun quickurl-load-urls () + "Load the contents of `quickurl-url-file' into `quickurl-urls'." + (when (file-exists-p quickurl-url-file) + (with-temp-buffer + (insert-file-contents quickurl-url-file) + (quickurl-read)))) + +(defun quickurl-save-urls () + "Save the contents of `quickurl-urls' to `quickurl-url-file'." + (with-temp-buffer + (let ((standard-output (current-buffer)) + (print-length nil)) + (princ quickurl-prefix) + (pp quickurl-urls) + (princ quickurl-postfix) + (write-region (point-min) (point-max) quickurl-url-file nil 0)))) + +(defun quickurl-find-url (lookup) + "Return URL associated with key LOOKUP. + +The lookup is done by looking in the alist `quickurl-urls' and the `cons' +for the URL is returned. The actual method used to look into the alist +depends on the setting of the variable `quickurl-assoc-function'." + (funcall quickurl-assoc-function lookup quickurl-urls)) + +(defun quickurl-insert (url &optional silent) + "Insert URL, formatted using `quickurl-format-function'. + +Also display a `message' saying what the URL was unless SILENT is non-nil." + (insert (funcall quickurl-format-function url)) + (unless silent + (message "Found %s" (quickurl-url-url url)))) + +;;;###autoload +(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 modified via +`quickurl-grab-lookup-function'." + (interactive) + (when (or lookup + (setq lookup (funcall quickurl-grab-lookup-function))) + (quickurl-load-urls) + (let ((url (quickurl-find-url lookup))) + (if (null url) + (error "No URL associated with \"%s\"" lookup) + (when (looking-at "\\w") + (skip-syntax-forward "\\w")) + (insert " ") + (quickurl-insert url))))) + +;;;###autoload +(defun quickurl-ask (lookup) + "Insert a URL, with `completing-read' prompt, based on LOOKUP." + (interactive + (list + (progn + (quickurl-load-urls) + (let ((completion-ignore-case quickurl-completion-ignore-case)) + (completing-read "Lookup: " quickurl-urls nil t))))) + (let ((url (quickurl-find-url lookup))) + (when url + (quickurl-insert url)))) + +(defun quickurl-grab-url () + "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 +`backward-word' has been issued at the start of the URL. + +It is assumed that the URL is either \"unguarded\" or is wrapped inside an +<URL:...> wrapper." + (let ((url (thing-at-point 'url))) + (when url + (save-excursion + (beginning-of-thing 'url) + ;; `beginning-of-thing' doesn't take you to the start of a marked-up + ;; URL, only to the start of the URL within the "markup". So, we + ;; need to do a little more work to get to where we want to be. + (when (thing-at-point-looking-at thing-at-point-markedup-url-regexp) + (search-backward "<URL:")) + (backward-word-strictly 1) + (let ((word (funcall quickurl-grab-lookup-function))) + (when word + (quickurl-make-url + ;; The grab function may return the word with properties. I don't + ;; want the properties. I couldn't find a method of stripping + ;; them from a "string" so this will have to do. If you know of + ;; a better method of doing this I'd love to know. + (with-temp-buffer + (insert word) + (buffer-substring-no-properties (point-min) (point-max))) + url))))))) + +;;;###autoload +(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 +is decided." + (interactive (let ((word-url (quickurl-grab-url))) + (list (read-string "Word: " (quickurl-url-keyword word-url)) + (read-string "URL: " (quickurl-url-url word-url)) + (read-string "Comment: " (quickurl-url-comment word-url))))) + (if (zerop (length word)) + (error "You must specify a WORD for lookup") + (quickurl-load-urls) + (let* ((current-url (quickurl-find-url word)) + (add-it (if current-url + (if (called-interactively-p 'interactive) + (y-or-n-p (format "\"%s\" exists, replace URL? " word)) + t) + t))) + (when add-it + (if current-url + (progn + (setf (quickurl-url-url current-url) url) + (setf (quickurl-url-comment current-url) comment)) + (push (quickurl-make-url word url comment) quickurl-urls)) + (setq quickurl-urls (funcall quickurl-sort-function quickurl-urls)) + (quickurl-save-urls) + (when (get-buffer quickurl-list-buffer-name) + (quickurl-list-populate-buffer)) + (when (called-interactively-p 'interactive) + (message "Added %s" url)))))) + +;;;###autoload +(defun quickurl-browse-url (&optional lookup) + "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 modified via +`quickurl-grab-lookup-function'." + (interactive) + (when (or lookup + (setq lookup (funcall quickurl-grab-lookup-function))) + (quickurl-load-urls) + (let ((url (quickurl-find-url lookup))) + (if url + (browse-url (quickurl-url-url url)) + (error "No URL associated with \"%s\"" lookup))))) + +;;;###autoload +(defun quickurl-browse-url-ask (lookup) + "Browse the URL, with `completing-read' prompt, associated with LOOKUP." + (interactive (list + (progn + (quickurl-load-urls) + (completing-read "Browse: " quickurl-urls nil t)))) + (let ((url (quickurl-find-url lookup))) + (when url + (browse-url (quickurl-url-url url))))) + +;;;###autoload +(defun quickurl-edit-urls () + "Pull `quickurl-url-file' into a buffer for hand editing." + (interactive) + (find-file quickurl-url-file)) + +;; quickurl-list mode. + +;;;###autoload +(define-derived-mode quickurl-list-mode special-mode "Quickurl" + "A mode for browsing the quickurl URL list. + +The key bindings for `quickurl-list-mode' are: + +\\{quickurl-list-mode-map}" + (setq truncate-lines t)) + +;;;###autoload +(defun quickurl-list () + "Display `quickurl-list' as a formatted list using `quickurl-list-mode'." + (interactive) + (quickurl-load-urls) + (unless (string= (buffer-name) quickurl-list-buffer-name) + (setq quickurl-list-last-buffer (current-buffer))) + (pop-to-buffer quickurl-list-buffer-name) + (quickurl-list-populate-buffer) + (quickurl-list-mode)) + +(defun quickurl-list-populate-buffer () + "Populate the `quickurl-list' buffer." + (with-current-buffer (get-buffer quickurl-list-buffer-name) + (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) + (dolist (url quickurl-urls) + (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." + (interactive "sWord: \nsURL: \nsComment: ") + (quickurl-add-url word url comment)) + +(defun quickurl-list-quit () + "Kill the buffer named `quickurl-list-buffer-name'." + (interactive) + (quit-window t)) + +(defun quickurl-list-mouse-select (event) + "Select the URL under the mouse click." + (interactive "e") + (goto-char (posn-point (event-end event))) + (quickurl-list-insert-url)) + +(defun quickurl-list-insert (type) + "Insert the URL under cursor into `quickurl-list-last-buffer'. +TYPE dictates what will be inserted, options are: + `url' - Insert the URL as <URL:url> + `naked-url' - Insert the URL with no formatting + `with-lookup' - Insert \"lookup <URL:url>\" + `with-desc' - Insert \"description <URL:url>\" + `lookup' - Insert the lookup for that URL" + (let ((url (nth (count-lines (point-min) (line-beginning-position)) + quickurl-urls))) + (if url + (with-current-buffer quickurl-list-last-buffer + (insert + (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>" + (quickurl-url-description url) + (quickurl-url-url url))) + ('lookup (quickurl-url-keyword url))))) + (error "No URL details on that line")) + url)) + +(defmacro quickurl-list-make-inserter (type) + "Macro to make a key-response function for use in `quickurl-list-mode-map'." + `(defun ,(intern (format "quickurl-list-insert-%S" type)) () + ,(format "Insert the result of calling `quickurl-list-insert' with `%s'." type) + (interactive) + (when (quickurl-list-insert ',type) + (quickurl-list-quit)))) + +(quickurl-list-make-inserter url) +(quickurl-list-make-inserter naked-url) +(quickurl-list-make-inserter with-lookup) +(quickurl-list-make-inserter with-desc) +(quickurl-list-make-inserter lookup) + +(provide 'quickurl) + +;;; quickurl.el ends here |