* 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 712f0b0c92428d8085d2f48bbb0ab9a62473749c..ce9ef55f49906355742aacaa858befa3e56a33a1 100644 (file)
--- a/lisp/net/quickurl.el
+++ b/lisp/net/quickurl.el
@@ -1,6 +1,6 @@
 ;;; quickurl.el --- insert a 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>


@@ -26,7 +26,7 @@
 ;;
 ;; 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
 ;;
 ;; 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.
 ;; 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)


@@ -96,12 +95,12 @@
   :prefix "quickurl-")
 
 (defcustom quickurl-url-file (convert-standard-filename "~/.quickurls")
   :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,7 +188,7 @@ 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.")


@@ -201,52 +200,45 @@ in your ~/.emacs (after loading/requiring quickurl).")
   (listp (cdr url)))
 
 (defun quickurl-make-url (keyword url &optional comment)
   (listp (cdr url)))
 
 (defun quickurl-make-url (keyword url &optional comment)

-  "Create a 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)
   "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."
 (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)
     ""))
 
   (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)
+(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
   "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
 `quickurl-grab-lookup-function'."
   (interactive)
   (when (or lookup


@@ -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))