unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
blob 479f64c3e074e4c3e74213cab654418b45d7043e 3589 bytes (raw)
name: lisp/url/url-misc.el 	 # note: path name is non-authoritative(*)

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
 
;;; url-misc.el --- Misc Uniform Resource Locator retrieval code  -*- lexical-binding: t; -*-

;; Copyright (C) 1996-1999, 2002, 2004-2022 Free Software Foundation,
;; Inc.

;; Keywords: comm, data, processes

;; 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-vars)
(require 'url-parse)
(declare-function mm-disable-multibyte "mm-util" ())
(autoload 'Info-goto-node "info" "" t)
(autoload 'man "man" nil t)

;;;###autoload
(defun url-man (url)
  "Fetch a Unix manual page URL."
  (man (url-filename url))
  nil)

;;;###autoload
(defun url-info (url)
  "Fetch a GNU Info URL."
  ;; Fetch an info node
  (let* ((fname (url-filename url))
	 (node (url-unhex-string (or (url-target url) "Top"))))
    (if (and fname node)
	(Info-goto-node (concat "(" fname ")" node))
      (error "Malformed url: %s" (url-recreate-url url)))
    nil))

(defun url-do-terminal-emulator (type server port user)
  (switch-to-buffer
   (apply
    'make-term
    (format "%s%s" (if user (concat user "@") "") server)
    (cond ((eq type 'rlogin) "rlogin")
	  ((eq type 'telnet) "telnet")
	  ((eq type 'tn3270) "tn3270")
	  (t (error "Unknown terminal emulator required: %s" type)))
    nil
    (cond ((eq type 'rlogin)
	   (if user (list server "-l" user) (list server)))
	  ((eq type 'telnet)
	   (if port (list server port) (list server)))
	  ((eq type 'tn3270)
	   (list server))))))

;;;###autoload
(defun url-generic-emulator-loader (url)
  (let* ((type (intern (downcase (url-type url))))
	 (server (url-host url))
	 (name (url-user url))
	 (port (number-to-string (url-port url))))
    (url-do-terminal-emulator type server port name))
  nil)

;;;###autoload
(defalias 'url-rlogin 'url-generic-emulator-loader)
;;;###autoload
(defalias 'url-telnet 'url-generic-emulator-loader)
;;;###autoload
(defalias 'url-tn3270 'url-generic-emulator-loader)

;; RFC 2397
;;;###autoload
(defun url-data (url)
  "Fetch a data URL (RFC 2397)."
  (let ((mediatype nil)
	;; The mediatype may need to be hex-encoded too -- see the RFC.
	(desc (url-unhex-string (url-filename url)))
	(encoding "8bit")
	(data nil))
    (save-excursion
      (if (not (string-match "\\([^,]*\\)," desc))
	  (error "Malformed data URL: %s" desc)
	(setq mediatype (match-string 1 desc)
	      data (url-unhex-string (substring desc (match-end 0))))
	(if (and mediatype (string-match ";base64\\'" mediatype))
	    (setq mediatype (substring mediatype 0 (match-beginning 0))
		  encoding "base64"))
	(if (or (null mediatype)
		(eq ?\; (aref mediatype 0)))
	  (setq mediatype (concat "text/plain" mediatype))))
      (set-buffer (generate-new-buffer " *url-data*"))
      (require 'mm-util)
      (mm-disable-multibyte)
      (insert (format "Content-Length: %d\n" (length data))
	      "Content-Type: " mediatype "\n"
	      "Content-Transfer-Encoding: " encoding "\n"
	      "\n")
      (if data (insert data))
      (current-buffer))))

(provide 'url-misc)

;;; url-misc.el ends here

debug log:

solving 479f64c3e0 ...
found 479f64c3e0 in https://git.savannah.gnu.org/cgit/emacs.git

(*) Git path names are given by the tree(s) the blob belongs to.
    Blobs themselves have no identifier aside from the hash of its contents.^

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).