X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/90207a152538c00b6c75b9774b528470dfb42717..0e963201d03d9229bb8ac4323291d2b0119526ed:/lisp/net/quickurl.el diff --git a/lisp/net/quickurl.el b/lisp/net/quickurl.el index b0bfe5b271..7a46485531 100644 --- 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 -;; Copyright (C) 1999-2012 Free Software Foundation, Inc. +;; Copyright (C) 1999-2016 Free Software Foundation, Inc. ;; Author: Dave Pearson ;; Maintainer: Dave Pearson @@ -81,8 +81,7 @@ ;; Things we need: -(eval-when-compile - (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'thingatpt) (require 'pp) (require 'browse-url) @@ -95,8 +94,10 @@ :group 'abbrev :prefix "quickurl-") -(defcustom quickurl-url-file (convert-standard-filename "~/.quickurls") +(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) @@ -165,7 +166,7 @@ To make use of this do something like: (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. @@ -206,47 +207,40 @@ in your ~/.emacs (after loading/requiring quickurl).") (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 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. @@ -259,14 +253,14 @@ returned." ;; 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))))))) @@ -280,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 - (let ((standard-output (current-buffer))) + (let ((standard-output (current-buffer)) + (print-length nil)) (princ quickurl-prefix) (pp quickurl-urls) (princ quickurl-postfix) @@ -303,7 +298,7 @@ Also display a `message' saying what the URL was unless SILENT is non-nil." (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 @@ -435,18 +430,12 @@ current buffer, this default action can be modified via (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)) @@ -464,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) - (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." @@ -494,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") - (setf (point) (posn-point (event-end event))) + (goto-char (posn-point (event-end event))) (quickurl-list-insert-url)) (defun quickurl-list-insert (type) @@ -510,16 +500,16 @@ TYPE dictates what will be inserted, options are: (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 " + (pcase type + (`url (funcall quickurl-format-function url)) + (`naked-url (quickurl-url-url url)) + (`with-lookup (format "%s " (quickurl-url-keyword url) (quickurl-url-url url))) - (with-desc (format "%S " + (`with-desc (format "%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))