* lisp/net/tramp-sh.el (tramp-methods) <doas>: Add. (Bug#22542)

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

diff --git a/lisp/net/quickurl.el b/lisp/net/quickurl.el
index d8220ef2b57a9df15302ba87f5c2079cdd797f8f..7a46485531a90c3131e5c8cd019d9a5a56f22ed9 100644 (file)
--- a/lisp/net/quickurl.el
+++ b/lisp/net/quickurl.el
@@ -1,7 +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, 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>
 
 ;; Author: Dave Pearson <davep@davep.org>
 ;; Maintainer: Dave Pearson <davep@davep.org>


@@ -25,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.


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


@@ -91,18 +89,20 @@
 ;; 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-")
 
   :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)))
   :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)
 


@@ -112,32 +112,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."


@@ -145,7 +145,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)
 


@@ -166,75 +166,81 @@ 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.
 
 (defvar quickurl-urls nil
   "URL alist for use with `quickurl' and `quickurl-ask'.")
 
 
 ;; 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*"
   "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.
 


@@ -247,14 +253,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)))))))
 


@@ -268,7 +274,8 @@ It also restores point after the `read'."
 (defun quickurl-save-urls ()
   "Save the contents of `quickurl-urls' to `quickurl-url-file'."
   (with-temp-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)
       (princ quickurl-prefix)
       (pp quickurl-urls)
       (princ quickurl-postfix)


@@ -291,11 +298,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


@@ -311,7 +318,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


@@ -323,7 +330,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


@@ -357,7 +364,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))


@@ -390,7 +397,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


@@ -420,36 +427,15 @@ current buffer, this default action can be modifed via
 
 ;; quickurl-list mode.
 
 
 ;; 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
 (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}"
   "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))
 
   (setq buffer-read-only t
         truncate-lines   t))
 


@@ -467,20 +453,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."


@@ -497,7 +484,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)


@@ -508,23 +495,21 @@ TYPE dictates what will be inserted, options are:
   `with-lookup' - Insert \"lookup <URL:url>\"
   `with-desc'   - Insert \"description <URL:url>\"
   `lookup'      - Insert the lookup for that URL"
   `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
                   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)))
                                    (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))
 


@@ -544,5 +529,4 @@ TYPE dictates what will be inserted, options are:
 
 (provide 'quickurl)
 
 
 (provide 'quickurl)
 

-;; arch-tag: a8183ea5-80c2-4082-a7d1-b0fdf2da467e

 ;;; quickurl.el ends here
 ;;; quickurl.el ends here