commit 76735c116d3d49f0e1ba84ccf657729e91cb1ad0 (HEAD, refs/remotes/origin/master) Author: Mark Oteiza Date: Thu Nov 3 01:15:30 2016 -0400 Remove antlr face aliases obsoleted in 22.1 * lisp/progmodes/antlr-mode.el: Remove obsolete aliases (antlr-default-face, antlr-keyword-face, antlr-syntax-face): (antlr-ruledef-face, antlr-tokendef-face, antlr-ruleref-face): (antlr-tokenref-face, antlr-literal-face): (antlr-literal-face): Remove. (antlr-font-lock-additional-keywords): Use face symbols instead. diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el index ee81add..3df7c13 100644 --- a/lisp/progmodes/antlr-mode.el +++ b/lisp/progmodes/antlr-mode.el @@ -824,16 +824,11 @@ font-lock keywords according to `font-lock-defaults' used for the code in the grammar's actions and semantic predicates, see `antlr-font-lock-maximum-decoration'.") -(defvar antlr-default-face 'antlr-default) (defface antlr-default '((t nil)) "Face to prevent strings from language dependent highlighting. Do not change." :group 'antlr) -;; backward-compatibility alias -(put 'antlr-font-lock-default-face 'face-alias 'antlr-default) -(put 'antlr-font-lock-default-face 'obsolete-face "22.1") -(defvar antlr-keyword-face 'antlr-keyword) (defface antlr-keyword (cond-emacs-xemacs '((((class color) (background light)) @@ -841,11 +836,7 @@ Do not change." (t :inherit font-lock-keyword-face))) "ANTLR keywords." :group 'antlr) -;; backward-compatibility alias -(put 'antlr-font-lock-keyword-face 'face-alias 'antlr-keyword) -(put 'antlr-font-lock-keyword-face 'obsolete-face "22.1") -(defvar antlr-syntax-face 'antlr-keyword) (defface antlr-syntax (cond-emacs-xemacs '((((class color) (background light)) @@ -853,11 +844,7 @@ Do not change." (t :inherit font-lock-constant-face))) "ANTLR syntax symbols like :, |, (, ), ...." :group 'antlr) -;; backward-compatibility alias -(put 'antlr-font-lock-syntax-face 'face-alias 'antlr-syntax) -(put 'antlr-font-lock-syntax-face 'obsolete-face "22.1") -(defvar antlr-ruledef-face 'antlr-ruledef) (defface antlr-ruledef (cond-emacs-xemacs '((((class color) (background light)) @@ -865,11 +852,7 @@ Do not change." (t :inherit font-lock-function-name-face))) "ANTLR rule references (definition)." :group 'antlr) -;; backward-compatibility alias -(put 'antlr-font-lock-ruledef-face 'face-alias 'antlr-ruledef) -(put 'antlr-font-lock-ruledef-face 'obsolete-face "22.1") -(defvar antlr-tokendef-face 'antlr-tokendef) (defface antlr-tokendef (cond-emacs-xemacs '((((class color) (background light)) @@ -877,31 +860,19 @@ Do not change." (t :inherit font-lock-function-name-face))) "ANTLR token references (definition)." :group 'antlr) -;; backward-compatibility alias -(put 'antlr-font-lock-tokendef-face 'face-alias 'antlr-tokendef) -(put 'antlr-font-lock-tokendef-face 'obsolete-face "22.1") -(defvar antlr-ruleref-face 'antlr-ruleref) (defface antlr-ruleref '((((class color) (background light)) (:foreground "blue4")) (t :inherit font-lock-type-face)) "ANTLR rule references (usage)." :group 'antlr) -;; backward-compatibility alias -(put 'antlr-font-lock-ruleref-face 'face-alias 'antlr-ruleref) -(put 'antlr-font-lock-ruleref-face 'obsolete-face "22.1") -(defvar antlr-tokenref-face 'antlr-tokenref) (defface antlr-tokenref '((((class color) (background light)) (:foreground "orange4")) (t :inherit font-lock-type-face)) "ANTLR token references (usage)." :group 'antlr) -;; backward-compatibility alias -(put 'antlr-font-lock-tokenref-face 'face-alias 'antlr-tokenref) -(put 'antlr-font-lock-tokenref-face 'obsolete-face "22.1") -(defvar antlr-literal-face 'antlr-literal) (defface antlr-literal (cond-emacs-xemacs '((((class color) (background light)) @@ -911,9 +882,6 @@ Do not change." It is used to highlight strings matched by the first regexp group of `antlr-font-lock-literal-regexp'." :group 'antlr) -;; backward-compatibility alias -(put 'antlr-font-lock-literal-face 'face-alias 'antlr-literal) -(put 'antlr-font-lock-literal-face 'obsolete-face "22.1") (defcustom antlr-font-lock-literal-regexp "\"\\(\\sw\\(\\sw\\|-\\)*\\)\"" "Regexp matching literals with special syntax highlighting, or nil. @@ -932,56 +900,58 @@ group. The string matched by the first group is highlighted with (cond-emacs-xemacs `((antlr-invalidate-context-cache) ("\\$setType[ \t]*(\\([A-Za-z\300-\326\330-\337]\\sw*\\))" - (1 antlr-tokendef-face)) - ("\\$\\sw+" (0 antlr-keyword-face)) + (1 'antlr-tokendef)) + ("\\$\\sw+" (0 'antlr-keyword)) ;; the tokens are already fontified as string/docstrings: (,(lambda (limit) (if antlr-font-lock-literal-regexp (antlr-re-search-forward antlr-font-lock-literal-regexp limit))) - (1 antlr-literal-face t) + (1 'antlr-literal t) :XEMACS (0 nil)) ; XEmacs bug workaround (,(lambda (limit) (antlr-re-search-forward antlr-class-header-regexp limit)) - (1 antlr-keyword-face) - (2 antlr-ruledef-face) - (3 antlr-keyword-face) + (1 'antlr-keyword) + (2 'antlr-ruledef) + (3 'antlr-keyword) (4 (if (member (match-string 4) '("Lexer" "Parser" "TreeParser")) - antlr-keyword-face - font-lock-type-face))) + 'antlr-keyword + 'font-lock-type-face))) (,(lambda (limit) (antlr-re-search-forward "\\<\\(header\\|options\\|tokens\\|exception\\|catch\\|returns\\)\\>" limit)) - (1 antlr-keyword-face)) + (1 'antlr-keyword)) (,(lambda (limit) (antlr-re-search-forward "^\\(private\\|public\\|protected\\)\\>[ \t]*\\(\\(\\sw+[ \t]*\\(:\\)?\\)\\)?" limit)) - (1 font-lock-type-face) ; not XEmacs's java level-3 fruit salad + (1 'font-lock-type-face) ; not XEmacs's java level-3 fruit salad (3 (if (antlr-upcase-p (char-after (match-beginning 3))) - antlr-tokendef-face - antlr-ruledef-face) nil t) - (4 antlr-syntax-face nil t)) + 'antlr-tokendef + 'antlr-ruledef) + nil t) + (4 'antlr-syntax nil t)) (,(lambda (limit) (antlr-re-search-forward "^\\(\\sw+\\)[ \t]*\\(:\\)?" limit)) (1 (if (antlr-upcase-p (char-after (match-beginning 0))) - antlr-tokendef-face - antlr-ruledef-face) nil t) - (2 antlr-syntax-face nil t)) + 'antlr-tokendef + 'antlr-ruledef) + nil t) + (2 'antlr-syntax nil t)) (,(lambda (limit) ;; v:ruleref and v:"literal" is allowed... (antlr-re-search-forward "\\(\\sw+\\)[ \t]*\\([=:]\\)?" limit)) (1 (if (match-beginning 2) (if (eq (char-after (match-beginning 2)) ?=) - antlr-default-face - font-lock-variable-name-face) + 'antlr-default + 'font-lock-variable-name-face) (if (antlr-upcase-p (char-after (match-beginning 1))) - antlr-tokenref-face - antlr-ruleref-face))) - (2 antlr-default-face nil t)) + 'antlr-tokenref + 'antlr-ruleref))) + (2 'antlr-default nil t)) (,(lambda (limit) (antlr-re-search-forward "[|&:;(~]\\|)\\([*+?]\\|=>\\)?" limit)) - (0 antlr-syntax-face)))) + (0 'antlr-syntax)))) "Font-lock keywords for ANTLR's normal grammar code. See `antlr-font-lock-keywords-alist' for the keywords of actions.") commit e5cdb5ce7d4ad96b7cd5ca7888e34076b9267eee Author: Daniel Colascione Date: Wed Nov 2 21:17:48 2016 -0700 Revert "Disable bracketed paste in a terminal in char mode" This change causes regressions, and besides, disabling BPM frame-wide for the sake of one buffer is the wrong solution. This reverts commit cf566b46a6cf85c6d54d0b0db80e32ed6ae8d1ca. diff --git a/lisp/term.el b/lisp/term.el index 5177ab4..c067254 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -1247,11 +1247,6 @@ intervention from Emacs, except for the escape character (usually C-c)." (end-of-line) (term-send-input)) (setq term-input-sender save-input-sender)))) - - ;; Turn off XTerm bracketed paste (Bug#24639). - (when (fboundp 'xterm-inhibit-bracketed-paste-mode) - (xterm-inhibit-bracketed-paste-mode)) - (term-update-mode-line))) (defun term-line-mode () @@ -1261,8 +1256,6 @@ you type \\[term-send-input] which sends the current line to the inferior." (interactive) (when (term-in-char-mode) (use-local-map term-old-mode-map) - (when (fboundp 'xterm-inhibit-bracketed-paste-mode) - (xterm-inhibit-bracketed-paste-mode 0)) (term-update-mode-line))) (defun term-update-mode-line () diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el index faf8991..01c0113 100644 --- a/lisp/term/xterm.el +++ b/lisp/term/xterm.el @@ -24,8 +24,6 @@ ;;; Code: -(require 'cl-lib) - (defgroup xterm nil "XTerm support." :version "24.1" @@ -767,78 +765,6 @@ We run the first FUNCTION whose STRING matches the input events." basemap (make-composed-keymap map (keymap-parent basemap)))) -(define-minor-mode xterm-inhibit-bracketed-paste-mode - "Toggle whether XTerm bracketed paste should be allowed in this buffer. -With a prefix argument ARG, forbid bracketed paste if ARG is -positive, and allow it otherwise. If called from Lisp, forbid -bracketed paste if ARG is omitted or nil, and toggle the state of -ARG is `toggle'. If XTerm bracketed paste is allowed (the -default), it will be used to paste text from an X selection upon -reception of the `xterm-paste' event. Otherwise the selection -will be inserted character by character, which is much slower. -Therefore, bracketed paste should only be disabled in buffers -that can't deal with the `xterm-paste' event, such as terminal -emulation buffers." - :group xterm - ;; Update the bracketed paste flag in all terminals that display the - ;; current buffer. - (mapc #'xterm--update-bracketed-paste (xterm--buffer-terminals))) - -(defun xterm--buffer-terminals (&optional buffer) - "Return all terminals that contain a window that displays BUFFER. -BUFFER defaults to the current buffer." - (cl-delete-duplicates - (cl-loop for window in (get-buffer-window-list buffer nil t) - for terminal = (frame-terminal (window-frame window)) - collect terminal) - :test 'eq)) - -(defun xterm--update-bracketed-paste (&optional terminal) - "Enable or disable bracketed paste for TERMINAL. -TERMINAL must be a live terminal; it defaults to the terminal -displaying the selected frame. If any buffer displayed on the -frames of TERMINAL inhibits bracketed paste by enabling -`xterm-inhibit-bracketed-paste-mode', disable bracketed paste for -TERMINAL. If there is no such buffer, enable bracketed paste." - (unless terminal (setq terminal (frame-terminal))) - (cl-check-type terminal terminal-live) - (when (xterm--is-xterm terminal) - (cl-symbol-macrolet - ((enabled-param (terminal-parameter terminal 'xterm--bracketed-paste)) - (set-strings-param (terminal-parameter terminal 'tty-mode-set-strings)) - (reset-strings-param - (terminal-parameter terminal 'tty-mode-reset-strings))) - (let ((is-enabled enabled-param) - (should-enable (xterm--bracketed-paste-possible terminal)) - (enable-seq "\e[?2004h") - (disable-seq "\e[?2004l")) - (cond - ;; Unconditionally send terminal sequences: terminals that - ;; don't support bracketed paste just ignore the sequences. - ((and (not is-enabled) should-enable) - (send-string-to-terminal enable-seq terminal) - (push disable-seq reset-strings-param) - (push enable-seq set-strings-param) - (setq enabled-param t)) - ((and is-enabled (not should-enable)) - (send-string-to-terminal disable-seq) - (cl-callf2 delete disable-seq reset-strings-param) - (cl-callf2 delete enable-seq set-strings-param) - (setq enabled-param nil))))))) - -(defun xterm--bracketed-paste-possible (terminal) - "Return non-nil if bracketed paste could be enabled on TERMINAL. -If any buffer displayed on the frames of TERMINAL inhibits -bracketed paste by enabling `xterm-inhibit-bracketed-paste-mode', -return nil. If there is no such buffer, return non-nil." - (cl-check-type terminal terminal-live) - (cl-loop for frame being the frames - if (eq (frame-terminal frame) terminal) - always (cl-loop - for window being the windows of frame - never (buffer-local-value 'xterm-inhibit-bracketed-paste-mode - (window-buffer window))))) - (defun terminal-init-xterm () "Terminal initialization function for xterm." ;; rxvt terminals sometimes set the TERM variable to "xterm", but @@ -876,8 +802,9 @@ return nil. If there is no such buffer, return non-nil." (when (memq 'setSelection xterm-extra-capabilities) (xterm--init-activate-set-selection))) - (add-hook 'window-configuration-change-hook #'xterm--update-bracketed-paste) - (xterm--update-bracketed-paste) + ;; Unconditionally enable bracketed paste mode: terminals that don't + ;; support it just ignore the sequence. + (xterm--init-bracketed-paste-mode) (run-hooks 'terminal-init-xterm-hook)) @@ -887,6 +814,12 @@ return nil. If there is no such buffer, return non-nil." (push "\e[>4m" (terminal-parameter nil 'tty-mode-reset-strings)) (push "\e[>4;1m" (terminal-parameter nil 'tty-mode-set-strings))) +(defun xterm--init-bracketed-paste-mode () + "Terminal initialization for bracketed paste mode." + (send-string-to-terminal "\e[?2004h") + (push "\e[?2004l" (terminal-parameter nil 'tty-mode-reset-strings)) + (push "\e[?2004h" (terminal-parameter nil 'tty-mode-set-strings))) + (defun xterm--init-activate-get-selection () "Terminal initialization for `gui-get-selection'." (set-terminal-parameter nil 'xterm--get-selection t)) @@ -1067,11 +1000,6 @@ versions of xterm." (set-terminal-parameter nil 'background-mode 'dark) t)) -(defun xterm--is-xterm (&optional terminal) - "Return non-nil if TERMINAL is an XTerm-like terminal. -TERMINAL defaults to the terminal of the selected frame." - (eq (terminal-parameter terminal 'terminal-initted) 'terminal-init-xterm)) - (provide 'xterm) ;Backward compatibility. (provide 'term/xterm) ;;; xterm.el ends here commit 722e7989fa2efa53a4a4e14e3f358a5b56f3eddd Author: Mark Oteiza Date: Wed Nov 2 16:23:48 2016 -0400 ; Require eieio at run time diff --git a/lisp/auth-source.el b/lisp/auth-source.el index 5254d77..13836aa 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -41,9 +41,8 @@ (require 'password-cache) -(eval-when-compile - (require 'cl-lib) - (require 'eieio)) +(eval-when-compile (require 'cl-lib)) +(require 'eieio) (autoload 'secrets-create-item "secrets") (autoload 'secrets-delete-item "secrets") commit 62a6e28e0cc2f7f652f2944a78c88a07051dbeae Author: Mark Oteiza Date: Wed Nov 2 16:18:49 2016 -0400 Revert change to eww-suggest-uris The introduced append is ugly and can yield '(nil); doing delq on it would be hacks on hacks. * lisp/net/eww.el: Require cl-lib at run time. (eww-suggest-uris): Restore eww-current-url, reverting previous change. (eww): Remove erroneous append. (eww-open-in-new-buffer): Check if the return from eww-suggested-uris is equal to eww-current-url, which is nil anyways if we are not in an EWW buffer. diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 5310a81..a5b3ce3 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -24,7 +24,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(require 'cl-lib) (require 'format-spec) (require 'shr) (require 'url) @@ -64,16 +64,18 @@ ;;;###autoload (defcustom eww-suggest-uris '(eww-links-at-point - url-get-url-at-point) + url-get-url-at-point + eww-current-url) "List of functions called to form the list of default URIs for `eww'. Each of the elements is a function returning either a string or a list of strings. The results will be joined into a single list with duplicate entries (if any) removed." - :version "26.1" + :version "25.1" :group 'eww :type 'hook :options '(eww-links-at-point - url-get-url-at-point)) + url-get-url-at-point + eww-current-url)) (defcustom eww-bookmarks-directory user-emacs-directory "Directory where bookmark files will be stored." @@ -244,7 +246,7 @@ This list can be customized via `eww-suggest-uris'." If the input doesn't look like an URL or a domain name, the word(s) will be searched for via `eww-search-prefix'." (interactive - (let* ((uris (append (eww-suggested-uris) (list (eww-current-url)))) + (let* ((uris (eww-suggested-uris)) (prompt (concat "Enter URL or keywords" (if uris (format " (default %s)" (car uris)) "") ": "))) @@ -322,7 +324,9 @@ See the `eww-search-prefix' variable for the search engine used." (with-current-buffer (if (eq major-mode 'eww-mode) (clone-buffer) (generate-new-buffer "*eww*")) - (eww (if (consp url) (car url) url)))))) + (unless (equal url (eww-current-url)) + (eww-mode) + (eww (if (consp url) (car url) url))))))) (defun eww-html-p (content-type) "Return non-nil if CONTENT-TYPE designates an HTML content type. commit bbc218b9b06d952f0ba31f7706d88c0bf8dc41d8 Author: Mark Oteiza Date: Wed Nov 2 15:58:28 2016 -0400 Add eww-open-in-new-buffer to EWW * doc/misc/eww.texi (Basic): Document new command and key. * etc/NEWS: Mention new key and its purpose. * lisp/net/eww.el (eww-suggest-uris): Remove eww-current-url. (eww): Append (eww-current-url) to the prompt defaults. (eww-open-in-new-buffer): New command. (eww-mode-map): Bind it and add a menu item. diff --git a/doc/misc/eww.texi b/doc/misc/eww.texi index 81f97a9..ea25863 100644 --- a/doc/misc/eww.texi +++ b/doc/misc/eww.texi @@ -97,6 +97,12 @@ and the web page is rendered in it. You can leave EWW by pressing web page hit @kbd{g} (@code{eww-reload}). Pressing @kbd{w} (@code{eww-copy-page-url}) will copy the current URL to the kill ring. +@findex eww-open-in-new-buffer +@kindex M-RET + The @kbd{M-RET} command (@code{eww-open-in-new-buffer}) opens the +URL at point in a new EWW buffer, akin to opening a link in a new +``tab'' in other browsers. + @findex eww-readable @kindex R The @kbd{R} command (@code{eww-readable}) will attempt to determine diff --git a/etc/NEWS b/etc/NEWS index e29dfe2..9a671f2 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -330,6 +330,9 @@ with blank space to eshell history. ** eww +++ +*** New 'M-RET' command for opening a link at point in a new eww buffer. + ++++ *** A new 's' command for switching to another eww buffer via the minibuffer. --- diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 6a84003..5310a81 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -64,18 +64,16 @@ ;;;###autoload (defcustom eww-suggest-uris '(eww-links-at-point - url-get-url-at-point - eww-current-url) + url-get-url-at-point) "List of functions called to form the list of default URIs for `eww'. Each of the elements is a function returning either a string or a list of strings. The results will be joined into a single list with duplicate entries (if any) removed." - :version "25.1" + :version "26.1" :group 'eww :type 'hook :options '(eww-links-at-point - url-get-url-at-point - eww-current-url)) + url-get-url-at-point)) (defcustom eww-bookmarks-directory user-emacs-directory "Directory where bookmark files will be stored." @@ -246,7 +244,7 @@ This list can be customized via `eww-suggest-uris'." If the input doesn't look like an URL or a domain name, the word(s) will be searched for via `eww-search-prefix'." (interactive - (let* ((uris (eww-suggested-uris)) + (let* ((uris (append (eww-suggested-uris) (list (eww-current-url)))) (prompt (concat "Enter URL or keywords" (if uris (format " (default %s)" (car uris)) "") ": "))) @@ -314,6 +312,18 @@ See the `eww-search-prefix' variable for the search engine used." (interactive "r") (eww (buffer-substring beg end))) +(defun eww-open-in-new-buffer () + "Fetch link at point in a new EWW buffer." + (interactive) + (let ((url (eww-suggested-uris))) + (if (null url) (user-error "No link at point") + ;; clone useful to keep history, but + ;; should not clone from non-eww buffer + (with-current-buffer + (if (eq major-mode 'eww-mode) (clone-buffer) + (generate-new-buffer "*eww*")) + (eww (if (consp url) (car url) url)))))) + (defun eww-html-p (content-type) "Return non-nil if CONTENT-TYPE designates an HTML content type. Currently this means either text/html or application/xhtml+xml." @@ -697,6 +707,7 @@ the like." (let ((map (make-sparse-keymap))) (define-key map "g" 'eww-reload) ;FIXME: revert-buffer-function instead! (define-key map "G" 'eww) + (define-key map [?\M-\r] 'eww-open-in-new-buffer) (define-key map [?\t] 'shr-next-link) (define-key map [?\M-\t] 'shr-previous-link) (define-key map [backtab] 'shr-previous-link) @@ -731,6 +742,7 @@ the like." ["Exit" quit-window t] ["Close browser" quit-window t] ["Reload" eww-reload t] + ["Follow URL in new buffer" eww-open-in-new-buffer] ["Back to previous page" eww-back-url :active (not (zerop (length eww-history)))] ["Forward to next page" eww-forward-url commit 3f06795181fb09aebaadfe592e7741ddc8ff8adf Author: Mark Oteiza Date: Wed Nov 2 14:56:40 2016 -0400 Migrate auth-source to cl-lib * lisp/auth-source.el: Use cl-lib. (auth-source-read-char-choice, auth-source-backend-parse-parameters): (auth-source-search): Replace cl calls with cl-lib ones. (auth-source-netrc-cache): (auth-source-forget+): Use cl-do-symbols instead. (auth-source-specmatchp, auth-source-netrc-parse): (auth-source-netrc-search, auth-source-netrc-create): (auth-source-netrc-saver, auth-source-secrets-listify-pattern): (auth-source-secrets-search, auth-source-secrets-create): (auth-source-macos-keychain-search, auth-source--decode-octal-string): (auth-source-macos-keychain-search-items, auth-source-plstore-search): (auth-source-plstore-create): Replace cl calls with cl-lib ones. diff --git a/lisp/auth-source.el b/lisp/auth-source.el index 9e1f468..5254d77 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -41,8 +41,9 @@ (require 'password-cache) -(eval-when-compile (require 'cl)) -(require 'eieio) +(eval-when-compile + (require 'cl-lib) + (require 'eieio)) (autoload 'secrets-create-item "secrets") (autoload 'secrets-delete-item "secrets") @@ -363,8 +364,8 @@ Only one of CHOICES will be returned. The PROMPT is augmented with \"[a/b/c] \" if CHOICES is \(?a ?b ?c)." (when choices (let* ((prompt-choices - (apply #'concat (loop for c in choices - collect (format "%c/" c)))) + (apply #'concat + (cl-loop for c in choices collect (format "%c/" c)))) (prompt-choices (concat "[" (substring prompt-choices 0 -1) "] ")) (full-prompt (concat prompt prompt-choices)) k) @@ -538,10 +539,9 @@ parameters." ;; (mapcar 'auth-source-backend-parse auth-sources) -(defun* auth-source-search (&rest spec - &key max - require create delete - &allow-other-keys) +(cl-defun auth-source-search (&rest spec + &key max require create delete + &allow-other-keys) "Search or modify authentication backends according to SPEC. This function parses `auth-sources' for matches of the SPEC @@ -681,9 +681,9 @@ must call it to obtain the actual value." (let* ((backends (mapcar #'auth-source-backend-parse auth-sources)) (max (or max 1)) (ignored-keys '(:require :create :delete :max)) - (keys (loop for i below (length spec) by 2 - unless (memq (nth i spec) ignored-keys) - collect (nth i spec))) + (keys (cl-loop for i below (length spec) by 2 + unless (memq (nth i spec) ignored-keys) + collect (nth i spec))) (cached (auth-source-remembered-p spec)) ;; note that we may have cached results but found is still nil ;; (there were no results from the search) @@ -695,11 +695,11 @@ must call it to obtain the actual value." "auth-source-search: found %d CACHED results matching %S" (length found) spec) - (assert + (cl-assert (or (eq t create) (listp create)) t "Invalid auth-source :create parameter (must be t or a list): %s %s") - (assert + (cl-assert (listp require) t "Invalid auth-source :require parameter (must be a list): %s") @@ -712,7 +712,7 @@ must call it to obtain the actual value." (plist-get spec key) (slot-value backend key)) (setq filtered-backends (delq backend filtered-backends)) - (return)) + (cl-return)) (invalid-slot-name nil)))) (auth-source-do-trivia @@ -812,12 +812,9 @@ Returns the deleted entries." (defun auth-source-forget-all-cached () "Forget all cached auth-source data." (interactive) - (loop for sym being the symbols of password-data - ;; when the symbol name starts with auth-source-magic - when (string-match (concat "^" auth-source-magic) - (symbol-name sym)) - ;; remove that key - do (password-cache-remove (symbol-name sym))) + (cl-do-symbols (sym password-data) + (when (string-match (concat "^" auth-source-magic) (symbol-name sym)) + (password-cache-remove (symbol-name sym)))) (setq auth-source-netrc-cache nil)) (defun auth-source-format-cache-entry (spec) @@ -866,27 +863,26 @@ cached data that was found with a search for those two hosts, while \(:host t) would find all host entries." (let ((count 0) sname) - (loop for sym being the symbols of password-data - ;; when the symbol name matches with auth-source-magic - when (and (setq sname (symbol-name sym)) - (string-match (concat "^" auth-source-magic "\\(.+\\)") - sname) - ;; and the spec matches what was stored in the cache - (auth-source-specmatchp spec (read (match-string 1 sname)))) - ;; remove that key - do (progn - (password-cache-remove sname) - (incf count))) + (cl-do-symbols (sym password-data) + ;; when the symbol name matches with auth-source-magic + (when (and (setq sname (symbol-name sym)) + (string-match (concat "^" auth-source-magic "\\(.+\\)") + sname) + ;; and the spec matches what was stored in the cache + (auth-source-specmatchp spec (read (match-string 1 sname)))) + ;; remove that key + (password-cache-remove sname) + (cl-incf count))) count)) (defun auth-source-specmatchp (spec stored) - (let ((keys (loop for i below (length spec) by 2 - collect (nth i spec)))) + (let ((keys (cl-loop for i below (length spec) by 2 + collect (nth i spec)))) (not (eq - (dolist (key keys) + (cl-dolist (key keys) (unless (auth-source-search-collection (plist-get stored key) (plist-get spec key)) - (return 'no))) + (cl-return 'no))) 'no)))) ;; (auth-source-pick-first-password :host "z.lifelogs.com") @@ -941,8 +937,8 @@ while \(:host t) would find all host entries." (cdr (assoc key alist))) ;; (auth-source-netrc-parse :file "~/.authinfo.gpg") -(defun* auth-source-netrc-parse (&key file max host user port require - &allow-other-keys) +(cl-defun auth-source-netrc-parse (&key file max host user port require + &allow-other-keys) "Parse FILE and return a list of all entries in the file. Note that the MAX parameter is used so we can exit the parse early." (if (listp file) @@ -983,8 +979,8 @@ Note that the MAX parameter is used so we can exit the parse early." ;; every element of require is in n(ormalized) (let ((n (nth 0 (auth-source-netrc-normalize (list alist) file)))) - (loop for req in require - always (plist-get n req))))))) + (cl-loop for req in require + always (plist-get n req))))))) result) (if (and (functionp cached-secrets) @@ -1199,16 +1195,15 @@ FILE is the file from which we obtained this token." ;; (setq secret (plist-get (nth 0 (auth-source-search :host t :type 'netrc :K 1 :max 1)) :secret)) ;; (funcall secret) -(defun* auth-source-netrc-search (&rest - spec - &key backend require create - type max host user port - &allow-other-keys) +(cl-defun auth-source-netrc-search (&rest spec + &key backend require create + type max host user port + &allow-other-keys) "Given a property list SPEC, return search matches from the :backend. See `auth-source-search' for details on SPEC." ;; just in case, check that the type is correct (null or same as the backend) - (assert (or (null type) (eq type (oref backend type))) - t "Invalid netrc search: %s %s") + (cl-assert (or (null type) (eq type (oref backend type))) + t "Invalid netrc search: %s %s") (let ((results (auth-source-netrc-normalize (auth-source-netrc-parse @@ -1245,10 +1240,9 @@ See `auth-source-search' for details on SPEC." ;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t) ;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t :create-extra-keys '((A "default A") (B))) -(defun* auth-source-netrc-create (&rest spec - &key backend - host port create - &allow-other-keys) +(cl-defun auth-source-netrc-create (&rest spec + &key backend host port create + &allow-other-keys) (let* ((base-required '(host user port secret)) ;; we know (because of an assertion in auth-source-search) that the ;; :create parameter is either t or a list (which includes nil) @@ -1281,8 +1275,8 @@ See `auth-source-search' for details on SPEC." ;; for extra required elements, see if the spec includes a value for them (dolist (er create-extra) (let ((k (auth-source--symbol-keyword er)) - (keys (loop for i below (length spec) by 2 - collect (nth i spec)))) + (keys (cl-loop for i below (length spec) by 2 + collect (nth i spec)))) (when (memq k keys) (auth-source--aput valist er (plist-get spec k))))) @@ -1323,7 +1317,7 @@ See `auth-source-search' for details on SPEC." (plist-get artificial :port) "[any port]")))) (prompt (or (auth-source--aget auth-source-creation-prompts r) - (case r + (cl-case r (secret "%p password for %u@%h: ") (user "%p user name for %h: ") (host "%p host name for user %u: ") @@ -1400,7 +1394,7 @@ See `auth-source-search' for details on SPEC." ;; prepend a space (if (zerop (length add)) "" " ") ;; remap auth-source tokens to netrc - (case r + (cl-case r (user "login") (host "machine") (secret "password") @@ -1454,7 +1448,7 @@ Respects `auth-source-save-behavior'. Uses k) (while (not done) (setq k (auth-source-read-char-choice prompt '(?y ?n ?N ?e ??))) - (case k + (cl-case k (?y (setq done t)) (?? (save-excursion (with-output-to-temp-buffer bufname @@ -1526,17 +1520,12 @@ list, it matches the original pattern." (heads (if (stringp value) (list (list key value)) (mapcar (lambda (v) (list key v)) value)))) - (loop - for h in heads - nconc - (loop - for tl in tails - collect (append h tl)))))) - -(defun* auth-source-secrets-search (&rest - spec - &key backend create delete label max - &allow-other-keys) + (cl-loop for h in heads + nconc (cl-loop for tl in tails collect (append h tl)))))) + +(cl-defun auth-source-secrets-search (&rest spec + &key backend create delete label max + &allow-other-keys) "Search the Secrets API; spec is like `auth-source'. The :label key specifies the item's label. It is the only key @@ -1569,19 +1558,19 @@ authentication tokens: " ;; TODO - (assert (not create) nil - "The Secrets API auth-source backend doesn't support creation yet") + (cl-assert (not create) nil + "The Secrets API auth-source backend doesn't support creation yet") ;; TODO ;; (secrets-delete-item coll elt) - (assert (not delete) nil - "The Secrets API auth-source backend doesn't support deletion yet") + (cl-assert (not delete) nil + "The Secrets API auth-source backend doesn't support deletion yet") (let* ((coll (oref backend source)) (max (or max 5000)) ; sanity check: default to stop at 5K (ignored-keys '(:create :delete :max :backend :label :require :type)) - (search-keys (loop for i below (length spec) by 2 - unless (memq (nth i spec) ignored-keys) - collect (nth i spec))) + (search-keys (cl-loop for i below (length spec) by 2 + unless (memq (nth i spec) ignored-keys) + collect (nth i spec))) ;; build a search spec without the ignored keys ;; if a search key is nil or t (match anything), we skip it (search-specs (auth-source-secrets-listify-pattern @@ -1597,12 +1586,13 @@ authentication tokens: '(:host :login :port :secret) search-keys))) (items - (loop for search-spec in search-specs - nconc - (loop for item in (apply #'secrets-search-items coll search-spec) - unless (and (stringp label) - (not (string-match label item))) - collect item))) + (cl-loop + for search-spec in search-specs + nconc + (cl-loop for item in (apply #'secrets-search-items coll search-spec) + unless (and (stringp label) + (not (string-match label item))) + collect item))) ;; TODO: respect max in `secrets-search-items', not after the fact (items (butlast items (- (length items) max))) ;; convert the item name to a full plist @@ -1653,11 +1643,9 @@ authentication tokens: ;; (let ((auth-sources '("macos-keychain-generic:Login"))) (auth-source-search :max 1 :host "git.gnus.org")) ;; (let ((auth-sources '("macos-keychain-generic:Login"))) (auth-source-search :max 1)) -(defun* auth-source-macos-keychain-search (&rest - spec - &key backend create delete - type max - &allow-other-keys) +(cl-defun auth-source-macos-keychain-search (&rest spec + &key backend create delete type max + &allow-other-keys) "Search the MacOS Keychain; spec is like `auth-source'. All search keys must match exactly. If you need substring @@ -1698,11 +1686,11 @@ entries for git.gnus.org: (auth-source-search :max 1 :host \"git.gnus.org\")) " ;; TODO - (assert (not create) nil + (cl-assert (not create) nil "The MacOS Keychain auth-source backend doesn't support creation yet") ;; TODO ;; (macos-keychain-delete-item coll elt) - (assert (not delete) nil + (cl-assert (not delete) nil "The MacOS Keychain auth-source backend doesn't support deletion yet") (let* ((coll (oref backend source)) @@ -1710,9 +1698,10 @@ entries for git.gnus.org: ;; Filter out ignored keys from the spec (ignored-keys '(:create :delete :max :backend :label :host :port)) ;; Build a search spec without the ignored keys - (search-keys (loop for i below (length spec) by 2 - unless (memq (nth i spec) ignored-keys) - collect (nth i spec))) + ;; FIXME make this loop a function? it's used in at least 3 places + (search-keys (cl-loop for i below (length spec) by 2 + unless (memq (nth i spec) ignored-keys) + collect (nth i spec))) ;; If a search key value is nil or t (match anything), we skip it (search-spec (apply #'append (mapcar (lambda (k) @@ -1765,21 +1754,19 @@ entries for git.gnus.org: (size (length string))) (decode-coding-string (apply #'unibyte-string - (loop for i = 0 then (+ i (if (eq (nth i list) ?\\) 4 1)) - for var = (nth i list) - while (< i size) - if (eq var ?\\) - collect (string-to-number - (concat (cl-subseq list (+ i 1) (+ i 4))) 8) - else - collect var)) + (cl-loop for i = 0 then (+ i (if (eq (nth i list) ?\\) 4 1)) + for var = (nth i list) + while (< i size) + if (eq var ?\\) + collect (string-to-number + (concat (cl-subseq list (+ i 1) (+ i 4))) 8) + else + collect var)) 'utf-8))) -(defun* auth-source-macos-keychain-search-items (coll _type _max - host port - &key label type - user - &allow-other-keys) +(cl-defun auth-source-macos-keychain-search-items (coll _type _max host port + &key label type user + &allow-other-keys) (let* ((keychain-generic (eq type 'macos-keychain-generic)) (args `(,(if keychain-generic "find-generic-password" @@ -1858,18 +1845,16 @@ entries for git.gnus.org: ;;; Backend specific parsing: PLSTORE backend -(defun* auth-source-plstore-search (&rest - spec - &key backend create delete - max - &allow-other-keys) +(cl-defun auth-source-plstore-search (&rest spec + &key backend create delete max + &allow-other-keys) "Search the PLSTORE; spec is like `auth-source'." (let* ((store (oref backend data)) (max (or max 5000)) ; sanity check: default to stop at 5K (ignored-keys '(:create :delete :max :backend :label :require :type)) - (search-keys (loop for i below (length spec) by 2 - unless (memq (nth i spec) ignored-keys) - collect (nth i spec))) + (search-keys (cl-loop for i below (length spec) by 2 + unless (memq (nth i spec) ignored-keys) + collect (nth i spec))) ;; build a search spec without the ignored keys ;; if a search key is nil or t (match anything), we skip it (search-spec (apply #'append (mapcar @@ -1934,10 +1919,9 @@ entries for git.gnus.org: (plstore-save store))) items)) -(defun* auth-source-plstore-create (&rest spec - &key backend - host port create - &allow-other-keys) +(cl-defun auth-source-plstore-create (&rest spec + &key backend host port create + &allow-other-keys) (let* ((base-required '(host user port secret)) (base-secret '(secret)) ;; we know (because of an assertion in auth-source-search) that the @@ -1970,8 +1954,8 @@ entries for git.gnus.org: ;; for extra required elements, see if the spec includes a value for them (dolist (er create-extra) (let ((k (auth-source--symbol-keyword er)) - (keys (loop for i below (length spec) by 2 - collect (nth i spec)))) + (keys (cl-loop for i below (length spec) by 2 + collect (nth i spec)))) (when (memq k keys) (auth-source--aput valist er (plist-get spec k))))) @@ -2012,7 +1996,7 @@ entries for git.gnus.org: (plist-get artificial :port) "[any port]")))) (prompt (or (auth-source--aget auth-source-creation-prompts r) - (case r + (cl-case r (secret "%p password for %u@%h: ") (user "%p user name for %h: ") (host "%p host name for user %u: ")