diff options
| author | Lars Ingebrigtsen <larsi@gnus.org> | 2022-08-04 11:13:48 +0200 |
|---|---|---|
| committer | Lars Ingebrigtsen <larsi@gnus.org> | 2022-08-04 11:13:48 +0200 |
| commit | 4f3a33c90f0652363b1fd4c7870f95d9a02ae7e2 (patch) | |
| tree | be4074dc0c4671b952f3eb01326caa7a152bfcff /lisp/obsolete | |
| parent | 8348ace63a9c2cd039cad855784e2c352c3bb789 (diff) | |
| download | emacs-4f3a33c90f0652363b1fd4c7870f95d9a02ae7e2.tar.gz | |
Make url-about.el obsolete (bug#56885)
Diffstat (limited to 'lisp/obsolete')
| -rw-r--r-- | lisp/obsolete/url-about.el | 103 |
1 files changed, 103 insertions, 0 deletions
diff --git a/lisp/obsolete/url-about.el b/lisp/obsolete/url-about.el new file mode 100644 index 00000000000..a50986d511a --- /dev/null +++ b/lisp/obsolete/url-about.el @@ -0,0 +1,103 @@ +;;; url-about.el --- Show internal URLs -*- lexical-binding: t; -*- + +;; Copyright (C) 2001-2022 Free Software Foundation, Inc. + +;; Keywords: comm, data, processes, 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: + +;;; Code: + +(require 'url-util) +(require 'url-parse) + +(defun url-probe-protocols () + "Return a list of all potential URL schemes." + (or (get 'url-extension-protocols 'probed) + (mapc (lambda (s) (url-scheme-get-property s 'name)) + (or (get 'url-extension-protocols 'schemes) + (let ((schemes '("info" "man" "rlogin" "telnet" + "tn3270" "data" "snews"))) + (mapc (lambda (d) + (mapc (lambda (f) + (if (string-match "url-\\(.*\\).el$" f) + (push (match-string 1 f) schemes))) + (directory-files d nil "\\`url-.*\\.el\\'"))) + (seq-filter #'file-exists-p load-path)) + (put 'url-extension-protocols 'schemes schemes) + schemes))))) + +(defvar url-scheme-registry) + +(defun url-about-protocols (_url) + (url-probe-protocols) + (insert "<html>\n" + " <head>\n" + " <title>Supported Protocols</title>\n" + " </head>\n" + " <body>\n" + " <h1>Supported Protocols - URL package in Emacs " emacs-version "</h1>\n" + " <table width='100%' border='1'>\n" + " <tr>\n" + " <td>Protocol\n" + " <td>Properties\n" + " <td>Description\n" + " </tr>\n") + (mapc (lambda (k) + (if (string= k "proxy") + ;; Ignore the proxy setting... its magic! + nil + (insert " <tr>\n") + ;; The name of the protocol + (insert " <td valign=top>" (or (url-scheme-get-property k 'name) k) "\n") + + ;; Now the properties. Currently just asynchronous + ;; status, default port number, and proxy status. + (insert " <td valign=top>" + (if (url-scheme-get-property k 'asynchronous-p) "As" "S") + "ynchronous<br>\n" + (if (url-scheme-get-property k 'default-port) + (format "Default Port: %d<br>\n" + (url-scheme-get-property k 'default-port)) + "") + (if (assoc k url-proxy-services) + (format "Proxy: %s<br>\n" (assoc k url-proxy-services)) "")) + ;; Now the description... + (insert " <td valign=top>" + (or (url-scheme-get-property k 'description) "N/A")))) + (sort (let (x) (maphash (lambda (k _v) (push k x)) url-scheme-registry) x) + #'string-lessp)) + (insert " </table>\n" + " </body>\n" + "</html>\n")) + +(defun url-about (url) + "Show internal URLs." + (let* ((item (downcase (url-filename url))) + (func (intern (format "url-about-%s" item)))) + (if (fboundp func) + (progn + (set-buffer (generate-new-buffer " *about-data*")) + (insert "Content-type: text/plain\n\n") + (funcall func url) + (current-buffer)) + (error "URL does not know about `%s'" item)))) + +(provide 'url-about) + +;;; url-about.el ends here |