mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-28 10:56:36 +00:00
Code Issues Releases Activity

* lisp/net/*.el: Use lexical-binding

Browse Source 
Also remove some redundant `:group` arguments.

* lisp/net/eudc-export.el: Use lexical-binding.
(eudc-create-bbdb-record): Use `cl-progv` and `apply` to avoid `eval`.

* lisp/net/eudc-hotlist.el: Use lexical-binding.

* lisp/net/eudc.el (eudc-print-attribute-value): Use `funcall` to avoid
`eval`.

* lisp/net/eudcb-bbdb.el: Use lexical-binding.
(eudc-bbdb-filter-non-matching-record): Use `funcall` to avoid `eval`.
Move `bbdb-val` binding to avoid `setq`.
Use `seq-some` instead of `eval+or`.
(eudc-bbdb-format-record-as-result): Use `dolist` and `pcase`.
Use `funcall` to avoid `eval`.
(eudc-bbdb-query-internal): Simplify a bit.

* lisp/net/eudcb-ldap.el: Use lexical-binding.
(eudc-ldap-get-host-parameter): Use `defalias` to avoid `eval-and-compile`.

* lisp/net/telnet.el: Use lexical-binding.
* lisp/net/quickurl.el: Use lexical-binding.
* lisp/net/newst-ticker.el: Use lexical-binding.
* lisp/net/newst-reader.el: Use lexical-binding.
* lisp/net/goto-addr.el: Use lexical-binding.
* lisp/net/gnutls.el: Use lexical-binding.
* lisp/net/eudcb-macos-contacts.el: Use lexical-binding.
* lisp/net/eudcb-mab.el: Use lexical-binding.

* lisp/net/net-utils.el: Use lexical-binding.
(finger): Remove unused var `found`.

* lisp/net/network-stream.el (open-protocol-stream): Remove redundant
`defalias`.

* lisp/net/newst-plainview.el: Use lexical-binding.
(newsticker-hide-entry, newsticker-show-entry): Remove unused var
`is-invisible`.
(w3m-fill-column, w3-maximum-line-length): Declare vars.

* lisp/net/tramp.el (tramp-compute-multi-hops):
* lisp/net/tramp-compat.el (tramp-compat-temporary-file-directory):
* lisp/net/tramp-cmds.el (tramp-default-rename-file):
* lisp/net/webjump.el (webjump): Don't forget lexical-binding for `eval`.
This commit is contained in:
Stefan Monnier 2021-03-08 10:11:22 -05:00
parent b4bfdd3999
commit dc083ebc4e
37 changed files with 486 additions and 550 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
lisp/net/browse-url.el
View File

@ -826,7 +826,7 @@ If optional arg TEMP-FILE-NAME is non-nil, delete it instead."
(if (and file-name (file-exists-p file-name))
(delete-file file-name))))
(add-hook 'kill-buffer-hook 'browse-url-delete-temp-file)
(add-hook 'kill-buffer-hook #'browse-url-delete-temp-file)
(declare-function dired-get-filename "dired"
(&optional localp no-error-if-not-filep))
@ -1064,7 +1064,7 @@ xdg-open is a desktop utility that calls your preferred web browser."
(executable-find "xdg-open")))
;;;###autoload
(defun browse-url-xdg-open (url &optional ignored)
(defun browse-url-xdg-open (url &optional _ignored)
"Pass the specified URL to the \"xdg-open\" command.
xdg-open is a desktop utility that calls your preferred web browser.
The optional argument IGNORED is not used."
@ -1095,7 +1095,7 @@ used instead of `browse-url-new-window-flag'."
(setq url (browse-url-encode-url url))
(let* ((process-environment (browse-url-process-environment))
(process
(apply 'start-process
(apply #'start-process
(concat "netscape " url) nil
browse-url-netscape-program
(append
@ -1125,7 +1125,7 @@ used instead of `browse-url-new-window-flag'."
(let* ((process-environment (browse-url-process-environment)))
;; Netscape not running - start it
(message "Starting %s..." browse-url-netscape-program)
(apply 'start-process (concat "netscape" url) nil
(apply #'start-process (concat "netscape" url) nil
browse-url-netscape-program
(append browse-url-netscape-startup-arguments (list url))))))
@ -1144,7 +1144,7 @@ How depends on `browse-url-netscape-version'."
"Send a remote control command to Netscape."
(declare (obsolete nil "25.1"))
(let* ((process-environment (browse-url-process-environment)))
(apply 'start-process "netscape" nil
(apply #'start-process "netscape" nil
browse-url-netscape-program
(append browse-url-netscape-arguments
(list "-remote" command)))))
@ -1170,7 +1170,7 @@ used instead of `browse-url-new-window-flag'."
(setq url (browse-url-encode-url url))
(let* ((process-environment (browse-url-process-environment))
(process
(apply 'start-process
(apply #'start-process
(concat "mozilla " url) nil
browse-url-mozilla-program
(append
@ -1196,7 +1196,7 @@ used instead of `browse-url-new-window-flag'."
(let* ((process-environment (browse-url-process-environment)))
;; Mozilla is not running - start it
(message "Starting %s..." browse-url-mozilla-program)
(apply 'start-process (concat "mozilla " url) nil
(apply #'start-process (concat "mozilla " url) nil
browse-url-mozilla-program
(append browse-url-mozilla-startup-arguments (list url))))))
@ -1219,7 +1219,7 @@ instead of `browse-url-new-window-flag'."
(interactive (browse-url-interactive-arg "URL: "))
(setq url (browse-url-encode-url url))
(let* ((process-environment (browse-url-process-environment)))
(apply 'start-process
(apply #'start-process
(concat "firefox " url) nil
browse-url-firefox-program
(append
@ -1242,7 +1242,7 @@ The optional argument NEW-WINDOW is not used."
(interactive (browse-url-interactive-arg "URL: "))
(setq url (browse-url-encode-url url))
(let* ((process-environment (browse-url-process-environment)))
(apply 'start-process
(apply #'start-process
(concat "chromium " url) nil
browse-url-chromium-program
(append
@ -1260,7 +1260,7 @@ The optional argument NEW-WINDOW is not used."
(interactive (browse-url-interactive-arg "URL: "))
(setq url (browse-url-encode-url url))
(let* ((process-environment (browse-url-process-environment)))
(apply 'start-process
(apply #'start-process
(concat "google-chrome " url) nil
browse-url-chrome-program
(append
@ -1290,7 +1290,7 @@ used instead of `browse-url-new-window-flag'."
(interactive (browse-url-interactive-arg "URL: "))
(setq url (browse-url-encode-url url))
(let* ((process-environment (browse-url-process-environment))
(process (apply 'start-process
(process (apply #'start-process
(concat "galeon " url)
nil
browse-url-galeon-program
@ -1315,7 +1315,7 @@ used instead of `browse-url-new-window-flag'."
(let* ((process-environment (browse-url-process-environment)))
;; Galeon is not running - start it
(message "Starting %s..." browse-url-galeon-program)
(apply 'start-process (concat "galeon " url) nil
(apply #'start-process (concat "galeon " url) nil
browse-url-galeon-program
(append browse-url-galeon-startup-arguments (list url))))))
@ -1338,7 +1338,7 @@ used instead of `browse-url-new-window-flag'."
(interactive (browse-url-interactive-arg "URL: "))
(setq url (browse-url-encode-url url))
(let* ((process-environment (browse-url-process-environment))
(process (apply 'start-process
(process (apply #'start-process
(concat "epiphany " url)
nil
browse-url-epiphany-program
@ -1362,7 +1362,7 @@ used instead of `browse-url-new-window-flag'."
(let* ((process-environment (browse-url-process-environment)))
;; Epiphany is not running - start it
(message "Starting %s..." browse-url-epiphany-program)
(apply 'start-process (concat "epiphany " url) nil
(apply #'start-process (concat "epiphany " url) nil
browse-url-epiphany-program
(append browse-url-epiphany-startup-arguments (list url))))))
@ -1403,7 +1403,7 @@ When called non-interactively, optional second argument NEW-WINDOW is
used instead of `browse-url-new-window-flag'."
(declare (obsolete nil "25.1"))
(interactive (browse-url-interactive-arg "URL: "))
(apply 'start-process (concat "gnome-moz-remote " url)
(apply #'start-process (concat "gnome-moz-remote " url)
nil
browse-url-gnome-moz-program
(append
@ -1437,7 +1437,7 @@ NEW-WINDOW instead of `browse-url-new-window-flag'."
(interactive (browse-url-interactive-arg "URL: "))
(setq url (browse-url-encode-url url))
(let* ((process-environment (browse-url-process-environment)))
(apply 'start-process (format "conkeror %s" url)
(apply #'start-process (format "conkeror %s" url)
nil
browse-url-conkeror-program
(append
@ -1487,7 +1487,7 @@ The `browse-url-gnudoit-program' program is used with options given by
`browse-url-gnudoit-args'. Default to the URL around or before point."
(declare (obsolete nil "25.1"))
(interactive (browse-url-interactive-arg "W3 URL: "))
(apply 'start-process (concat "gnudoit:" url) nil
(apply #'start-process (concat "gnudoit:" url) nil
browse-url-gnudoit-program
(append browse-url-gnudoit-args
(list (concat "(w3-fetch \"" url "\")")
@ -1667,7 +1667,7 @@ don't offer a form of remote control."
(interactive (browse-url-interactive-arg "URL: "))
(if (not browse-url-generic-program)
(error "No browser defined (`browse-url-generic-program')"))
(apply 'call-process browse-url-generic-program nil
(apply #'call-process browse-url-generic-program nil
0 nil
(append browse-url-generic-args (list url))))
@ -1742,9 +1742,9 @@ from `browse-url-elinks-wrapper'."
(defvar browse-url-button-map
(let ((map (make-sparse-keymap)))
(define-key map "\r" 'browse-url-button-open)
(define-key map [mouse-2] 'browse-url-button-open)
(define-key map "w" 'browse-url-button-copy)
(define-key map "\r" #'browse-url-button-open)
(define-key map [mouse-2] #'browse-url-button-open)
(define-key map "w" #'browse-url-button-copy)
map)
"The keymap used for browse-url buttons.")

67
lisp/net/dictionary.el
View File

@ -76,7 +76,7 @@ You can specify here:
- dict.org: Only use dict.org
- User-defined: You can specify your own server here"
:group 'dictionary
:set 'dictionary-set-server-var
:set #'dictionary-set-server-var
:type '(choice (const :tag "Automatic" nil)
(const :tag "localhost" "localhost")
(const :tag "dict.org" "dict.org")
@ -88,7 +88,7 @@ You can specify here:
"The port of the dictionary server.
This port is propably always 2628 so there should be no need to modify it."
:group 'dictionary
:set 'dictionary-set-server-var
:set #'dictionary-set-server-var
:type 'number
:version "28.1")
@ -189,7 +189,7 @@ where the current word was found."
nil
"Connects via a HTTP proxy using the CONNECT command when not nil."
:group 'dictionary-proxy
:set 'dictionary-set-server-var
:set #'dictionary-set-server-var
:type 'boolean
:version "28.1")
@ -197,7 +197,7 @@ where the current word was found."
"proxy"
"The name of the HTTP proxy to use when `dictionary-use-http-proxy' is set."
:group 'dictionary-proxy
:set 'dictionary-set-server-var
:set #'dictionary-set-server-var
:type 'string
:version "28.1")
@ -205,7 +205,7 @@ where the current word was found."
3128
"The port of the proxy server, used only when `dictionary-use-http-proxy' is set."
:group 'dictionary-proxy
:set 'dictionary-set-server-var
:set #'dictionary-set-server-var
:type 'number
:version "28.1")
@ -331,19 +331,19 @@ is utf-8"
(suppress-keymap map)
(set-keymap-parent map button-buffer-map)
(define-key map "q" 'dictionary-close)
(define-key map "h" 'dictionary-help)
(define-key map "s" 'dictionary-search)
(define-key map "d" 'dictionary-lookup-definition)
(define-key map "D" 'dictionary-select-dictionary)
(define-key map "M" 'dictionary-select-strategy)
(define-key map "m" 'dictionary-match-words)
(define-key map "l" 'dictionary-previous)
(define-key map "n" 'forward-button)
(define-key map "p" 'backward-button)
(define-key map " " 'scroll-up-command)
(define-key map [?\S-\ ] 'scroll-down-command)
(define-key map (read-kbd-macro "M-SPC") 'scroll-down-command)
(define-key map "q" #'dictionary-close)
(define-key map "h" #'dictionary-help)
(define-key map "s" #'dictionary-search)
(define-key map "d" #'dictionary-lookup-definition)
(define-key map "D" #'dictionary-select-dictionary)
(define-key map "M" #'dictionary-select-strategy)
(define-key map "m" #'dictionary-match-words)
(define-key map "l" #'dictionary-previous)
(define-key map "n" #'forward-button)
(define-key map "p" #'backward-button)
(define-key map " " #'scroll-up-command)
(define-key map [?\S-\ ] #'scroll-down-command)
(define-key map (read-kbd-macro "M-SPC") #'scroll-down-command)
map)
"Keymap for the dictionary mode.")
@ -413,7 +413,7 @@ This is a quick reference to this mode describing the default key bindings:
(make-local-variable 'dictionary-default-dictionary)
(make-local-variable 'dictionary-default-strategy)
(add-hook 'kill-buffer-hook 'dictionary-close t t)
(add-hook 'kill-buffer-hook #'dictionary-close t t)
(run-hooks 'dictionary-mode-hook))
;;;###autoload
@ -535,7 +535,7 @@ The connection takes the proxy setting in customization group
;; Dealing with closing the buffer
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun dictionary-close (&rest ignored)
(defun dictionary-close (&rest _ignored)
"Close the current dictionary buffer and its connection."
(interactive)
(if (eq major-mode 'dictionary-mode)
@ -669,7 +669,7 @@ previous state."
(setq dictionary-positions (cons (point) (window-start))))
;; Restore the previous state
(defun dictionary-restore-state (&rest ignored)
(defun dictionary-restore-state (&rest _ignored)
"Restore the state just before the last operation."
(let ((position (pop dictionary-position-stack))
(data (pop dictionary-data-stack)))
@ -872,7 +872,7 @@ The word is taken from the buffer, the DICTIONARY is given as argument."
'help-echo (concat "Press Mouse-2 to lookup \""
word "\" in \"" dictionary "\"")))))
(defun dictionary-select-dictionary (&rest ignored)
(defun dictionary-select-dictionary (&rest _ignored)
"Save the current state and start a dictionary selection."
(interactive)
(dictionary-ensure-buffer)
@ -880,7 +880,7 @@ The word is taken from the buffer, the DICTIONARY is given as argument."
(dictionary-do-select-dictionary)
(dictionary-store-state 'dictionary-do-select-dictionary nil))
(defun dictionary-do-select-dictionary (&rest ignored)
(defun dictionary-do-select-dictionary (&rest _ignored)
"The workhorse for doing the dictionary selection."
(message "Looking up databases and descriptions")
@ -916,7 +916,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
(dictionary-display-dictionary-line "! \"The first matching dictionary\"")
(let* ((reply (dictionary-read-answer))
(list (dictionary-simple-split-string reply "\n+")))
(mapc 'dictionary-display-dictionary-line list))
(mapc #'dictionary-display-dictionary-line list))
(dictionary-post-buffer))
(defun dictionary-display-dictionary-line (string)
@ -984,7 +984,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
(dictionary-store-state 'dictionary-display-more-info dictionary))))
(defun dictionary-select-strategy (&rest ignored)
(defun dictionary-select-strategy (&rest _ignored)
"Save the current state and start a strategy selection."
(interactive)
(dictionary-ensure-buffer)
@ -1014,7 +1014,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
(dictionary-display-strategy-line ". \"The servers default\"")
(let* ((reply (dictionary-read-answer))
(list (dictionary-simple-split-string reply "\n+")))
(mapc 'dictionary-display-strategy-line list))
(mapc #'dictionary-display-strategy-line list))
(dictionary-post-buffer))
(defun dictionary-display-strategy-line (string)
@ -1030,7 +1030,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
'help-echo (purecopy "Mouse-2 to select this matching algorithm"))
(insert "\n")))))
(defun dictionary-set-strategy (strategy &rest ignored)
(defun dictionary-set-strategy (strategy &rest _ignored)
"Select this STRATEGY as new default."
(setq dictionary-default-strategy strategy)
(dictionary-restore-state)
@ -1194,7 +1194,7 @@ allows editing it."
(describe-function 'dictionary-mode))
;;;###autoload
(defun dictionary-match-words (&optional pattern &rest ignored)
(defun dictionary-match-words (&optional pattern &rest _ignored)
"Search PATTERN in current default dictionary using default strategy."
(interactive)
;; can't use interactive because of mouse events
@ -1270,7 +1270,7 @@ allows editing it."
(defun dictionary-read-definition (&ignore)
(let ((list (dictionary-simple-split-string (dictionary-read-answer) "\n+")))
(mapconcat 'identity (cdr list) "\n")))
(mapconcat #'identity (cdr list) "\n")))
;;; Tooltip support for GNU Emacs
(defvar global-dictionary-tooltip-mode
@ -1322,8 +1322,8 @@ will be set to nil."
(interactive)
(tooltip-mode on)
(if on
(add-hook 'tooltip-functions 'dictionary-display-tooltip)
(remove-hook 'tooltip-functions 'dictionary-display-tooltip)))
(add-hook 'tooltip-functions #'dictionary-display-tooltip)
(remove-hook 'tooltip-functions #'dictionary-display-tooltip)))
;;;###autoload
(defun dictionary-tooltip-mode (&optional arg)
@ -1364,9 +1364,8 @@ any buffer where (dictionary-tooltip-mode 1) has been called."
(make-local-variable 'dictionary-tooltip-mouse-event)
(setq-default track-mouse on)
(dictionary-switch-tooltip-mode 1)
(if on
(global-set-key [mouse-movement] 'dictionary-tooltip-track-mouse)
(global-set-key [mouse-movement] 'ignore))
(global-set-key [mouse-movement]
(if on #'dictionary-tooltip-track-mouse #'ignore))
on))
(provide 'dictionary)

4
lisp/net/dig.el
View File

@ -79,7 +79,7 @@ and is a commonly available debugging tool."
(push domain cmdline)
(if server (push (concat "@" server) cmdline)
(if dig-dns-server (push (concat "@" dig-dns-server) cmdline)))
(apply 'call-process dig-program nil buf nil cmdline)
(apply #'call-process dig-program nil buf nil cmdline)
buf))
(defun dig-extract-rr (domain &optional type class)
@ -120,7 +120,7 @@ Buffer should contain output generated by `dig-invoke'."
(defvar dig-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "g" nil)
(define-key map "q" 'dig-exit)
(define-key map "q" #'dig-exit)
map))
(define-derived-mode dig-mode special-mode "Dig"

8
lisp/net/dns.el
View File

@ -135,8 +135,8 @@ updated. Set this variable to t to disable the check.")
(if (stringp ended)
(if (null name)
ended
(concat (mapconcat 'identity (nreverse name) ".") "." ended))
(mapconcat 'identity (nreverse name) "."))))
(concat (mapconcat #'identity (nreverse name) ".") "." ended))
(mapconcat #'identity (nreverse name) "."))))
(defun dns-write (spec &optional tcp-p)
"Write a DNS packet according to SPEC.
@ -283,7 +283,7 @@ If TCP-P, the first two bytes of the packet will be the length field."
(let ((bytes nil))
(dotimes (_ 4)
(push (dns-read-bytes 1) bytes))
(mapconcat 'number-to-string (nreverse bytes) ".")))
(mapconcat #'number-to-string (nreverse bytes) ".")))
((eq type 'AAAA)
(let (hextets)
(dotimes (_ 8)
@ -386,7 +386,7 @@ If REVERSE, look up an IP address."
(when reverse
(setq name (concat
(mapconcat 'identity (nreverse (split-string name "\\.")) ".")
(mapconcat #'identity (nreverse (split-string name "\\.")) ".")
".in-addr.arpa")
type 'PTR))

20
lisp/net/eudc-bob.el
View File

@ -41,38 +41,38 @@
(defvar eudc-bob-generic-keymap
(let ((map (make-sparse-keymap)))
(define-key map "s" 'eudc-bob-save-object)
(define-key map "!" 'eudc-bob-pipe-object-to-external-program)
(define-key map [down-mouse-3] 'eudc-bob-popup-menu)
(define-key map "s" #'eudc-bob-save-object)
(define-key map "!" #'eudc-bob-pipe-object-to-external-program)
(define-key map [down-mouse-3] #'eudc-bob-popup-menu)
map)
"Keymap for multimedia objects.")
(defvar eudc-bob-image-keymap
(let ((map (make-sparse-keymap)))
(set-keymap-parent map eudc-bob-generic-keymap)
(define-key map "t" 'eudc-bob-toggle-inline-display)
(define-key map "t" #'eudc-bob-toggle-inline-display)
map)
"Keymap for inline images.")
(defvar eudc-bob-sound-keymap
(let ((map (make-sparse-keymap)))
(set-keymap-parent map eudc-bob-generic-keymap)
(define-key map (kbd "RET") 'eudc-bob-play-sound-at-point)
(define-key map [down-mouse-2] 'eudc-bob-play-sound-at-mouse)
(define-key map (kbd "RET") #'eudc-bob-play-sound-at-point)
(define-key map [down-mouse-2] #'eudc-bob-play-sound-at-mouse)
map)
"Keymap for inline sounds.")
(defvar eudc-bob-url-keymap
(let ((map (make-sparse-keymap)))
(define-key map (kbd "RET") 'browse-url-at-point)
(define-key map [down-mouse-2] 'browse-url-at-mouse)
(define-key map (kbd "RET") #'browse-url-at-point)
(define-key map [down-mouse-2] #'browse-url-at-mouse)
map)
"Keymap for inline urls.")
(defvar eudc-bob-mail-keymap
(let ((map (make-sparse-keymap)))
(define-key map (kbd "RET") 'goto-address-at-point)
(define-key map [down-mouse-2] 'goto-address-at-point)
(define-key map (kbd "RET") #'goto-address-at-point)
(define-key map [down-mouse-2] #'goto-address-at-point)
map)
"Keymap for inline e-mail addresses.")

78
lisp/net/eudc-export.el
View File

@ -1,4 +1,4 @@
;;; eudc-export.el --- functions to export EUDC query results
;;; eudc-export.el --- functions to export EUDC query results -*- lexical-binding: t; -*-
;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
@ -35,6 +35,7 @@
;; NOERROR is so we can compile it.
(require 'bbdb nil t)
(require 'bbdb-com nil t)
(require 'cl-lib)
(defun eudc-create-bbdb-record (record &optional silent)
"Create a BBDB record using the RECORD alist.
@ -42,24 +43,22 @@ RECORD is an alist of (KEY . VALUE) where KEY is a directory attribute name
symbol and VALUE is the corresponding value for the record.
If SILENT is non-nil then the created BBDB record is not displayed."
(require 'bbdb)
(declare-function bbdb-create-internal "bbdb-com" (&rest spec))
(declare-function bbdb-display-records "bbdb"
(records &optional layout append))
;; This function runs in a special context where lisp symbols corresponding
;; to field names in record are bound to the corresponding values
(eval
`(let* (,@(mapcar (lambda (c)
(list (car c) (if (listp (cdr c))
(list 'quote (cdr c))
(cdr c))))
record)
bbdb-name
bbdb-company
bbdb-net
bbdb-address
bbdb-phones
bbdb-notes
spec
bbdb-record
value
(conversion-alist (symbol-value eudc-bbdb-conversion-alist)))
(cl-progv (mapcar #'car record) (mapcar #'cdr record)
(let* (bbdb-name
bbdb-company
bbdb-net
bbdb-address
bbdb-phones
bbdb-notes
spec
bbdb-record
value
(conversion-alist (symbol-value eudc-bbdb-conversion-alist)))
;; BBDB standard fields
(setq bbdb-name (eudc-parse-spec (cdr (assq 'name conversion-alist)) record nil)
@ -68,14 +67,14 @@ If SILENT is non-nil then the created BBDB record is not displayed."
bbdb-notes (eudc-parse-spec (cdr (assq 'notes conversion-alist)) record nil))
(setq spec (cdr (assq 'address conversion-alist)))
(setq bbdb-address (delq nil (eudc-parse-spec (if (listp (car spec))
spec
(list spec))
record t)))
spec
(list spec))
record t)))
(setq spec (cdr (assq 'phone conversion-alist)))
(setq bbdb-phones (delq nil (eudc-parse-spec (if (listp (car spec))
spec
(list spec))
record t)))
spec
(list spec))
record t)))
;; BBDB custom fields
(setq bbdb-notes (append (list (and bbdb-notes (cons 'notes bbdb-notes)))
(mapcar (lambda (mapping)
@ -85,19 +84,20 @@ If SILENT is non-nil then the created BBDB record is not displayed."
(cons (car mapping) value)))
conversion-alist)))
(setq bbdb-notes (delq nil bbdb-notes))
(setq bbdb-record (bbdb-create-internal
bbdb-name
,@(when (eudc--using-bbdb-3-or-newer-p)
'(nil
nil))
bbdb-company
bbdb-net
,@(if (eudc--using-bbdb-3-or-newer-p)
'(bbdb-phones
bbdb-address)
'(bbdb-address
bbdb-phones))
bbdb-notes))
(setq bbdb-record
(apply #'bbdb-create-internal
`(,bbdb-name
,@(when (eudc--using-bbdb-3-or-newer-p)
'(nil
nil))
,bbdb-company
,bbdb-net
,@(if (eudc--using-bbdb-3-or-newer-p)
(list bbdb-phones
bbdb-address)
(list bbdb-address
bbdb-phones))
,bbdb-notes)))
(or silent
(bbdb-display-records (list bbdb-record))))))
@ -111,7 +111,7 @@ If RECURSE is non-nil then SPEC may be a list of atomic specs."
(symbolp (car spec))
(fboundp (car spec))))
(condition-case nil
(eval spec)
(eval spec t)
(void-variable nil)))
((and recurse
(listp spec))
@ -194,9 +194,9 @@ LOCATION is used as the phone location for BBDB."
(signal (car err) (cdr err)))))
(if (= 3 (length phone-list))
(setq phone-list (append phone-list '(nil))))
(apply 'vector location phone-list)))
(apply #'vector location phone-list)))
((listp phone)
(vector location (mapconcat 'identity phone ", ")))
(vector location (mapconcat #'identity phone ", ")))
(t
(error "Invalid phone specification"))))

14
lisp/net/eudc-hotlist.el
View File

@ -1,4 +1,4 @@
;;; eudc-hotlist.el --- hotlist management for EUDC
;;; eudc-hotlist.el --- hotlist management for EUDC -*- lexical-binding: t; -*-
;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
@ -37,12 +37,12 @@
(defvar eudc-hotlist-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "a" 'eudc-hotlist-add-server)
(define-key map "d" 'eudc-hotlist-delete-server)
(define-key map "s" 'eudc-hotlist-select-server)
(define-key map "t" 'eudc-hotlist-transpose-servers)
(define-key map "q" 'eudc-hotlist-quit-edit)
(define-key map "x" 'kill-current-buffer)
(define-key map "a" #'eudc-hotlist-add-server)
(define-key map "d" #'eudc-hotlist-delete-server)
(define-key map "s" #'eudc-hotlist-select-server)
(define-key map "t" #'eudc-hotlist-transpose-servers)
(define-key map "q" #'eudc-hotlist-quit-edit)
(define-key map "x" #'kill-current-buffer)
map))
(define-derived-mode eudc-hotlist-mode fundamental-mode "EUDC-Servers"

14
lisp/net/eudc.el
View File

@ -65,12 +65,12 @@
(defvar eudc-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map widget-keymap)
(define-key map "q" 'kill-current-buffer)
(define-key map "x" 'kill-current-buffer)
(define-key map "f" 'eudc-query-form)
(define-key map "b" 'eudc-try-bbdb-insert)
(define-key map "n" 'eudc-move-to-next-record)
(define-key map "p" 'eudc-move-to-previous-record)
(define-key map "q" #'kill-current-buffer)
(define-key map "x" #'kill-current-buffer)
(define-key map "f" #'eudc-query-form)
(define-key map "b" #'eudc-try-bbdb-insert)
(define-key map "n" #'eudc-move-to-next-record)
(define-key map "p" #'eudc-move-to-previous-record)
map))
(defvar mode-popup-menu)
@ -407,7 +407,7 @@ if any, is called to print the value in cdr of FIELD."
(val (cdr field)))
(if match
(progn
(eval (list (cdr match) val))
(funcall (cdr match) val)
(insert "\n"))
(mapc
(lambda (val-elem)

125
lisp/net/eudcb-bbdb.el
View File

@ -1,4 +1,4 @@
;;; eudcb-bbdb.el --- Emacs Unified Directory Client - BBDB Backend
;;; eudcb-bbdb.el --- Emacs Unified Directory Client - BBDB Backend -*- lexical-binding: t; -*-
;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
@ -34,6 +34,7 @@
;; Make it loadable on systems without bbdb.
(require 'bbdb nil t)
(require 'bbdb-com nil t)
(require 'seq)
;;{{{ Internal cooking
@ -87,33 +88,30 @@ BBDB < 3 used `net'; BBDB >= 3 uses `mail'."
"Return RECORD if it matches `eudc-bbdb-current-query', nil otherwise."
(require 'bbdb)
(catch 'unmatch
(progn
(dolist (condition eudc-bbdb-current-query)
(let ((attr (car condition))
(val (cdr condition))
(case-fold-search t)
bbdb-val)
(or (and (memq attr '(firstname lastname aka company phones
addresses net))
(progn
(setq bbdb-val
(eval (list (intern (concat "bbdb-record-"
(symbol-name
(eudc-bbdb-field
attr))))
'record)))
(if (listp bbdb-val)
(if eudc-bbdb-enable-substring-matches
(eval `(or ,@(mapcar (lambda (subval)
(string-match val subval))
bbdb-val)))
(member (downcase val)
(mapcar 'downcase bbdb-val)))
(dolist (condition eudc-bbdb-current-query)
(let ((attr (car condition))
(val (cdr condition))
(case-fold-search t))
(or (and (memq attr '(firstname lastname aka company phones
addresses net))
(let ((bbdb-val
(funcall (intern (concat "bbdb-record-"
(symbol-name
(eudc-bbdb-field
attr))))
record)))
(if (listp bbdb-val)
(if eudc-bbdb-enable-substring-matches
(string-match val bbdb-val)
(string-equal (downcase val) (downcase bbdb-val))))))
(throw 'unmatch nil))))
record)))
(seq-some (lambda (subval)
(string-match val subval))
bbdb-val)
(member (downcase val)
(mapcar #'downcase bbdb-val)))
(if eudc-bbdb-enable-substring-matches
(string-match val bbdb-val)
(string-equal (downcase val) (downcase bbdb-val))))))
(throw 'unmatch nil))))
record))
;; External.
(declare-function bbdb-phone-location "ext:bbdb" t) ; via bbdb-defstruct
@ -182,40 +180,34 @@ The record is filtered according to `eudc-bbdb-current-return-attributes'."
(require 'bbdb)
(let ((attrs (or eudc-bbdb-current-return-attributes
'(firstname lastname aka company phones addresses net notes)))
attr
eudc-rec
val)
(while (prog1
(setq attr (car attrs))
(setq attrs (cdr attrs)))
(cond
((eq attr 'phones)
(setq val (eudc-bbdb-extract-phones record)))
((eq attr 'addresses)
(setq val (eudc-bbdb-extract-addresses record)))
((eq attr 'notes)
(if (eudc--using-bbdb-3-or-newer-p)
(setq val (bbdb-record-xfield record 'notes))
(setq val (bbdb-record-notes record))))
((memq attr '(firstname lastname aka company net))
(setq val (eval
(list (intern
(concat "bbdb-record-"
(symbol-name (eudc-bbdb-field attr))))
'record))))
(t
(error "Unknown BBDB attribute")))
(cond
((or (not val) (equal val ""))) ; do nothing
((memq attr '(phones addresses))
(setq eudc-rec (append val eudc-rec)))
((and (listp val)
(= 1 (length val)))
(setq eudc-rec (cons (cons attr (car val)) eudc-rec)))
((> (length val) 0)
(setq eudc-rec (cons (cons attr val) eudc-rec)))
(t
(error "Unexpected attribute value"))))
eudc-rec)
(dolist (attr attrs)
(let ((val
(pcase attr
('phones (eudc-bbdb-extract-phones record))
('addresses (eudc-bbdb-extract-addresses record))
('notes
(if (eudc--using-bbdb-3-or-newer-p)
(bbdb-record-xfield record 'notes)
(bbdb-record-notes record)))
((or 'firstname 'lastname 'aka 'company 'net)
(funcall (intern
(concat "bbdb-record-"
(symbol-name (eudc-bbdb-field attr))))
record))
(_
(error "Unknown BBDB attribute")))))
(cond
((or (not val) (equal val ""))) ; do nothing
((memq attr '(phones addresses))
(setq eudc-rec (append val eudc-rec)))
((and (listp val)
(= 1 (length val)))
(push (cons attr (car val)) eudc-rec))
((> (length val) 0)
(push (cons attr val) eudc-rec))
(t
(error "Unexpected attribute value")))))
(nreverse eudc-rec)))
@ -240,21 +232,20 @@ RETURN-ATTRS is a list of attributes to return, defaulting to
(while (and records (> (length query-attrs) 0))
(setq bbdb-attrs (append bbdb-attrs (list (car query-attrs))))
(if (car query-attrs)
(setq records (eval `(bbdb-search ,(quote records) ,@bbdb-attrs))))
;; BEWARE: `bbdb-search' is a macro!
(setq records (eval `(bbdb-search records ,@bbdb-attrs) t)))
(setq query-attrs (cdr query-attrs)))
(mapc (lambda (record)
(setq filtered (eudc-filter-duplicate-attributes record))
;; If there were duplicate attributes reverse the order of the
;; record so the unique attributes appear first
(if (> (length filtered) 1)
(setq filtered (mapcar (lambda (rec)
(reverse rec))
filtered)))
(setq filtered (mapcar #'reverse filtered)))
(setq result (append result filtered)))
(delq nil
(mapcar 'eudc-bbdb-format-record-as-result
(mapcar #'eudc-bbdb-format-record-as-result
(delq nil
(mapcar 'eudc-bbdb-filter-non-matching-record
(mapcar #'eudc-bbdb-filter-non-matching-record
records)))))
result))

18
lisp/net/eudcb-ldap.el
View File

@ -1,4 +1,4 @@
;;; eudcb-ldap.el --- Emacs Unified Directory Client - LDAP Backend
;;; eudcb-ldap.el --- Emacs Unified Directory Client - LDAP Backend -*- lexical-binding: t; -*-
;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
@ -38,10 +38,10 @@
;;{{{ Internal cooking
(eval-and-compile
(defalias 'eudc-ldap-get-host-parameter
(if (fboundp 'ldap-get-host-parameter)
(fset 'eudc-ldap-get-host-parameter 'ldap-get-host-parameter)
(defun eudc-ldap-get-host-parameter (host parameter)
#'ldap-get-host-parameter
(lambda (host parameter)
"Get the value of PARAMETER for HOST in `ldap-host-parameters-alist'."
(plist-get (cdr (assoc host ldap-host-parameters-alist))
parameter))))
@ -84,7 +84,7 @@
record))
(defun eudc-filter-$ (string)
(mapconcat 'identity (split-string string "\\$") "\n"))
(mapconcat #'identity (split-string string "\\$") "\n"))
(defun eudc-ldap-cleanup-record-filtering-addresses (record)
"Clean up RECORD to make it suitable for EUDC.
@ -104,7 +104,7 @@ multiple addresses."
(value (cdr field)))
(when (and clean-up-addresses
(memq name '(postaladdress registeredaddress)))
(setq value (mapcar 'eudc-filter-$ value)))
(setq value (mapcar #'eudc-filter-$ value)))
(if (eq name 'mail)
(setq mail-addresses (append mail-addresses value))
(push (cons name (if (cdr value)
@ -126,9 +126,9 @@ RETURN-ATTRS is a list of attributes to return, defaulting to
(let ((result (ldap-search (eudc-ldap-format-query-as-rfc1558 query)
eudc-server
(if (listp return-attrs)
(mapcar 'symbol-name return-attrs))))
(mapcar #'symbol-name return-attrs))))
final-result)
(setq result (mapcar 'eudc-ldap-cleanup-record-filtering-addresses result))
(setq result (mapcar #'eudc-ldap-cleanup-record-filtering-addresses result))
(if (and eudc-strict-return-matches
return-attrs
@ -154,7 +154,7 @@ attribute names are returned. Default to `person'."
(let ((ldap-host-parameters-alist
(list (cons eudc-server
'(scope subtree sizelimit 1)))))
(mapcar 'eudc-ldap-cleanup-record-filtering-addresses
(mapcar #'eudc-ldap-cleanup-record-filtering-addresses
(ldap-search
(eudc-ldap-format-query-as-rfc1558
(list (cons "objectclass"

2
lisp/net/eudcb-mab.el
View File

@ -1,4 +1,4 @@
;;; eudcb-mab.el --- Emacs Unified Directory Client - AddressBook backend
;;; eudcb-mab.el --- Emacs Unified Directory Client - AddressBook backend -*- lexical-binding: t; -*-
;; Copyright (C) 2003-2021 Free Software Foundation, Inc.

4
lisp/net/eudcb-macos-contacts.el
View File

@ -1,4 +1,4 @@
;;; eudcb-macos-contacts.el --- EUDC - macOS Contacts backend
;;; eudcb-macos-contacts.el --- EUDC - macOS Contacts backend -*- lexical-binding: t; -*-
;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
@ -74,7 +74,7 @@ end tell" str))
"`osascript' executable not found. "
"Is this is a macOS 10.0 or later system?"))))
(defun eudc-macos-contacts-query-internal (query &optional return-attrs)
(defun eudc-macos-contacts-query-internal (query &optional _return-attrs)
"Query macOS Contacts with QUERY.
QUERY is a list of cons cells (ATTR . VALUE) where ATTRs should be valid
macOS Contacts attribute names.

7
lisp/net/gnutls.el
View File

@ -1,4 +1,4 @@
;;; gnutls.el --- Support SSL/TLS connections through GnuTLS
;;; gnutls.el --- Support SSL/TLS connections through GnuTLS -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
@ -59,7 +59,6 @@ general, Emacs network security is handled by the Network
Security Manager (NSM), and the default value of nil delegates
the job of checking the connection security to the NSM.
See Info node `(emacs) Network Security'."
:group 'gnutls
:type '(choice (const nil)
string))
@ -91,7 +90,6 @@ checks are performed at the gnutls level. Instead the checks are
performed via `open-network-stream' at a higher level by the
Network Security Manager. See Info node `(emacs) Network
Security'."
:group 'gnutls
:version "24.4"
:type '(choice
(const t)
@ -118,7 +116,6 @@ Security'."
If a file path contains glob wildcards, they will be expanded.
The files may be in PEM or DER format, as per the GnuTLS documentation.
The files may not exist, in which case they will be ignored."
:group 'gnutls
:type '(choice (function :tag "Function to produce list of bundle filenames")
(repeat (file :tag "Bundle filename"))))
@ -139,7 +136,6 @@ network security is handled at a higher level via
node `(emacs) Network Security'."
:type '(choice (const :tag "Use default value" nil)
(integer :tag "Number of bits" 2048))
:group 'gnutls
:version "27.1")
(defcustom gnutls-crlfiles
@ -150,7 +146,6 @@ node `(emacs) Network Security'."
If a file path contains glob wildcards, they will be expanded.
The files may be in PEM or DER format, as per the GnuTLS documentation.
The files may not exist, in which case they will be ignored."
:group 'gnutls
:type '(choice (function :tag "Function to produce list of CRL filenames")
(repeat (file :tag "CRL filename")))
:version "27.1")

28
lisp/net/goto-addr.el
View File

@ -1,4 +1,4 @@
;;; goto-addr.el --- click to browse URL or to send to e-mail address
;;; goto-addr.el --- click to browse URL or to send to e-mail address -*- lexical-binding: t; -*-
;; Copyright (C) 1995, 2000-2021 Free Software Foundation, Inc.
@ -73,19 +73,16 @@
(defcustom goto-address-fontify-p t
"Non-nil means URLs and e-mail addresses in buffer are fontified.
But only if `goto-address-highlight-p' is also non-nil."
:type 'boolean
:group 'goto-address)
:type 'boolean)
(defcustom goto-address-highlight-p t
"Non-nil means URLs and e-mail addresses in buffer are highlighted."
:type 'boolean
:group 'goto-address)
:type 'boolean)
(defcustom goto-address-fontify-maximum-size 30000
"Maximum size of file in which to fontify and/or highlight URLs.
A value of t means there is no limit--fontify regardless of the size."
:type '(choice (integer :tag "Maximum size") (const :tag "No limit" t))
:group 'goto-address)
:type '(choice (integer :tag "Maximum size") (const :tag "No limit" t)))
(defvar goto-address-mail-regexp
;; Actually pretty much any char could appear in the username part. -stef
@ -122,30 +119,26 @@ will have no effect.")
(defvar goto-address-highlight-keymap
(let ((m (make-sparse-keymap)))
(define-key m (kbd "<mouse-2>") 'goto-address-at-point)
(define-key m (kbd "C-c RET") 'goto-address-at-point)
(define-key m (kbd "<mouse-2>") #'goto-address-at-point)
(define-key m (kbd "C-c RET") #'goto-address-at-point)
m)
"Keymap to hold goto-addr's mouse key defs under highlighted URLs.")
(defcustom goto-address-url-face 'link
"Face to use for URLs."
:type 'face
:group 'goto-address)
:type 'face)
(defcustom goto-address-url-mouse-face 'highlight
"Face to use for URLs when the mouse is on them."
:type 'face
:group 'goto-address)
:type 'face)
(defcustom goto-address-mail-face 'italic
"Face to use for e-mail addresses."
:type 'face
:group 'goto-address)
:type 'face)
(defcustom goto-address-mail-mouse-face 'secondary-selection
"Face to use for e-mail addresses when the mouse is on them."
:type 'face
:group 'goto-address)
:type 'face)
(defun goto-address-unfontify (start end)
"Remove `goto-address' fontification from the given region."
@ -287,7 +280,6 @@ Also fontifies the buffer appropriately (see `goto-address-fontify-p' and
;;;###autoload
(define-globalized-minor-mode global-goto-address-mode
goto-address-mode goto-addr-mode--turn-on
:group 'goto-address
:version "28.1")
;;;###autoload

84
lisp/net/net-utils.el
View File

@ -1,4 +1,4 @@
;;; net-utils.el --- network functions
;;; net-utils.el --- network functions -*- lexical-binding: t; -*-
;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
@ -67,17 +67,14 @@
"tracert"
"traceroute")
"Program to trace network hops to a destination."
:group 'net-utils
:type 'string)
(defcustom traceroute-program-options nil
"Options for the traceroute program."
:group 'net-utils
:type '(repeat string))
(defcustom ping-program "ping"
"Program to send network test packets to a host."
:group 'net-utils
:type 'string)
;; On GNU/Linux and Irix, the system's ping program seems to send packets
@ -87,7 +84,6 @@
(list "-c" "4"))
"Options for the ping program.
These options can be used to limit how many ICMP packets are emitted."
:group 'net-utils
:type '(repeat string))
(defcustom ifconfig-program
@ -98,7 +94,6 @@ These options can be used to limit how many ICMP packets are emitted."
(t "ip"))
"Program to print network configuration information."
:version "25.1" ; add ip
:group 'net-utils
:type 'string)
(defcustom ifconfig-program-options
@ -108,7 +103,6 @@ These options can be used to limit how many ICMP packets are emitted."
"Options for the ifconfig program."
:version "25.1"
:set-after '(ifconfig-program)
:group 'net-utils
:type '(repeat string))
(defcustom iwconfig-program
@ -116,7 +110,6 @@ These options can be used to limit how many ICMP packets are emitted."
((net-utils--executable-find-sbin "iw") "iw")
(t "iw"))
"Program to print wireless network configuration information."
:group 'net-utils
:type 'string
:version "26.1")
@ -124,7 +117,6 @@ These options can be used to limit how many ICMP packets are emitted."
(cond ((string-match-p "iw\\'" iwconfig-program) (list "dev"))
(t nil))
"Options for the iwconfig program."
:group 'net-utils
:type '(repeat string)
:version "26.1")
@ -133,25 +125,21 @@ These options can be used to limit how many ICMP packets are emitted."
((net-utils--executable-find-sbin "ss"))
(t "ss"))
"Program to print network statistics."
:group 'net-utils
:type 'string
:version "26.1")
(defcustom netstat-program-options
(list "-a")
"Options for the netstat program."
:group 'net-utils
:type '(repeat string))
(defcustom arp-program (or (net-utils--executable-find-sbin "arp") "arp")
"Program to print IP to address translation tables."
:group 'net-utils
:type 'string)
(defcustom arp-program-options
(list "-a")
"Options for the arp program."
:group 'net-utils
:type '(repeat string))
(defcustom route-program
@ -162,7 +150,6 @@ These options can be used to limit how many ICMP packets are emitted."
((net-utils--executable-find-sbin "ip"))
(t "ip"))
"Program to print routing tables."
:group 'net-utils
:type 'string
:version "26.1")
@ -171,18 +158,15 @@ These options can be used to limit how many ICMP packets are emitted."
((string-match-p "netstat\\'" route-program) (list "-r"))
(t (list "route")))
"Options for the route program."
:group 'net-utils
:type '(repeat string)
:version "26.1")
(defcustom nslookup-program "nslookup"
"Program to interactively query DNS information."
:group 'net-utils
:type 'string)
(defcustom nslookup-program-options nil
"Options for the nslookup program."
:group 'net-utils
:type '(repeat string))
(defcustom nslookup-prompt-regexp "^> "
@ -190,28 +174,23 @@ These options can be used to limit how many ICMP packets are emitted."
This variable is only used if the variable
`comint-use-prompt-regexp' is non-nil."
:group 'net-utils
:type 'regexp)
(defcustom dig-program "dig"
"Program to query DNS information."
:group 'net-utils
:type 'string)
(defcustom dig-program-options nil
"Options for the dig program."
:group 'net-utils
:type '(repeat string)
:version "26.1")
(defcustom ftp-program "ftp"
"Program to run to do FTP transfers."
:group 'net-utils
:type 'string)
(defcustom ftp-program-options nil
"Options for the ftp program."
:group 'net-utils
:type '(repeat string))
(defcustom ftp-prompt-regexp "^ftp>"
@ -219,17 +198,14 @@ This variable is only used if the variable
This variable is only used if the variable
`comint-use-prompt-regexp' is non-nil."
:group 'net-utils
:type 'regexp)
(defcustom smbclient-program "smbclient"
"Smbclient program."
:group 'net-utils
:type 'string)
(defcustom smbclient-program-options nil
"Options for the smbclient program."
:group 'net-utils
:type '(repeat string))
(defcustom smbclient-prompt-regexp "^smb: >"
@ -237,17 +213,14 @@ This variable is only used if the variable
This variable is only used if the variable
`comint-use-prompt-regexp' is non-nil."
:group 'net-utils
:type 'regexp)
(defcustom dns-lookup-program "host"
"Program to interactively query DNS information."
:group 'net-utils
:type 'string)
(defcustom dns-lookup-program-options nil
"Options for the dns-lookup program."
:group 'net-utils
:type '(repeat string))
;; Internal variables
@ -265,7 +238,7 @@ This variable is only used if the variable
1 'font-lock-keyword-face)
;; Dotted quads
(list
(mapconcat 'identity
(mapconcat #'identity
(make-list 4 "[0-9]+")
"\\.")
0 'font-lock-variable-name-face)
@ -273,7 +246,7 @@ This variable is only used if the variable
(list
(let ((host-expression "[-A-Za-z0-9]+"))
(concat
(mapconcat 'identity
(mapconcat #'identity
(make-list 2 host-expression)
"\\.")
"\\(\\." host-expression "\\)*"))
@ -288,7 +261,7 @@ This variable is only used if the variable
(list
;; Dotted quads
(list
(mapconcat 'identity (make-list 4 "[0-9]+") "\\.")
(mapconcat #'identity (make-list 4 "[0-9]+") "\\.")
0 'font-lock-variable-name-face)
;; Simple rfc4291 addresses
(list (concat
@ -300,7 +273,7 @@ This variable is only used if the variable
(list
(let ((host-expression "[-A-Za-z0-9]+"))
(concat
(mapconcat 'identity (make-list 2 host-expression) "\\.")
(mapconcat #'identity (make-list 2 host-expression) "\\.")
"\\(\\." host-expression "\\)*"))
0 'font-lock-variable-name-face))
"Expressions to font-lock for general network utilities.")
@ -371,8 +344,8 @@ This variable is only used if the variable
(erase-buffer)
(insert header "\n")
(set-process-filter
(apply 'start-process name buf program args)
'net-utils-remove-ctrl-m-filter)
(apply #'start-process name buf program args)
#'net-utils-remove-ctrl-m-filter)
(display-buffer buf)
buf))
@ -405,12 +378,12 @@ This variable is only used if the variable
`(net-utils-run-simple ,(current-buffer)
,program-name ,args nodisplay))
(set-process-filter
(apply 'start-process program-name
(current-buffer) program-name args)
'net-utils-remove-ctrl-m-filter)
(apply #'start-process program-name
(current-buffer) program-name args)
#'net-utils-remove-ctrl-m-filter)
(unless nodisplay (display-buffer (current-buffer)))))
(defun net-utils--revert-function (&optional ignore-auto noconfirm)
(defun net-utils--revert-function (&optional _ignore-auto _noconfirm)
(message "Reverting `%s'..." (buffer-name))
(apply (car net-utils--revert-cmd) (cdr net-utils--revert-cmd))
(let ((proc (get-buffer-process (current-buffer))))
@ -430,7 +403,7 @@ This variable is only used if the variable
ifconfig-program
ifconfig-program-options))
(defalias 'ipconfig 'ifconfig)
(defalias 'ipconfig #'ifconfig)
;;;###autoload
(defun iwconfig ()
@ -532,7 +505,7 @@ in Lisp code."
(net-utils-run-program
"Nslookup"
(concat "** "
(mapconcat 'identity
(mapconcat #'identity
(list "Nslookup" host nslookup-program)
" ** "))
nslookup-program
@ -618,7 +591,7 @@ This command uses `nslookup-program' to look up DNS records."
(defvar nslookup-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\t" 'completion-at-point)
(define-key map "\t" #'completion-at-point)
map))
;; Using a derived mode gives us keymaps, hooks, etc.
@ -646,9 +619,9 @@ This command uses `dns-lookup-program' for looking up the DNS information."
(net-utils-run-program
(concat "DNS Lookup [" host "]")
(concat "** "
(mapconcat 'identity
(list "DNS Lookup" host dns-lookup-program)
" ** "))
(mapconcat #'identity
(list "DNS Lookup" host dns-lookup-program)
" ** "))
dns-lookup-program
options)))
@ -669,13 +642,14 @@ This command uses `dig-program' for looking up the DNS information."
(net-utils-run-program
"Dig"
(concat "** "
(mapconcat 'identity
(mapconcat #'identity
(list "Dig" host dig-program)
" ** "))
dig-program
options)))
(autoload 'comint-exec "comint")
(declare-function comint-watch-for-password-prompt "comint" (string))
;; This is a lot less than ange-ftp, but much simpler.
;;;###autoload
@ -697,7 +671,7 @@ This command uses `dig-program' for looking up the DNS information."
(defvar ftp-mode-map
(let ((map (make-sparse-keymap)))
;; Occasionally useful
(define-key map "\t" 'completion-at-point)
(define-key map "\t" #'completion-at-point)
map))
(define-derived-mode ftp-mode comint-mode "FTP"
@ -710,9 +684,9 @@ This command uses `dig-program' for looking up the DNS information."
;; password prompts will probably immediately follow the initial
;; connection), but it's better than getting prompted twice for the
;; same password.
(unless (memq 'comint-watch-for-password-prompt
(unless (memq #'comint-watch-for-password-prompt
(default-value 'comint-output-filter-functions))
(add-hook 'comint-output-filter-functions 'comint-watch-for-password-prompt
(add-hook 'comint-output-filter-functions #'comint-watch-for-password-prompt
nil t)))
(defun smbclient (host service)
@ -759,9 +733,9 @@ This command uses `smbclient-program' to connect to HOST."
;; password prompts will probably immediately follow the initial
;; connection), but it's better than getting prompted twice for the
;; same password.
(unless (memq 'comint-watch-for-password-prompt
(unless (memq #'comint-watch-for-password-prompt
(default-value 'comint-output-filter-functions))
(add-hook 'comint-output-filter-functions 'comint-watch-for-password-prompt
(add-hook 'comint-output-filter-functions #'comint-watch-for-password-prompt
nil t)))
@ -810,7 +784,7 @@ This list is not complete.")
(error "Could not open connection to %s" host))
(erase-buffer)
(set-marker (process-mark tcp-connection) (point-min))
(set-process-filter tcp-connection 'net-utils-remove-ctrl-m-filter)
(set-process-filter tcp-connection #'net-utils-remove-ctrl-m-filter)
(and initial-string
(process-send-string tcp-connection
(concat initial-string "\r\n")))
@ -825,7 +799,6 @@ This list is not complete.")
If a host name passed to `finger' matches one of these regular
expressions, it is assumed to be a host that doesn't accept
queries of the form USER@HOST, and wants a query containing USER only."
:group 'net-utils
:type '(repeat regexp)
:version "21.1")
@ -852,7 +825,7 @@ and `network-connection-service-alist', which see."
(let* ((user-and-host (concat user "@" host))
(process-name (concat "Finger [" user-and-host "]"))
(regexps finger-X.500-host-regexps)
found)
) ;; found
(and regexps
(while (not (string-match (car regexps) host))
(setq regexps (cdr regexps)))
@ -866,7 +839,6 @@ and `network-connection-service-alist', which see."
(defcustom whois-server-name "rs.internic.net"
"Default host name for the whois service."
:group 'net-utils
:type 'string)
(defcustom whois-server-list
@ -880,7 +852,6 @@ and `network-connection-service-alist', which see."
("whois.nic.gov")
("whois.ripe.net"))
"A list of whois servers that can be queried."
:group 'net-utils
:type '(repeat (list string)))
;; FIXME: modern whois clients include a much better tld <-> whois server
@ -903,14 +874,12 @@ and `network-connection-service-alist', which see."
("whois.nic.gov" . "gov")
("whois.nic.mil" . "mil"))
"Alist to map top level domains to whois servers."
:group 'net-utils
:type '(repeat (cons string string)))
(defcustom whois-guess-server t
"If non-nil then whois will try to deduce the appropriate whois
server from the query. If the query doesn't look like a domain or hostname
then the server named by `whois-server-name' is used."
:group 'net-utils
:type 'boolean)
(defun whois-get-tld (host)
@ -951,7 +920,6 @@ The port is deduced from `network-connection-service-alist'."
(defcustom whois-reverse-lookup-server "whois.arin.net"
"Server which provides inverse DNS mapping."
:group 'net-utils
:type 'string)
;;;###autoload

3
lisp/net/network-stream.el
View File

@ -248,8 +248,7 @@ gnutls-boot (as returned by `gnutls-boot-parameters')."
(list key cert)))))))
;;;###autoload
(defalias 'open-protocol-stream 'open-network-stream)
(define-obsolete-function-alias 'open-protocol-stream 'open-network-stream
(define-obsolete-function-alias 'open-protocol-stream #'open-network-stream
"26.1")
(defun network-stream-open-plain (name buffer host service parameters)

32
lisp/net/newst-backend.el
View File

@ -163,7 +163,7 @@ These were mostly extracted from the Radio Community Server
You may add other entries in `newsticker-url-list'."
:type `(set ,@(mapcar #'newsticker--splicer
newsticker--raw-url-list-defaults))
:set 'newsticker--set-customvar-retrieval
:set #'newsticker--set-customvar-retrieval
:group 'newsticker-retrieval)
(defcustom newsticker-url-list nil
@ -217,7 +217,7 @@ which apply for this feed only, overriding the value of
(choice :tag "Wget Arguments"
(const :tag "Default arguments" nil)
(repeat :tag "Special arguments" string))))
:set 'newsticker--set-customvar-retrieval
:set #'newsticker--set-customvar-retrieval
:group 'newsticker-retrieval)
(defcustom newsticker-retrieval-method
@ -260,7 +260,7 @@ make it less than 1800 seconds (30 minutes)!"
(const :tag "Daily" 86400)
(const :tag "Weekly" 604800)
(integer :tag "Interval"))
:set 'newsticker--set-customvar-retrieval
:set #'newsticker--set-customvar-retrieval
:group 'newsticker-retrieval)
(defcustom newsticker-desc-comp-max
@ -549,7 +549,7 @@ name/timer pair to `newsticker--retrieval-timer-list'."
(if (<= interval 0)
(setq interval nil))
(setq timer (run-at-time start-time interval
'newsticker-get-news feed-name))
#'newsticker-get-news feed-name))
(if interval
(add-to-list 'newsticker--retrieval-timer-list
(cons feed-name timer))))))
@ -727,10 +727,10 @@ See `newsticker-get-news'."
(error "Another wget-process is running for %s" feed-name))
;; start wget
(let* ((args (append wget-arguments (list url)))
(proc (apply 'start-process feed-name buffername
(proc (apply #'start-process feed-name buffername
newsticker-wget-name args)))
(set-process-coding-system proc 'no-conversion 'no-conversion)
(set-process-sentinel proc 'newsticker--sentinel)
(set-process-sentinel proc #'newsticker--sentinel)
(process-put proc 'nt-feed-name feed-name)
(setq newsticker--process-ids (cons (process-id proc)
newsticker--process-ids))
@ -1131,9 +1131,9 @@ Restore an xml-string from a an xml NODE that was returned by xml-parse..."
(children (cddr node)))
(concat "<" qname
(when att-list " ")
(mapconcat 'newsticker--unxml-attribute att-list " ")
(mapconcat #'newsticker--unxml-attribute att-list " ")
">"
(mapconcat 'newsticker--unxml children "") "</" qname ">")))
(mapconcat #'newsticker--unxml children "") "</" qname ">")))
(defun newsticker--unxml-attribute (attribute)
"Actually restore xml-string of an ATTRIBUTE of an xml node."
@ -1580,7 +1580,7 @@ Remove the pre-formatted from `newsticker--cache'."
"Forget all cached pre-formatted data.
Remove the pre-formatted from `newsticker--cache'."
(mapc (lambda (feed)
(mapc 'newsticker--do-forget-preformatted
(mapc #'newsticker--do-forget-preformatted
(cdr feed)))
newsticker--cache)
(when (fboundp 'newsticker--buffer-set-uptodate)
@ -1593,7 +1593,7 @@ This function calls `message' with arguments STRING and ARGS, if
(and newsticker-debug
;;(not (active-minibuffer-window))
;;(not (current-message))
(apply 'message string args)))
(apply #'message string args)))
(defun newsticker--decode-iso8601-date (string)
"Return ISO8601-encoded STRING in format like `encode-time'.
@ -1751,10 +1751,10 @@ Save image as FILENAME in DIRECTORY, download it from URL."
feed-name))
;; start wget
(let* ((args (append wget-arguments (list url)))
(proc (apply 'start-process proc-name buffername
(proc (apply #'start-process proc-name buffername
newsticker-wget-name args)))
(set-process-coding-system proc 'no-conversion 'no-conversion)
(set-process-sentinel proc 'newsticker--image-sentinel)
(set-process-sentinel proc #'newsticker--image-sentinel)
(process-put proc 'nt-directory directory)
(process-put proc 'nt-feed-name feed-name)
(process-put proc 'nt-filename filename)))))
@ -2149,7 +2149,7 @@ FEED is a symbol!"
"Save cache data for all feeds."
(unless (file-directory-p newsticker-dir)
(make-directory newsticker-dir t))
(mapc 'newsticker--cache-save-feed newsticker--cache)
(mapc #'newsticker--cache-save-feed newsticker--cache)
nil)
(defun newsticker--cache-save-feed (feed)
@ -2223,7 +2223,7 @@ If AGES is nil, the total number of items is returned."
(defun newsticker--stat-num-items-total (&optional age)
"Return total number of items in all feeds which have the given AGE.
If AGE is nil, the total number of items is returned."
(apply '+
(apply #'+
(mapcar (lambda (feed)
(if age
(newsticker--stat-num-items (intern (car feed)) age)
@ -2395,7 +2395,7 @@ the item."
(make-directory temp-dir t))
(cd temp-dir)
(message "Getting image %s" url)
(apply 'start-process "wget-image"
(apply #'start-process "wget-image"
" *newsticker-wget-download-images*"
newsticker-wget-name
(list url))
@ -2417,7 +2417,7 @@ This function is suited for adding it to `newsticker-new-item-functions'."
(make-directory temp-dir t))
(cd temp-dir)
(message "Getting enclosure %s" url)
(apply 'start-process "wget-enclosure"
(apply #'start-process "wget-enclosure"
" *newsticker-wget-download-enclosures*"
newsticker-wget-name
(list url))

115
lisp/net/newst-plainview.el
View File

@ -1,4 +1,4 @@
;;; newst-plainview.el --- Single buffer frontend for newsticker.
;;; newst-plainview.el --- Single buffer frontend for newsticker. -*- lexical-binding: t; -*-
;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
@ -90,7 +90,7 @@ The following sort methods are available:
(const :tag "Keep original order" sort-by-original-order)
(const :tag "Sort by time" sort-by-time)
(const :tag "Sort by title" sort-by-title))
:set 'newsticker--set-customvar-sorting
:set #'newsticker--set-customvar-sorting
:group 'newsticker-plainview)
(defcustom newsticker-heading-format
@ -107,7 +107,7 @@ The following printf-like specifiers can be used:
%s The statistical data of the feed. See `newsticker-statistics-format'.
%t The title of the feed, i.e. its name."
:type 'string
:set 'newsticker--set-customvar-formatting
:set #'newsticker--set-customvar-formatting
:group 'newsticker-plainview)
(defcustom newsticker-item-format
@ -122,7 +122,7 @@ The following printf-like specifiers can be used:
the title of the feed is used.
%t The title of the item."
:type 'string
:set 'newsticker--set-customvar-formatting
:set #'newsticker--set-customvar-formatting
:group 'newsticker-plainview)
(defcustom newsticker-desc-format
@ -133,7 +133,7 @@ The following printf-like specifiers can be used:
%d The date the item was (first) retrieved. See
`newsticker-date-format'."
:type 'string
:set 'newsticker--set-customvar-formatting
:set #'newsticker--set-customvar-formatting
:group 'newsticker-plainview)
(defcustom newsticker-statistics-format
@ -146,7 +146,7 @@ The following printf-like specifiers can be used:
%o The number of old items in the feed.
%O The number of obsolete items in the feed."
:type 'string
:set 'newsticker--set-customvar-formatting
:set #'newsticker--set-customvar-formatting
:group 'newsticker-plainview)
@ -195,7 +195,7 @@ If set to t old items will be completely folded and only new
items will show up in the *newsticker* buffer. Otherwise old as
well as new items will be visible."
:type 'boolean
:set 'newsticker--set-customvar-buffer
:set #'newsticker--set-customvar-buffer
:group 'newsticker-plainview)
(defcustom newsticker-show-descriptions-of-new-items
@ -204,14 +204,14 @@ well as new items will be visible."
If set to t old items will be folded and new items will be
unfolded. Otherwise old as well as new items will be folded."
:type 'boolean
:set 'newsticker--set-customvar-buffer
:set #'newsticker--set-customvar-buffer
:group 'newsticker-plainview)
(defcustom newsticker-show-all-news-elements
nil
"Show all news elements."
:type 'boolean
;;:set 'newsticker--set-customvar
;;:set #'newsticker--set-customvar
:group 'newsticker-plainview)
;; ======================================================================
@ -386,51 +386,45 @@ images."
(defvar newsticker-mode-map
(let ((map (make-keymap)))
(define-key map "sO" 'newsticker-show-old-items)
(define-key map "hO" 'newsticker-hide-old-items)
(define-key map "sa" 'newsticker-show-all-desc)
(define-key map "ha" 'newsticker-hide-all-desc)
(define-key map "sf" 'newsticker-show-feed-desc)
(define-key map "hf" 'newsticker-hide-feed-desc)
(define-key map "so" 'newsticker-show-old-item-desc)
(define-key map "ho" 'newsticker-hide-old-item-desc)
(define-key map "sn" 'newsticker-show-new-item-desc)
(define-key map "hn" 'newsticker-hide-new-item-desc)
(define-key map "se" 'newsticker-show-entry)
(define-key map "he" 'newsticker-hide-entry)
(define-key map "sx" 'newsticker-show-extra)
(define-key map "hx" 'newsticker-hide-extra)
(define-key map "sO" #'newsticker-show-old-items)
(define-key map "hO" #'newsticker-hide-old-items)
(define-key map "sa" #'newsticker-show-all-desc)
(define-key map "ha" #'newsticker-hide-all-desc)
(define-key map "sf" #'newsticker-show-feed-desc)
(define-key map "hf" #'newsticker-hide-feed-desc)
(define-key map "so" #'newsticker-show-old-item-desc)
(define-key map "ho" #'newsticker-hide-old-item-desc)
(define-key map "sn" #'newsticker-show-new-item-desc)
(define-key map "hn" #'newsticker-hide-new-item-desc)
(define-key map "se" #'newsticker-show-entry)
(define-key map "he" #'newsticker-hide-entry)
(define-key map "sx" #'newsticker-show-extra)
(define-key map "hx" #'newsticker-hide-extra)
(define-key map [?\S-\ ] 'scroll-down-command)
(define-key map " " 'scroll-up-command)
(define-key map "q" 'newsticker-close-buffer)
(define-key map "p" 'newsticker-previous-item)
(define-key map "P" 'newsticker-previous-new-item)
(define-key map "F" 'newsticker-previous-feed)
(define-key map "\t" 'newsticker-next-item)
(define-key map "n" 'newsticker-next-item)
(define-key map "N" 'newsticker-next-new-item)
(define-key map "f" 'newsticker-next-feed)
(define-key map "M" 'newsticker-mark-all-items-as-read)
(define-key map "m"
'newsticker-mark-all-items-at-point-as-read-and-redraw)
(define-key map "o"
'newsticker-mark-item-at-point-as-read)
(define-key map "O"
'newsticker-mark-all-items-at-point-as-read)
(define-key map "G" 'newsticker-get-all-news)
(define-key map "g" 'newsticker-get-news-at-point)
(define-key map "u" 'newsticker-buffer-update)
(define-key map "U" 'newsticker-buffer-force-update)
(define-key map "a" 'newsticker-add-url)
(define-key map [?\S-\ ] #'scroll-down-command)
(define-key map " " #'scroll-up-command)
(define-key map "q" #'newsticker-close-buffer)
(define-key map "p" #'newsticker-previous-item)
(define-key map "P" #'newsticker-previous-new-item)
(define-key map "F" #'newsticker-previous-feed)
(define-key map "\t" #'newsticker-next-item)
(define-key map "n" #'newsticker-next-item)
(define-key map "N" #'newsticker-next-new-item)
(define-key map "f" #'newsticker-next-feed)
(define-key map "M" #'newsticker-mark-all-items-as-read)
(define-key map "m" #'newsticker-mark-all-items-at-point-as-read-and-redraw)
(define-key map "o" #'newsticker-mark-item-at-point-as-read)
(define-key map "O" #'newsticker-mark-all-items-at-point-as-read)
(define-key map "G" #'newsticker-get-all-news)
(define-key map "g" #'newsticker-get-news-at-point)
(define-key map "u" #'newsticker-buffer-update)
(define-key map "U" #'newsticker-buffer-force-update)
(define-key map "a" #'newsticker-add-url)
(define-key map "i"
'newsticker-mark-item-at-point-as-immortal)
(define-key map "i" #'newsticker-mark-item-at-point-as-immortal)
(define-key map "xf"
'newsticker-toggle-auto-narrow-to-feed)
(define-key map "xi"
'newsticker-toggle-auto-narrow-to-item)
(define-key map "xf" #'newsticker-toggle-auto-narrow-to-feed)
(define-key map "xi" #'newsticker-toggle-auto-narrow-to-item)
;; Bind menu to mouse.
(define-key map [down-mouse-3] newsticker-menu)
@ -479,11 +473,11 @@ images."
;; maps for the clickable portions
(defvar newsticker--url-keymap
(let ((map (make-sparse-keymap)))
(define-key map [mouse-1] 'newsticker-mouse-browse-url)
(define-key map [mouse-2] 'newsticker-mouse-browse-url)
(define-key map "\n" 'newsticker-browse-url)
(define-key map "\C-m" 'newsticker-browse-url)
(define-key map [(control return)] 'newsticker-handle-url)
(define-key map [mouse-1] #'newsticker-mouse-browse-url)
(define-key map [mouse-2] #'newsticker-mouse-browse-url)
(define-key map "\n" #'newsticker-browse-url)
(define-key map "\C-m" #'newsticker-browse-url)
(define-key map [(control return)] #'newsticker-handle-url)
map)
"Key map for click-able headings in the newsticker buffer.")
@ -980,7 +974,7 @@ not get changed."
(let* (pos1 pos2
(inhibit-read-only t)
inv-prop org-inv-prop
is-invisible)
) ;; is-invisible
(newsticker--buffer-beginning-of-item)
(newsticker--buffer-goto '(desc))
(setq pos1 (max (point-min) (1- (point))))
@ -1009,7 +1003,7 @@ not get changed."
(let* (pos1 pos2
(inhibit-read-only t)
inv-prop org-inv-prop
is-invisible)
) ;; is-invisible
(newsticker--buffer-beginning-of-item)
(newsticker--buffer-goto '(desc))
(setq pos1 (max (point-min) (1- (point))))
@ -1147,7 +1141,7 @@ If VALUE is nil, auto-narrowing is turned off, otherwise it is turned on."
(setq index-alist (list feed-list)))
index-alist)))
(defun newsticker--imenu-goto (name pos &rest args)
(defun newsticker--imenu-goto (_name pos &rest _args)
"Go to item NAME at position POS and show item.
ARGS are ignored."
(goto-char pos)
@ -1236,6 +1230,9 @@ item-retrieval time is added as well."
;; insert the description
(newsticker--buffer-do-insert-text item 'desc feed-name-symbol))
(defvar w3m-fill-column)
(defvar w3-maximum-line-length)
(defun newsticker--buffer-do-insert-text (item type feed-name-symbol)
"Actually insert contents of news item, format it, render it and all that.
ITEM is a news item, TYPE tells which part of the item shall be inserted,

10
lisp/net/newst-reader.el
View File

@ -1,4 +1,4 @@
;;; newst-reader.el --- Generic RSS reader functions.
;;; newst-reader.el --- Generic RSS reader functions. -*- lexical-binding: t; -*-
;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
@ -94,7 +94,7 @@ done."
(const :tag "Right" right)
(const :tag "Center" center)
(const :tag "Full" full))
:set 'newsticker--set-customvar-formatting
:set #'newsticker--set-customvar-formatting
:group 'newsticker-reader)
(defcustom newsticker-use-full-width
@ -103,7 +103,7 @@ done."
If non-nil newsticker sets `fill-column' so that the whole
window is used when filling. See also `newsticker-justification'."
:type 'boolean
:set 'newsticker--set-customvar-formatting
:set #'newsticker--set-customvar-formatting
:group 'newsticker-reader)
(defcustom newsticker-html-renderer
@ -122,7 +122,7 @@ htmlr if this option is set."
(const :tag "w3" w3-region)
(const :tag "w3m" w3m-region)
(const :tag "htmlr" newsticker-htmlr-render))
:set 'newsticker--set-customvar-formatting
:set #'newsticker--set-customvar-formatting
:group 'newsticker-reader)
(defcustom newsticker-date-format
@ -130,7 +130,7 @@ htmlr if this option is set."
"Format for the date part in item and feed lines.
See `format-time-string' for a list of valid specifiers."
:type 'string
:set 'newsticker--set-customvar-formatting
:set #'newsticker--set-customvar-formatting
:group 'newsticker-reader)
(defgroup newsticker-faces nil

12
lisp/net/newst-ticker.el
View File

@ -1,4 +1,4 @@
;; newst-ticker.el --- mode line ticker for newsticker.
;; newst-ticker.el --- mode line ticker for newsticker. -*- lexical-binding: t; -*-
;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
@ -83,7 +83,7 @@ smooth display (see `newsticker-scroll-smoothly') a value of 0.3 seems
reasonable. For non-smooth display a value of 10 is a good starting
point."
:type 'number
:set 'newsticker--set-customvar-ticker
:set #'newsticker--set-customvar-ticker
:group 'newsticker-ticker)
(defcustom newsticker-scroll-smoothly
@ -104,7 +104,7 @@ at all. If you change `newsticker-scroll-smoothly' you should also change
If t the echo area will not show immortal items. See also
`newsticker-hide-old-items-in-echo-area'."
:type 'boolean
:set 'newsticker--set-customvar-ticker
:set #'newsticker--set-customvar-ticker
:group 'newsticker-ticker)
(defcustom newsticker-hide-old-items-in-echo-area
@ -113,7 +113,7 @@ If t the echo area will not show immortal items. See also
If t the echo area will show only new items, i.e. only items which have
been added between the last two retrievals."
:type 'boolean
:set 'newsticker--set-customvar-ticker
:set #'newsticker--set-customvar-ticker
:group 'newsticker-ticker)
(defcustom newsticker-hide-obsolete-items-in-echo-area
@ -122,7 +122,7 @@ been added between the last two retrievals."
If t the echo area will not show obsolete items. See also
`newsticker-hide-old-items-in-echo-area'."
:type 'boolean
:set 'newsticker--set-customvar-ticker
:set #'newsticker--set-customvar-ticker
:group 'newsticker-ticker)
(defun newsticker--display-tick ()
@ -205,7 +205,7 @@ running already."
(setq newsticker--ticker-timer
(run-at-time newsticker-ticker-interval
newsticker-ticker-interval
'newsticker--display-tick))))
#'newsticker--display-tick))))
(defun newsticker-stop-ticker ()
"Stop newsticker's ticker (but not the news retrieval)."

129
lisp/net/newst-treeview.el
View File

@ -52,86 +52,73 @@
(defface newsticker-treeview-face
'((((class color) (background dark)) :foreground "white")
(((class color) (background light)) :foreground "black"))
"Face for newsticker tree."
:group 'newsticker-treeview)
"Face for newsticker tree.")
(defface newsticker-treeview-new-face
'((t :inherit newsticker-treeview-face :weight bold))
"Face for newsticker tree."
:group 'newsticker-treeview)
"Face for newsticker tree.")
(defface newsticker-treeview-old-face
'((t :inherit newsticker-treeview-face))
"Face for newsticker tree."
:group 'newsticker-treeview)
"Face for newsticker tree.")
(defface newsticker-treeview-immortal-face
'((default :inherit newsticker-treeview-face :slant italic)
(((class color) (background dark)) :foreground "orange")
(((class color) (background light)) :foreground "blue"))
"Face for newsticker tree."
:group 'newsticker-treeview)
"Face for newsticker tree.")
(defface newsticker-treeview-obsolete-face
'((t :inherit newsticker-treeview-face :strike-through t))
"Face for newsticker tree."
:group 'newsticker-treeview)
"Face for newsticker tree.")
(defface newsticker-treeview-selection-face
'((((class color) (background dark)) :background "#4444aa")
(((class color) (background light)) :background "#bbbbff"))
"Face for newsticker selection."
:group 'newsticker-treeview)
"Face for newsticker selection.")
(defcustom newsticker-treeview-date-format
"%d.%m.%y, %H:%M"
"Format for the date column in the treeview list buffer.
See `format-time-string' for a list of valid specifiers."
:version "25.1"
:type 'string
:group 'newsticker-treeview)
:type 'string)
(defcustom newsticker-treeview-own-frame
nil
"Decides whether newsticker treeview creates and uses its own frame."
:type 'boolean
:group 'newsticker-treeview)
:type 'boolean)
(defcustom newsticker-treeview-treewindow-width
30
"Width of tree window in treeview layout.
See also `newsticker-treeview-listwindow-height'."
:type 'integer
:group 'newsticker-treeview)
:type 'integer)
(defcustom newsticker-treeview-listwindow-height
10
"Height of list window in treeview layout.
See also `newsticker-treeview-treewindow-width'."
:type 'integer
:group 'newsticker-treeview)
:type 'integer)
(defcustom newsticker-treeview-automatically-mark-displayed-items-as-old
t
"Decides whether to automatically mark displayed items as old.
If t an item is marked as old as soon as it is displayed. This
applies to newsticker only."
:type 'boolean
:group 'newsticker-treeview)
:type 'boolean)
(defcustom newsticker-treeview-use-feed-name-from-url-list-in-treeview
t
"Use the feed names from 'newsticker-url-list' for display in treeview."
:version "28.1"
:type 'boolean
:group 'newsticker-treeview)
:type 'boolean)
(defcustom newsticker-treeview-use-feed-name-from-url-list-in-itemview
t
"Use feed names from 'newsticker-url-list' in itemview."
:version "28.1"
:type 'boolean
:group 'newsticker-treeview)
:type 'boolean)
(defvar newsticker-groups
'("Feeds")
@ -166,14 +153,16 @@ Example: (\"Topmost group\" \"feed1\" (\"subgroup1\" \"feed 2\")
(defvar newsticker--treeview-feed-tree nil)
(defvar newsticker--treeview-vfeed-tree nil)
(declare-function newsticker-handle-url "newst-plainview" ())
;; maps for the clickable portions
(defvar newsticker--treeview-url-keymap
(let ((map (make-sparse-keymap 'newsticker--treeview-url-keymap)))
(define-key map [mouse-1] 'newsticker-treeview-mouse-browse-url)
(define-key map [mouse-2] 'newsticker-treeview-mouse-browse-url)
(define-key map "\n" 'newsticker-treeview-browse-url)
(define-key map "\C-m" 'newsticker-treeview-browse-url)
(define-key map [(control return)] 'newsticker-handle-url)
(define-key map [mouse-1] #'newsticker-treeview-mouse-browse-url)
(define-key map [mouse-2] #'newsticker-treeview-mouse-browse-url)
(define-key map "\n" #'newsticker-treeview-browse-url)
(define-key map "\C-m" #'newsticker-treeview-browse-url)
(define-key map [(control return)] #'newsticker-handle-url)
map)
"Key map for click-able headings in the newsticker treeview buffers.")
@ -342,9 +331,9 @@ If string SHOW-FEED is non-nil it is shown in the item string."
(replace-match " "))
(let ((map (make-sparse-keymap)))
(dolist (key'([mouse-1] [mouse-3]))
(define-key map key 'newsticker-treeview-tree-click))
(define-key map "\n" 'newsticker-treeview-show-item)
(define-key map "\C-m" 'newsticker-treeview-show-item)
(define-key map key #'newsticker-treeview-tree-click))
(define-key map "\n" #'newsticker-treeview-show-item)
(define-key map "\C-m" #'newsticker-treeview-show-item)
(add-text-properties pos1 (point-max)
(list :nt-item item
:nt-feed feed
@ -626,9 +615,9 @@ If CLEAR-BUFFER is non-nil the list buffer is completely erased."
(defvar newsticker-treeview-list-sort-button-map
(let ((map (make-sparse-keymap)))
(define-key map [header-line mouse-1]
'newsticker--treeview-list-sort-by-column)
#'newsticker--treeview-list-sort-by-column)
(define-key map [header-line mouse-2]
'newsticker--treeview-list-sort-by-column)
#'newsticker--treeview-list-sort-by-column)
map)
"Local keymap for newsticker treeview list window sort buttons.")
@ -960,9 +949,9 @@ arguments NT-ID, FEED, VFEED and TOOLTIP are added as properties."
(if (and num-new (> num-new 0))
(setq face 'newsticker-treeview-new-face))
(dolist (key '([mouse-1] [mouse-3]))
(define-key map key 'newsticker-treeview-tree-click))
(define-key map "\n" 'newsticker-treeview-tree-do-click)
(define-key map "\C-m" 'newsticker-treeview-tree-do-click)
(define-key map key #'newsticker-treeview-tree-click))
(define-key map "\n" #'newsticker-treeview-tree-do-click)
(define-key map "\C-m" #'newsticker-treeview-tree-do-click)
(propertize tag 'face face 'keymap map
:nt-id nt-id
:nt-feed feed
@ -2029,37 +2018,37 @@ Return t if groups have changed, nil otherwise."
(defvar newsticker-treeview-mode-map
(let ((map (make-sparse-keymap 'newsticker-treeview-mode-map)))
(define-key map " " 'newsticker-treeview-next-page)
(define-key map "a" 'newsticker-add-url)
(define-key map "b" 'newsticker-treeview-browse-url-item)
(define-key map "c" 'newsticker-treeview-customize-current-feed)
(define-key map "F" 'newsticker-treeview-prev-feed)
(define-key map "f" 'newsticker-treeview-next-feed)
(define-key map "g" 'newsticker-treeview-get-news)
(define-key map "G" 'newsticker-get-all-news)
(define-key map "i" 'newsticker-treeview-toggle-item-immortal)
(define-key map "j" 'newsticker-treeview-jump)
(define-key map "n" 'newsticker-treeview-next-item)
(define-key map "N" 'newsticker-treeview-next-new-or-immortal-item)
(define-key map "O" 'newsticker-treeview-mark-list-items-old)
(define-key map "o" 'newsticker-treeview-mark-item-old)
(define-key map "p" 'newsticker-treeview-prev-item)
(define-key map "P" 'newsticker-treeview-prev-new-or-immortal-item)
(define-key map "q" 'newsticker-treeview-quit)
(define-key map "S" 'newsticker-treeview-save-item)
(define-key map "s" 'newsticker-treeview-save)
(define-key map "u" 'newsticker-treeview-update)
(define-key map "v" 'newsticker-treeview-browse-url)
;;(define-key map "\n" 'newsticker-treeview-scroll-item)
;;(define-key map "\C-m" 'newsticker-treeview-scroll-item)
(define-key map "\M-m" 'newsticker-group-move-feed)
(define-key map "\M-a" 'newsticker-group-add-group)
(define-key map "\M-d" 'newsticker-group-delete-group)
(define-key map "\M-r" 'newsticker-group-rename-group)
(define-key map [M-down] 'newsticker-group-shift-feed-down)
(define-key map [M-up] 'newsticker-group-shift-feed-up)
(define-key map [M-S-down] 'newsticker-group-shift-group-down)
(define-key map [M-S-up] 'newsticker-group-shift-group-up)
(define-key map " " #'newsticker-treeview-next-page)
(define-key map "a" #'newsticker-add-url)
(define-key map "b" #'newsticker-treeview-browse-url-item)
(define-key map "c" #'newsticker-treeview-customize-current-feed)
(define-key map "F" #'newsticker-treeview-prev-feed)
(define-key map "f" #'newsticker-treeview-next-feed)
(define-key map "g" #'newsticker-treeview-get-news)
(define-key map "G" #'newsticker-get-all-news)
(define-key map "i" #'newsticker-treeview-toggle-item-immortal)
(define-key map "j" #'newsticker-treeview-jump)
(define-key map "n" #'newsticker-treeview-next-item)
(define-key map "N" #'newsticker-treeview-next-new-or-immortal-item)
(define-key map "O" #'newsticker-treeview-mark-list-items-old)
(define-key map "o" #'newsticker-treeview-mark-item-old)
(define-key map "p" #'newsticker-treeview-prev-item)
(define-key map "P" #'newsticker-treeview-prev-new-or-immortal-item)
(define-key map "q" #'newsticker-treeview-quit)
(define-key map "S" #'newsticker-treeview-save-item)
(define-key map "s" #'newsticker-treeview-save)
(define-key map "u" #'newsticker-treeview-update)
(define-key map "v" #'newsticker-treeview-browse-url)
;;(define-key map "\n" #'newsticker-treeview-scroll-item)
;;(define-key map "\C-m" #'newsticker-treeview-scroll-item)
(define-key map "\M-m" #'newsticker-group-move-feed)
(define-key map "\M-a" #'newsticker-group-add-group)
(define-key map "\M-d" #'newsticker-group-delete-group)
(define-key map "\M-r" #'newsticker-group-rename-group)
(define-key map [M-down] #'newsticker-group-shift-feed-down)
(define-key map [M-up] #'newsticker-group-shift-feed-up)
(define-key map [M-S-down] #'newsticker-group-shift-group-down)
(define-key map [M-S-up] #'newsticker-group-shift-group-up)
map)
"Mode map for newsticker treeview.")

4
lisp/net/puny.el
View File

@ -37,7 +37,7 @@ For instance, \"fśf.org\" => \"xn--ff-2sa.org\"."
;; add a check first to avoid doing unnecessary work.
(if (string-match "\\`[[:ascii:]]+\\'" domain)
domain
(mapconcat 'puny-encode-string (split-string domain "[.]") ".")))
(mapconcat #'puny-encode-string (split-string domain "[.]") ".")))
(defun puny-encode-string (string)
"Encode STRING according to the IDNA/punycode algorithm.
@ -57,7 +57,7 @@ For instance, \"bücher\" => \"xn--bcher-kva\"."
(defun puny-decode-domain (domain)
"Decode DOMAIN according to the IDNA/punycode algorithm.
For instance, \"xn--ff-2sa.org\" => \"fśf.org\"."
(mapconcat 'puny-decode-string (split-string domain "[.]") "."))
(mapconcat #'puny-decode-string (split-string domain "[.]") "."))
(defun puny-decode-string (string)
"Decode an IDNA/punycode-encoded string.

29
lisp/net/quickurl.el
View File

@ -1,4 +1,4 @@
;;; quickurl.el --- insert a URL based on text at point in buffer
;;; quickurl.el --- insert a URL based on text at point in buffer -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
@ -97,23 +97,19 @@
(locate-user-emacs-file "quickurls" ".quickurls")
"File that contains the URL list."
:version "24.4" ; added locate-user-emacs-file
:type 'file
:group 'quickurl)
:type 'file)
(defcustom quickurl-format-function #'quickurl-format-url
"Function to format the URL before insertion into the current buffer."
:type 'function
:group 'quickurl)
:type 'function)
(defcustom quickurl-sort-function #'quickurl-sort-urls
"Function to sort the URL list."
:type 'function
:group 'quickurl)
:type 'function)
(defcustom quickurl-grab-lookup-function #'current-word
"Function to grab the thing to lookup."
:type 'function
:group 'quickurl)
:type 'function)
(defun quickurl--assoc-function (key alist)
"Default function for `quickurl-assoc-function'."
@ -122,31 +118,26 @@
(defcustom quickurl-assoc-function #'quickurl--assoc-function
"Function to use for alist lookup into `quickurl-urls'."
:version "26.1" ; was the obsolete assoc-ignore-case
:type 'function
:group 'quickurl)
:type 'function)
(defcustom quickurl-completion-ignore-case t
"Should `quickurl-ask' ignore case when doing the input lookup?"
:type 'boolean
:group 'quickurl)
:type 'boolean)
(defcustom quickurl-prefix ";; -*- lisp -*-\n\n"
"Text to write to `quickurl-url-file' before writing the URL list."
:type 'string
:group 'quickurl)
:type 'string)
(defcustom quickurl-postfix ""
"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."
:type 'string
:group 'quickurl)
:type 'string)
(defcustom quickurl-list-mode-hook nil
"Hooks for `quickurl-list-mode'."
:type 'hook
:group 'quickurl)
:type 'hook)
;; Constants.

2
lisp/net/rcirc.el
View File

@ -293,7 +293,7 @@ The following replacements are made:
Setting this alone will not affect the prompt;
use either M-x customize or also call `rcirc-update-prompt'."
:type 'string
:set 'rcirc-set-changed
:set #'rcirc-set-changed
:initialize 'custom-initialize-default)
(defcustom rcirc-keywords nil

10
lisp/net/secrets.el
View File

@ -643,7 +643,7 @@ starting with a colon. Example:
The object labels of the found items are returned as list."
(mapcar
(lambda (item-path) (secrets-get-item-property item-path "Label"))
(apply 'secrets-search-item-paths collection attributes)))
(apply #'secrets-search-item-paths collection attributes)))
(defun secrets-create-item (collection item password &rest attributes)
"Create a new item in COLLECTION with label ITEM and password PASSWORD.
@ -780,9 +780,9 @@ ITEM can also be an object path, which is used if contained in COLLECTION."
(defvar secrets-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map (make-composed-keymap special-mode-map widget-keymap))
(define-key map "n" 'next-line)
(define-key map "p" 'previous-line)
(define-key map "z" 'kill-current-buffer)
(define-key map "n" #'next-line)
(define-key map "p" #'previous-line)
(define-key map "z" #'kill-current-buffer)
map)
"Keymap used in `secrets-mode' buffers.")
@ -859,7 +859,7 @@ to their attributes."
;; padding is needed to format attribute names.
(padding
(apply
'max
#'max
(cons
(1+ (length "password"))
(mapcar

14
lisp/net/shr-color.el
View File

@ -36,14 +36,12 @@
(defcustom shr-color-visible-luminance-min 40
"Minimum luminance distance between two colors to be considered visible.
Must be between 0 and 100."
:group 'shr-color
:type 'number)
(defcustom shr-color-visible-distance-min 5
"Minimum color distance between two colors to be considered visible.
This value is used to compare result for `ciede2000'. It's an
absolute value without any unit."
:group 'shr-color
:type 'integer)
(defconst shr-color-html-colors-alist
@ -332,8 +330,8 @@ color will be adapted to be visible on BG."
(if (or (null fg-norm)
(null bg-norm))
(list bg fg)
(let* ((fg-lab (apply 'color-srgb-to-lab fg-norm))
(bg-lab (apply 'color-srgb-to-lab bg-norm))
(let* ((fg-lab (apply #'color-srgb-to-lab fg-norm))
(bg-lab (apply #'color-srgb-to-lab bg-norm))
;; Compute color distance using CIE DE 2000
(fg-bg-distance (color-cie-de2000 fg-lab bg-lab))
;; Compute luminance distance (subtract L component)
@ -351,12 +349,12 @@ color will be adapted to be visible on BG."
(list
(if fixed-background
bg
(apply 'format "#%02x%02x%02x"
(apply #'format "#%02x%02x%02x"
(mapcar (lambda (x) (* (max (min 1 x) 0) 255))
(apply 'color-lab-to-srgb bg-lab))))
(apply 'format "#%02x%02x%02x"
(apply #'color-lab-to-srgb bg-lab))))
(apply #'format "#%02x%02x%02x"
(mapcar (lambda (x) (* (max (min 1 x) 0) 255))
(apply 'color-lab-to-srgb fg-lab))))))))))
(apply #'color-lab-to-srgb fg-lab))))))))))
(provide 'shr-color)

26
lisp/net/shr.el
View File

@ -220,20 +220,20 @@ and other things:
(defvar shr-map
(let ((map (make-sparse-keymap)))
(define-key map "a" 'shr-show-alt-text)
(define-key map "i" 'shr-browse-image)
(define-key map "z" 'shr-zoom-image)
(define-key map [?\t] 'shr-next-link)
(define-key map [?\M-\t] 'shr-previous-link)
(define-key map "a" #'shr-show-alt-text)
(define-key map "i" #'shr-browse-image)
(define-key map "z" #'shr-zoom-image)
(define-key map [?\t] #'shr-next-link)
(define-key map [?\M-\t] #'shr-previous-link)
(define-key map [follow-link] 'mouse-face)
(define-key map [mouse-2] 'shr-browse-url)
(define-key map [C-down-mouse-1] 'shr-mouse-browse-url-new-window)
(define-key map "I" 'shr-insert-image)
(define-key map "w" 'shr-maybe-probe-and-copy-url)
(define-key map "u" 'shr-maybe-probe-and-copy-url)
(define-key map "v" 'shr-browse-url)
(define-key map "O" 'shr-save-contents)
(define-key map "\r" 'shr-browse-url)
(define-key map [mouse-2] #'shr-browse-url)
(define-key map [C-down-mouse-1] #'shr-mouse-browse-url-new-window)
(define-key map "I" #'shr-insert-image)
(define-key map "w" #'shr-maybe-probe-and-copy-url)
(define-key map "u" #'shr-maybe-probe-and-copy-url)
(define-key map "v" #'shr-browse-url)
(define-key map "O" #'shr-save-contents)
(define-key map "\r" #'shr-browse-url)
map))
(defvar shr-image-map

6
lisp/net/sieve-mode.el
View File

@ -139,9 +139,9 @@
(defvar sieve-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\C-c\C-l" 'sieve-upload)
(define-key map "\C-c\C-c" 'sieve-upload-and-kill)
(define-key map "\C-c\C-m" 'sieve-manage)
(define-key map "\C-c\C-l" #'sieve-upload)
(define-key map "\C-c\C-c" #'sieve-upload-and-kill)
(define-key map "\C-c\C-m" #'sieve-manage)
map)
"Key map used in sieve mode.")

26
lisp/net/soap-client.el
View File

@ -10,6 +10,7 @@
;; Package: soap-client
;; Homepage: https://github.com/alex-hhh/emacs-soap-client
;; Package-Requires: ((cl-lib "0.6.1"))
;;FIXME: Put in `Package-Requires:' the Emacs version we expect.
;; This file is part of GNU Emacs.
@ -771,6 +772,8 @@ This is a specialization of `soap-decode-type' for
(Array (soap-decode-array node))))))
(defalias 'soap-type-of
;; FIXME: Once we drop support for Emacs<25, use generic functions
;; via `cl-defmethod' instead of our own ad-hoc version of it.
(if (eq 'soap-xs-basic-type (type-of (make-soap-xs-basic-type)))
;; `type-of' in Emacs ≥ 26 already does what we need.
#'type-of
@ -1263,7 +1266,7 @@ See also `soap-wsdl-resolve-references'."
(soap-l2wk (xml-node-name node)))
(setf (soap-xs-simple-type-base type)
(mapcar 'soap-l2fq
(mapcar #'soap-l2fq
(split-string
(or (xml-get-attribute-or-nil node 'memberTypes) ""))))
@ -1343,7 +1346,7 @@ See also `soap-wsdl-resolve-references'."
(soap-validate-xs-basic-type value base))))
(error (push (cadr error-object) messages))))
(when messages
(error (mapconcat 'identity (nreverse messages) "; and: "))))
(error (mapconcat #'identity (nreverse messages) "; and: "))))
(cl-labels ((fail-with-message (format value)
(push (format format value) messages)
(throw 'invalid nil)))
@ -2345,8 +2348,8 @@ See also `soap-resolve-references' and
(when (= (length (soap-operation-parameter-order operation)) 0)
(setf (soap-operation-parameter-order operation)
(mapcar 'car (soap-message-parts
(cdr (soap-operation-input operation))))))
(mapcar #'car (soap-message-parts
(cdr (soap-operation-input operation))))))
(setf (soap-operation-parameter-order operation)
(mapcar (lambda (p)
@ -2391,13 +2394,13 @@ See also `soap-wsdl-resolve-references'."
;; Install resolvers for our types
(progn
(put (soap-type-of (make-soap-message)) 'soap-resolve-references
'soap-resolve-references-for-message)
#'soap-resolve-references-for-message)
(put (soap-type-of (make-soap-operation)) 'soap-resolve-references
'soap-resolve-references-for-operation)
#'soap-resolve-references-for-operation)
(put (soap-type-of (make-soap-binding)) 'soap-resolve-references
'soap-resolve-references-for-binding)
#'soap-resolve-references-for-binding)
(put (soap-type-of (make-soap-port)) 'soap-resolve-references
'soap-resolve-references-for-port))
#'soap-resolve-references-for-port))
(defun soap-wsdl-resolve-references (wsdl)
"Resolve all references inside the WSDL structure.
@ -2511,7 +2514,7 @@ Build on WSDL if it is provided."
(soap-wsdl-resolve-references (soap-parse-wsdl xml wsdl))
wsdl))
(defalias 'soap-load-wsdl-from-url 'soap-load-wsdl)
(defalias 'soap-load-wsdl-from-url #'soap-load-wsdl)
(defun soap-parse-wsdl-phase-validate-node (node)
"Assert that NODE is valid."
@ -2884,7 +2887,7 @@ decode function to perform the actual decoding."
(if (fboundp 'define-error)
(define-error 'soap-error "SOAP error")
;; Support older Emacs versions that do not have define-error, so
;; Support Emacs<24.4 that do not have define-error, so
;; that soap-client can remain unchanged in GNU ELPA.
(put 'soap-error
'error-conditions
@ -3123,8 +3126,7 @@ http://schemas.xmlsoap.org/soap/encoding/\"\n"))
(defcustom soap-debug nil
"When t, enable some debugging facilities."
:type 'boolean
:group 'soap-client)
:type 'boolean)
(defun soap-find-port (wsdl service)
"Return the WSDL port having SERVICE name.

46
lisp/net/soap-inspect.el
View File

@ -109,7 +109,7 @@ soap-xs-attribute objects."
This is a specialization of `soap-sample-value' for
`soap-xs-simple-type' objects."
(append
(mapcar 'soap-sample-value-for-xs-attribute
(mapcar #'soap-sample-value-for-xs-attribute
(soap-xs-type-attributes type))
(cond
((soap-xs-simple-type-enumeration type)
@ -143,7 +143,7 @@ This is a specialization of `soap-sample-value' for
This is a specialization of `soap-sample-value' for
`soap-xs-complex-type' objects."
(append
(mapcar 'soap-sample-value-for-xs-attribute
(mapcar #'soap-sample-value-for-xs-attribute
(soap-xs-type-attributes type))
(cl-case (soap-xs-complex-type-indicator type)
(array
@ -176,31 +176,31 @@ This is a specialization of `soap-sample-value' for
;; Install soap-sample-value methods for our types
(put (soap-type-of (make-soap-xs-basic-type))
'soap-sample-value
'soap-sample-value-for-xs-basic-type)
#'soap-sample-value-for-xs-basic-type)
(put (soap-type-of (make-soap-xs-element))
'soap-sample-value
'soap-sample-value-for-xs-element)
#'soap-sample-value-for-xs-element)
(put (soap-type-of (make-soap-xs-attribute))
'soap-sample-value
'soap-sample-value-for-xs-attribute)
#'soap-sample-value-for-xs-attribute)
(put (soap-type-of (make-soap-xs-attribute))
'soap-sample-value
'soap-sample-value-for-xs-attribute-group)
#'soap-sample-value-for-xs-attribute-group)
(put (soap-type-of (make-soap-xs-simple-type))
'soap-sample-value
'soap-sample-value-for-xs-simple-type)
#'soap-sample-value-for-xs-simple-type)
(put (soap-type-of (make-soap-xs-complex-type))
'soap-sample-value
'soap-sample-value-for-xs-complex-type)
#'soap-sample-value-for-xs-complex-type)
(put (soap-type-of (make-soap-message))
'soap-sample-value
'soap-sample-value-for-message))
#'soap-sample-value-for-message))
@ -437,7 +437,7 @@ TYPE is a `soap-xs-complex-type'."
(funcall (list 'soap-invoke '*WSDL* "SomeService"
(soap-element-name operation))))
(let ((sample-invocation
(append funcall (mapcar 'cdr sample-message-value))))
(append funcall (mapcar #'cdr sample-message-value))))
(pp sample-invocation (current-buffer)))))
(defun soap-inspect-port-type (port-type)
@ -460,7 +460,7 @@ TYPE is a `soap-xs-complex-type'."
collect o))
op-name-width)
(setq operations (sort operations 'string<))
(setq operations (sort operations #'string<))
(setq op-name-width (cl-loop for o in operations maximizing (length o)))
@ -504,39 +504,39 @@ TYPE is a `soap-xs-complex-type'."
;; Install the soap-inspect methods for our types
(put (soap-type-of (make-soap-xs-basic-type)) 'soap-inspect
'soap-inspect-xs-basic-type)
#'soap-inspect-xs-basic-type)
(put (soap-type-of (make-soap-xs-element)) 'soap-inspect
'soap-inspect-xs-element)
#'soap-inspect-xs-element)
(put (soap-type-of (make-soap-xs-simple-type)) 'soap-inspect
'soap-inspect-xs-simple-type)
#'soap-inspect-xs-simple-type)
(put (soap-type-of (make-soap-xs-complex-type)) 'soap-inspect
'soap-inspect-xs-complex-type)
#'soap-inspect-xs-complex-type)
(put (soap-type-of (make-soap-xs-attribute)) 'soap-inspect
'soap-inspect-xs-attribute)
#'soap-inspect-xs-attribute)
(put (soap-type-of (make-soap-xs-attribute-group)) 'soap-inspect
'soap-inspect-xs-attribute-group)
#'soap-inspect-xs-attribute-group)
(put (soap-type-of (make-soap-message)) 'soap-inspect
'soap-inspect-message)
#'soap-inspect-message)
(put (soap-type-of (make-soap-operation)) 'soap-inspect
'soap-inspect-operation)
#'soap-inspect-operation)
(put (soap-type-of (make-soap-port-type)) 'soap-inspect
'soap-inspect-port-type)
#'soap-inspect-port-type)
(put (soap-type-of (make-soap-binding)) 'soap-inspect
'soap-inspect-binding)
#'soap-inspect-binding)
(put (soap-type-of (make-soap-port)) 'soap-inspect
'soap-inspect-port)
#'soap-inspect-port)
(put (soap-type-of (soap-make-wsdl "origin")) 'soap-inspect
'soap-inspect-wsdl))
#'soap-inspect-wsdl))
(provide 'soap-inspect)
;;; soap-inspect.el ends here

20
lisp/net/telnet.el
View File

@ -1,4 +1,4 @@
;;; telnet.el --- run a telnet session from within an Emacs buffer
;;; telnet.el --- run a telnet session from within an Emacs buffer -*- lexical-binding: t; -*-
;; Copyright (C) 1985, 1988, 1992, 1994, 2001-2021 Free Software
;; Foundation, Inc.
@ -63,11 +63,11 @@ LOGIN-NAME, which is optional, says what to log in as on that machine.")
(defvar telnet-new-line "\r")
(defvar telnet-mode-map
(let ((map (nconc (make-sparse-keymap) comint-mode-map)))
(define-key map "\C-m" 'telnet-send-input)
;; (define-key map "\C-j" 'telnet-send-input)
(define-key map "\C-c\C-q" 'send-process-next-char)
(define-key map "\C-c\C-c" 'telnet-interrupt-subjob)
(define-key map "\C-c\C-z" 'telnet-c-z)
(define-key map "\C-m" #'telnet-send-input)
;; (define-key map "\C-j" #'telnet-send-input)
(define-key map "\C-c\C-q" #'send-process-next-char)
(define-key map "\C-c\C-c" #'telnet-interrupt-subjob)
(define-key map "\C-c\C-z" #'telnet-c-z)
map))
(defvar telnet-prompt-pattern "^[^#$%>\n]*[#$%>] *")
@ -152,7 +152,7 @@ rejecting one login and prompting again for a username and password.")
(t (telnet-check-software-type-initialize string)
(telnet-filter proc string)
(cond ((> telnet-count telnet-maximum-count)
(set-process-filter proc 'telnet-filter))
(set-process-filter proc #'telnet-filter))
(t (setq telnet-count (1+ telnet-count)))))))))
;; Identical to comint-simple-send, except that it sends telnet-new-line
@ -227,9 +227,9 @@ Normally input is edited in Emacs and sent a line at a time."
(if (and buffer (get-buffer-process buffer))
(switch-to-buffer (concat "*" name "*"))
(switch-to-buffer
(apply 'make-comint name telnet-program nil telnet-options))
(apply #'make-comint name telnet-program nil telnet-options))
(setq process (get-buffer-process (current-buffer)))
(set-process-filter process 'telnet-initial-filter)
(set-process-filter process #'telnet-initial-filter)
;; Don't send the `open' cmd till telnet is ready for it.
(accept-process-output process)
(erase-buffer)
@ -263,7 +263,7 @@ Normally input is edited in Emacs and sent a line at a time."
(require 'shell)
(let ((name (concat "rsh-" host )))
(switch-to-buffer (make-comint name remote-shell-program nil host))
(set-process-filter (get-process name) 'telnet-initial-filter)
(set-process-filter (get-process name) #'telnet-initial-filter)
(telnet-mode)
(setq-local telnet-connect-command (list 'rsh host))
(setq telnet-count -16)))

2
lisp/net/tramp-cmds.el
View File

@ -250,7 +250,7 @@ function returns nil"
(host (or (file-remote-p string 'host) ""))
item result)
(while (setq item (pop tdra))
(when (string-match-p (or (eval (car item)) "") string)
(when (string-match-p (or (eval (car item) t) "") string)
(setq tdra nil
result
(format-spec

2
lisp/net/tramp-compat.el
View File

@ -70,7 +70,7 @@
It is the default value of `temporary-file-directory'."
;; We must return a local directory. If it is remote, we could run
;; into an infloop.
(eval (car (get 'temporary-file-directory 'standard-value))))
(eval (car (get 'temporary-file-directory 'standard-value)) t))
(defsubst tramp-compat-make-temp-name ()
"Generate a local temporary file name (compat function)."

2
lisp/net/tramp-integration.el
View File

@ -231,7 +231,7 @@ NAME must be equal to `tramp-current-connection'."
(delete (info-lookup->mode-cache 'symbol 'tramp-info-lookup-mode)
(info-lookup->topic-cache 'symbol)))))
(dolist (mode (mapcar 'car (info-lookup->topic-value 'symbol)))
(dolist (mode (mapcar #'car (info-lookup->topic-value 'symbol)))
;; Add `tramp-info-lookup-mode' to `other-modes' for either
;; `emacs-lisp-mode' itself, or to modes which use
;; `emacs-lisp-mode' as `other-modes'. Reset `info-lookup-cache'.

4
lisp/net/tramp-sh.el
View File

@ -4918,7 +4918,7 @@ If there is just some editing, retry it after 5 seconds."
(progn
(tramp-message
vec 5 "Cannot timeout session, trying it again in %s seconds." 5)
(run-at-time 5 nil 'tramp-timeout-session vec))
(run-at-time 5 nil #'tramp-timeout-session vec))
(tramp-message
vec 3 "Timeout session %s" (tramp-make-tramp-file-name vec 'noloc))
(tramp-cleanup-connection vec 'keep-debug nil 'keep-processes)))
@ -5149,7 +5149,7 @@ connection if a previous connection has died for some reason."
(when (tramp-get-connection-property p "session-timeout" nil)
(run-at-time
(tramp-get-connection-property p "session-timeout" nil) nil
'tramp-timeout-session vec))
#'tramp-timeout-session vec))
;; Make initial shell settings.
(tramp-open-connection-setup-interactive-shell p vec)

25
lisp/net/tramp.el
View File

@ -386,6 +386,8 @@ Also see `tramp-default-method-alist'."
:type 'string)
(defcustom tramp-default-method-alist nil
;; FIXME: This is not an "alist", because its elements are not of
;; the form (KEY . VAL) but (KEY1 KEY2 VAL).
"Default method to use for specific host/user pairs.
This is an alist of items (HOST USER METHOD). The first matching item
specifies the method to use for a file name which does not specify a
@ -413,6 +415,8 @@ This variable is regarded as obsolete, and will be removed soon."
:type '(choice (const nil) string))
(defcustom tramp-default-user-alist nil
;; FIXME: This is not an "alist", because its elements are not of
;; the form (KEY . VAL) but (KEY1 KEY2 VAL).
"Default user to use for specific method/host pairs.
This is an alist of items (METHOD HOST USER). The first matching item
specifies the user to use for a file name which does not specify a
@ -432,6 +436,8 @@ Useful for su and sudo methods mostly."
:type 'string)
(defcustom tramp-default-host-alist nil
;; FIXME: This is not an "alist", because its elements are not of
;; the form (KEY . VAL) but (KEY1 KEY2 VAL).
"Default host to use for specific method/user pairs.
This is an alist of items (METHOD USER HOST). The first matching item
specifies the host to use for a file name which does not specify a
@ -447,6 +453,8 @@ empty string for the method name."
(choice :tag " Host name" string (const nil)))))
(defcustom tramp-default-proxies-alist nil
;; FIXME: This is not an "alist", because its elements are not of
;; the form (KEY . VAL) but (KEY1 KEY2 VAL).
"Route to be followed for specific host/user pairs.
This is an alist of items (HOST USER PROXY). The first matching
item specifies the proxy to be passed for a file name located on
@ -1710,6 +1718,10 @@ version, the function does nothing."
"Used for highlighting Tramp debug buffers in `outline-mode'.")
(defconst tramp-debug-font-lock-keywords
;; FIXME: Make it a function instead of an ELisp expression, so you
;; can evaluate it with `funcall' rather than `eval'!
;; Also, in `font-lock-defaults' you can specify a function name for
;; the "KEYWORDS" part, so font-lock calls it to get the actual keywords!
'(list
(concat "^\\(?:" tramp-debug-outline-regexp "\\).+")
'(1 font-lock-warning-face t t)
@ -1738,8 +1750,11 @@ The outline level is equal to the verbosity of the Tramp message."
(outline-mode))
(setq-local outline-level 'tramp-debug-outline-level)
(setq-local font-lock-keywords
`(t (eval ,tramp-debug-font-lock-keywords)
,(eval tramp-debug-font-lock-keywords)))
;; FIXME: This `(t FOO . BAR)' representation in
;; `font-lock-keywords' is supposed to be an
;; internal implementation "detail". Don't abuse it here!
`(t (eval ,tramp-debug-font-lock-keywords t)
,(eval tramp-debug-font-lock-keywords t)))
;; Do not edit the debug buffer.
(use-local-map special-mode-map))
(current-buffer)))
@ -3691,15 +3706,15 @@ User is always nil."
(setq choices tramp-default-proxies-alist)
(while choices
(setq item (pop choices)
proxy (eval (nth 2 item)))
proxy (eval (nth 2 item) t))
(when (and
;; Host.
(string-match-p
(or (eval (nth 0 item)) "")
(or (eval (nth 0 item) t) "")
(or (tramp-file-name-host-port (car target-alist)) ""))
;; User.
(string-match-p
(or (eval (nth 1 item)) "")
(or (eval (nth 1 item) t) "")
(or (tramp-file-name-user-domain (car target-alist)) "")))
(if (null proxy)
;; No more hops needed.

2
lisp/net/webjump.el
View File

@ -252,7 +252,7 @@ Please submit bug reports and other feedback to the author, Neil W. Van Dyke
(cond ((not expr) "")
((stringp expr) expr)
((vectorp expr) (webjump-builtin expr name))
((listp expr) (eval expr))
((listp expr) (eval expr t))
((symbolp expr)
(if (fboundp expr)
(funcall expr name)