* lisp/net/tramp.el (tramp-get-debug-buffer): Ensure outline.el is not

[gnu-emacs] / lisp / net / quickurl.el

diff --git a/lisp/net/quickurl.el b/lisp/net/quickurl.el
index c3da1707165cc3f9cd1acd52782cc330e27b58e6..ce9ef55f49906355742aacaa858befa3e56a33a1 100644 (file)
--- a/lisp/net/quickurl.el
+++ b/lisp/net/quickurl.el
@@ -1,6 +1,6 @@
-;;; 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-2011  Free Software Foundation, Inc.
+;; Copyright (C) 1999-2013 Free Software Foundation, Inc.

 
 ;; Author: Dave Pearson <davep@davep.org>
 ;; Maintainer: Dave Pearson <davep@davep.org>
 
 ;; Author: Dave Pearson <davep@davep.org>
 ;; Maintainer: Dave Pearson <davep@davep.org>


@@ -24,9 +24,9 @@
 
 ;;; Commentary:
 ;;
 
 ;;; 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
 ;; 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.
 ;; 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.


@@ -81,8 +81,7 @@
 
 ;; Things we need:
 
 
 ;; Things we need:
 

-(eval-when-compile
-  (require 'cl))
+(eval-when-compile (require 'cl-lib))

 (require 'thingatpt)
 (require 'pp)
 (require 'browse-url)
 (require 'thingatpt)
 (require 'pp)
 (require 'browse-url)


@@ -90,18 +89,18 @@
 ;; Customize options.
 
 (defgroup quickurl nil
 ;; 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")
   :version "21.1"
   :group  'abbrev
   :prefix "quickurl-")
 
 (defcustom quickurl-url-file (convert-standard-filename "~/.quickurls")

-  "*File that contains the URL list."
+  "File that contains the URL list."

   :type  'file
   :group 'quickurl)
 
 (defcustom quickurl-format-function (lambda (url) (format "<URL:%s>" (quickurl-url-url url)))
   :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)
 
   :type  'function
   :group 'quickurl)
 


@@ -111,32 +110,32 @@
                                             (string<
                                              (downcase (quickurl-url-description x))
                                              (downcase (quickurl-url-description y))))))
                                             (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
   :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
   :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
   :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"
   :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 ""
   :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."
 
 See the constant `quickurl-reread-hook-postfix' for some example text that
 could be used here."


@@ -144,7 +143,7 @@ could be used here."
   :group 'quickurl)
 
 (defcustom quickurl-list-mode-hook nil
   :group 'quickurl)
 
 (defcustom quickurl-list-mode-hook nil

-  "*Hooks for `quickurl-list-mode'."
+  "Hooks for `quickurl-list-mode'."

   :type  'hook
   :group 'quickurl)
 
   :type  'hook
   :group 'quickurl)
 


@@ -165,7 +164,7 @@ To make use of this do something like:
 
   (setq quickurl-postfix quickurl-reread-hook-postfix)
 
 
   (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.
 
 
 ;; Non-customize variables.
 


@@ -189,64 +188,57 @@ in your ~/.emacs (after loading/requiring quickurl).")
   "Local keymap for a `quickurl-list-mode' buffer.")
 
 (defvar quickurl-list-buffer-name "*quickurl-list*"
   "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.")
 
 
 (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)
 
 (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)))
 
   (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.
   "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."
 
 (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)))
 
   (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)
 (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."
 
 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)
     ""))
 
   (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.
 
 (defun quickurl-url-description (url)
   "Return a description for the URL.
 


@@ -259,14 +251,14 @@ returned."
 
 ;; Main code:
 
 
 ;; 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
   "`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)))))))
 
     (setq quickurl-urls (funcall quickurl-sort-function
                                  (read (or buffer (current-buffer)))))))
 


@@ -303,11 +295,11 @@ Also display a `message' saying what the URL was unless SILENT is non-nil."
     (message "Found %s" (quickurl-url-url url))))
 
 ;;;###autoload
     (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
 
 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
 `quickurl-grab-lookup-function'."
   (interactive)
   (when (or lookup


@@ -323,7 +315,7 @@ buffer, this default action can be modifed via
 
 ;;;###autoload
 (defun quickurl-ask (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
   (interactive
    (list
     (progn


@@ -335,7 +327,7 @@ buffer, this default action can be modifed via
       (quickurl-insert url))))
 
 (defun quickurl-grab-url ()
       (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
 
 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


@@ -369,7 +361,7 @@ It is assumed that the URL is either \"unguarded\" or is wrapped inside an
 (defun quickurl-add-url (word url comment)
   "Allow the user to interactively add a new URL associated with WORD.
 
 (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))
 is decided."
   (interactive (let ((word-url (quickurl-grab-url)))
                  (list (read-string "Word: "    (quickurl-url-keyword word-url))


@@ -402,7 +394,7 @@ is decided."
   "Browse the URL associated with LOOKUP.
 
 If not supplied LOOKUP is taken to be the word at point in the
   "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-grab-lookup-function'."
   (interactive)
   (when (or lookup


@@ -464,20 +456,21 @@ The key bindings for `quickurl-list-mode' are:
 (defun quickurl-list-populate-buffer ()
   "Populate the `quickurl-list' buffer."
   (with-current-buffer (get-buffer quickurl-list-buffer-name)
 (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-add-url (word url comment)
   "Wrapper for `quickurl-add-url' that doesn't guess the parameters."


@@ -494,7 +487,7 @@ The key bindings for `quickurl-list-mode' are:
 (defun quickurl-list-mouse-select (event)
   "Select the URL under the mouse click."
   (interactive "e")
 (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)
   (quickurl-list-insert-url))
 
 (defun quickurl-list-insert (type)


@@ -510,16 +503,16 @@ TYPE dictates what will be inserted, options are:
     (if url
         (with-current-buffer quickurl-list-last-buffer
           (insert
     (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)))
                                    (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)))
                                    (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))
 
       (error "No URL details on that line"))
     url))