commit b313a9d6a8a6d2728c69db6ee823b9f7bdd938ca (HEAD, refs/remotes/origin/master) Author: Tassilo Horn Date: Fri Oct 30 08:06:31 2015 +0100 Add RefTeX feature idea: editing RefTeX TOC buffers diff --git a/etc/TODO b/etc/TODO index 87c53b6..946a4fe 100644 --- a/etc/TODO +++ b/etc/TODO @@ -1244,6 +1244,15 @@ systems for HTML/XML files automatically." **** Leverage char-displayable-p. +** RefTeX + +*** Provide a wdired-like mode for editing RefTeX TOC buffers. +As a first step, renaming of sections could be supported. Ultimately, +it would be great if it also supported moving sections, e.g., by +killing and yanking or providing org-mode like "move section +upwards/downwards" commands. However, that's not so easy in the +presence of multi-file documents. + * Internal changes ** Cleanup all the GC_ mark bit stuff -- there is no longer any distinction commit af77f5b1ec7aff888162679e1a9adb7b03402aa5 Author: Tassilo Horn Date: Fri Oct 30 07:51:52 2015 +0100 More face defs for ivy, swiper, ace-window, eshell diff --git a/etc/themes/tsdh-dark-theme.el b/etc/themes/tsdh-dark-theme.el index 1d4326e..1a899b2 100644 --- a/etc/themes/tsdh-dark-theme.el +++ b/etc/themes/tsdh-dark-theme.el @@ -20,11 +20,11 @@ ;;; Code: (deftheme tsdh-dark - "Minor tweaks to the Emacs dark-background defaults. -Used and created by Tassilo Horn.") + "A dark theme used and created by Tassilo Horn.") (custom-theme-set-faces 'tsdh-dark + '(aw-leading-char-face ((t (:background "gray30" :foreground "red" :weight bold)))) '(default ((t (:background "gray20" :foreground "white smoke")))) '(diff-added ((t (:inherit diff-changed :background "dark green"))) t) '(diff-changed ((t (:background "midnight blue"))) t) @@ -34,6 +34,7 @@ Used and created by Tassilo Horn.") '(diff-removed ((t (:inherit diff-changed :background "dark red"))) t) '(dired-directory ((t (:foreground "DodgerBlue" :weight bold)))) '(error ((t (:foreground "deep pink" :weight bold)))) + '(eshell-prompt ((t (:inherit font-lock-function-name-face :weight bold)))) '(font-lock-builtin-face ((t (:foreground "chartreuse2")))) '(font-lock-comment-face ((t (:foreground "peru")))) '(font-lock-constant-face ((t (:foreground "dodger blue")))) @@ -44,7 +45,7 @@ Used and created by Tassilo Horn.") '(font-lock-string-face ((t (:foreground "light salmon")))) '(font-lock-type-face ((t (:foreground "medium purple")))) '(font-lock-variable-name-face ((t (:foreground "yellow green")))) - '(font-lock-warning-face ((t (:foreground "hot pink")))) + '(font-lock-warning-face ((t (:foreground "hot pink" :weight bold)))) '(gnus-button ((t (:inherit button)))) '(gnus-cite-1 ((t (:foreground "dark turquoise"))) t) '(gnus-group-mail-1 ((t (:inherit gnus-group-mail-1-empty :weight bold)))) @@ -68,6 +69,11 @@ Used and created by Tassilo Horn.") '(ido-first-match ((t (:foreground "turquoise" :weight bold)))) '(ido-only-match ((t (:foreground "medium spring green" :weight bold)))) '(ido-subdir ((t (:inherit dired-directory :weight normal)))) + '(ivy-current-match ((t (:inherit highlight)))) + '(ivy-minibuffer-match-face-1 ((t (:background "CadetBlue4" :weight bold)))) + '(ivy-minibuffer-match-face-2 ((t (:background "gold3" :weight bold)))) + '(ivy-minibuffer-match-face-4 ((t (:background "forest green" :weight bold)))) + '(ivy-remote ((t (:foreground "deep sky blue" :slant italic)))) '(lusty-file-face ((t (:foreground "SpringGreen1"))) t) '(magit-header ((t (:box 1 :weight bold)))) '(magit-section-title ((t (:inherit magit-header :background "dark slate blue")))) @@ -115,6 +121,7 @@ Used and created by Tassilo Horn.") '(secondary-selection ((t (:background "#333366" :foreground "#f6f3e8")))) '(show-paren-match ((t (:background "DeepSkyBlue4")))) '(show-paren-mismatch ((t (:background "dark magenta")))) + '(swiper-match-face-1 ((t (:background "gray35")))) '(th-sentence-hl-face ((t (:weight bold)))) '(widget-field ((t (:box (:line-width 2 :color "grey75" :style pressed-button))))) '(window-number-face ((t (:foreground "red" :weight bold))))) commit e4740877d6feeb357d7437e6025dba641800c11d Author: Stefan Monnier Date: Thu Oct 29 23:18:34 2015 -0400 * lisp/gnus/auth-source.el: Silence lexical-binding warnings (auth-source-netrc-use-gpg-tokens): Simplify (symbol-value 'VAR) to just VAR. (auth-source-backend-parse): Use make-instance. (auth-source-search): Remove unused key args. Remove unused vars `accessor-key' and `backend'. Avoid `eval'. (auth-source-search-backends): Use slot names rather than their initarg. (auth-source-netrc-create): (auth-source-delete): (auth-source-secrets-create, auth-source-plstore-search) (auth-source-macos-keychain-create, auth-source-macos-keychain-search) (auth-source-plstore-create, auth-source-netrc-search) (auth-source-netrc-parse): Remove unused key args. (auth-source-forget+): Simplify the arglist. (auth-source-macos-keychain-search-items) (auth-source-token-passphrase-callback-function): Mark unused args. (auth-source-epa-extract-gpg-token): Remove unused var `plain'. (pp-escape-newlines): Declare. (auto-source--symbol-keyword): New function. (auth-source-plstore-create, auth-source-netrc-create) (auth-source-netrc-normalize): Use it. (auth-source-netrc-search): Don't pass :delete to auth-source-netrc-parse since it doesn't use it. (auth-source-plstore-create, auth-source-netrc-create): Use plist-get symbol-value to index in keyword args. (auth-source-macos-keychain-result-append): Avoid setq. (auth-source-netrc-create): Remove unused vars `file' and `add'. (auth-source-user-or-password): Remove unused var `cname'. diff --git a/lisp/gnus/auth-source.el b/lisp/gnus/auth-source.el index 304bfa9..9d842c0 100644 --- a/lisp/gnus/auth-source.el +++ b/lisp/gnus/auth-source.el @@ -159,6 +159,7 @@ let-binding." auth-source-protocols)) (defvar auth-source-creation-defaults nil + ;; FIXME: AFAICT this is not set (or let-bound) anywhere! "Defaults for creating token values. Usually let-bound.") (defvar auth-source-creation-prompts nil @@ -176,7 +177,7 @@ let-binding." (const :tag "Never save" nil) (const :tag "Ask" ask))) -;; TODO: make the default (setq auth-source-netrc-use-gpg-tokens `((,(if (boundp 'epa-file-auto-mode-alist-entry) (car (symbol-value 'epa-file-auto-mode-alist-entry)) "\\.gpg\\'") never) (t gpg))) +;; TODO: make the default (setq auth-source-netrc-use-gpg-tokens `((,(if (boundp 'epa-file-auto-mode-alist-entry) (car epa-file-auto-mode-alist-entry) "\\.gpg\\'") never) (t gpg))) ;; TODO: or maybe leave as (setq auth-source-netrc-use-gpg-tokens 'never) (defcustom auth-source-netrc-use-gpg-tokens 'never @@ -194,8 +195,7 @@ Note that if EPA/EPG is not available, this should NOT be used." (const :tag "Match anything" t) (const :tag "The EPA encrypted file extensions" ,(if (boundp 'epa-file-auto-mode-alist-entry) - (car (symbol-value - 'epa-file-auto-mode-alist-entry)) + (car epa-file-auto-mode-alist-entry) "\\.gpg\\'")) (regexp :tag "Regular expression")) (choice :tag "What to do" @@ -448,15 +448,15 @@ with \"[a/b/c] \" if CHOICES is \(?a ?b ?c)." (plist-get entry :source) :source (plist-get entry :source) :type 'plstore - :search-function 'auth-source-plstore-search - :create-function 'auth-source-plstore-create + :search-function #'auth-source-plstore-search + :create-function #'auth-source-plstore-create :data (plstore-open (plist-get entry :source))) (auth-source-backend (plist-get entry :source) :source (plist-get entry :source) :type 'netrc - :search-function 'auth-source-netrc-search - :create-function 'auth-source-netrc-create))) + :search-function #'auth-source-netrc-search + :create-function #'auth-source-netrc-create))) ;; the MacOS Keychain ((and @@ -482,8 +482,8 @@ with \"[a/b/c] \" if CHOICES is \(?a ?b ?c)." (format "Mac OS Keychain (%s)" source) :source source :type keychain-type - :search-function 'auth-source-macos-keychain-search - :create-function 'auth-source-macos-keychain-create))) + :search-function #'auth-source-macos-keychain-search + :create-function #'auth-source-macos-keychain-create))) ;; the Secrets API. We require the package, in order to have a ;; defined value for `secrets-enabled'. @@ -509,8 +509,8 @@ with \"[a/b/c] \" if CHOICES is \(?a ?b ?c)." (format "Secrets API (%s)" source) :source source :type 'secrets - :search-function 'auth-source-secrets-search - :create-function 'auth-source-secrets-create) + :search-function #'auth-source-secrets-search + :create-function #'auth-source-secrets-create) (auth-source-do-warn "auth-source-backend-parse: no Secrets API, ignoring spec: %S" entry) (auth-source-backend @@ -522,8 +522,7 @@ with \"[a/b/c] \" if CHOICES is \(?a ?b ?c)." (t (auth-source-do-warn "auth-source-backend-parse: invalid backend spec: %S" entry) - (auth-source-backend - "Empty" + (make-instance 'auth-source-backend :source "" :type 'ignore))))) @@ -546,7 +545,7 @@ parameters." ;; (mapcar 'auth-source-backend-parse auth-sources) (defun* auth-source-search (&rest spec - &key type max host user port secret + &key max require create delete &allow-other-keys) "Search or modify authentication backends according to SPEC. @@ -695,7 +694,7 @@ must call it to obtain the actual value." ;; note that we may have cached results but found is still nil ;; (there were no results from the search) (found (auth-source-recall spec)) - filtered-backends accessor-key backend) + filtered-backends) (if (and cached auth-source-do-cache) (auth-source-do-debug @@ -714,13 +713,13 @@ must call it to obtain the actual value." (dolist (backend backends) (dolist (key keys) ;; ignore invalid slots - (condition-case signal - (unless (eval `(auth-source-search-collection - (plist-get spec key) - (oref backend ,key))) + (condition-case nil + (unless (auth-source-search-collection + (plist-get spec key) + (slot-value backend key)) (setq filtered-backends (delq backend filtered-backends)) (return)) - (invalid-slot-name)))) + (invalid-slot-name nil)))) (auth-source-do-trivia "auth-source-search: found %d backends matching %S" @@ -771,7 +770,7 @@ must call it to obtain the actual value." (let* ((bmatches (apply (slot-value backend 'search-function) :backend backend - :type (slot-value backend :type) + :type (slot-value backend 'type) ;; note we're overriding whatever the spec ;; has for :max, :require, :create, and :delete :max max @@ -783,8 +782,8 @@ must call it to obtain the actual value." (auth-source-do-trivia "auth-source-search-backend: got %d (max %d) in %s:%s matching %S" (length bmatches) max - (slot-value backend :type) - (slot-value backend :source) + (slot-value backend 'type) + (slot-value backend 'source) spec) (setq matches (append matches bmatches)))))) matches)) @@ -795,9 +794,7 @@ must call it to obtain the actual value." ;; (auth-source-search :host "nonesuch" :type 'netrc :K 1) ;; (auth-source-search :host "nonesuch" :type 'secrets) -(defun* auth-source-delete (&rest spec - &key delete - &allow-other-keys) +(defun auth-source-delete (&rest spec) "Delete entries from the authentication backends according to SPEC. Calls `auth-source-search' with the :delete property in SPEC set to t. The backend may not actually delete the entries. @@ -866,7 +863,7 @@ Returns t or nil for forgotten or not found." ;; (auth-source-recall '(:host t)) ;; (auth-source-forget+ :host t) -(defun* auth-source-forget+ (&rest spec &allow-other-keys) +(defun auth-source-forget+ (&rest spec) "Forget any cached data matching SPEC. Returns forgotten count. This is not a full `auth-source-search' spec but works similarly. @@ -948,9 +945,7 @@ while \(:host t) would find all host entries." (cdr (assoc key alist))) ;; (auth-source-netrc-parse :file "~/.authinfo.gpg") -(defun* auth-source-netrc-parse (&rest - spec - &key file max host user port delete require +(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." @@ -1113,7 +1108,7 @@ Note that the MAX parameter is used so we can exit the parse early." (defvar auth-source-passphrase-alist nil) -(defun auth-source-token-passphrase-callback-function (context key-id file) +(defun auth-source-token-passphrase-callback-function (_context _key-id file) (let* ((file (file-truename file)) (entry (assoc file auth-source-passphrase-alist)) passphrase) @@ -1139,14 +1134,15 @@ Note that the MAX parameter is used so we can exit the parse early." FILE is the file from which we obtained this token." (when (string-match "^gpg:\\(.+\\)" secret) (setq secret (base64-decode-string (match-string 1 secret)))) - (let ((context (epg-make-context 'OpenPGP)) - plain) + (let ((context (epg-make-context 'OpenPGP))) (epg-context-set-passphrase-callback context (cons #'auth-source-token-passphrase-callback-function file)) (epg-decrypt-string context secret))) +(defvar pp-escape-newlines) + ;; (insert (auth-source-epa-make-gpg-token "mysecret" "~/.netrc")) (defun auth-source-epa-make-gpg-token (secret file) (let ((context (epg-make-context 'OpenPGP)) @@ -1165,6 +1161,9 @@ FILE is the file from which we obtained this token." (point-min) (point-max)))))) +(defun auto-source--symbol-keyword (symbol) + (intern (format ":%s" symbol))) + (defun auth-source-netrc-normalize (alist filename) (mapcar (lambda (entry) (let (ret item) @@ -1198,7 +1197,7 @@ FILE is the file from which we obtained this token." (setq lexv (funcall token-decoder lexv))) lexv)))) (setq ret (plist-put ret - (intern (concat ":" k)) + (auto-source--symbol-keyword k) v)))) ret)) alist)) @@ -1208,7 +1207,7 @@ FILE is the file from which we obtained this token." (defun* auth-source-netrc-search (&rest spec - &key backend require create delete + &key backend require create type max host user port &allow-other-keys) "Given a property list SPEC, return search matches from the :backend. @@ -1221,7 +1220,6 @@ See `auth-source-search' for details on SPEC." (auth-source-netrc-parse :max max :require require - :delete delete :file (oref backend source) :host (or host t) :user (or user t) @@ -1255,7 +1253,7 @@ See `auth-source-search' for details on SPEC." (defun* auth-source-netrc-create (&rest spec &key backend - secret host user port create + 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 @@ -1276,23 +1274,23 @@ See `auth-source-search' for details on SPEC." ;; fill in the valist with whatever data we may have from the search ;; we complete the first value if it's a list and use the value otherwise (dolist (br base-required) - (when (symbol-value br) - (let ((br-choice (cond - ;; all-accepting choice (predicate is t) - ((eq t (symbol-value br)) nil) - ;; just the value otherwise - (t (symbol-value br))))) - (when br-choice - (auth-source--aput valist br br-choice))))) + (let ((val (plist-get spec (auto-source--symbol-keyword br)))) + (when val + (let ((br-choice (cond + ;; all-accepting choice (predicate is t) + ((eq t val) nil) + ;; just the value otherwise + (t val)))) + (when br-choice + (auth-source--aput valist br br-choice)))))) ;; for extra required elements, see if the spec includes a value for them (dolist (er create-extra) - (let ((name (concat ":" (symbol-name er))) + (let ((k (auto-source--symbol-keyword er)) (keys (loop for i below (length spec) by 2 collect (nth i spec)))) - (dolist (k keys) - (when (equal (symbol-name k) name) - (auth-source--aput valist er (plist-get spec k)))))) + (when (memq k keys) + (auth-source--aput valist er (plist-get spec k))))) ;; for each required element (dolist (r required) @@ -1300,7 +1298,7 @@ See `auth-source-search' for details on SPEC." ;; take the first element if the data is a list (data (or (auth-source-netrc-element-or-first data) (plist-get current-data - (intern (format ":%s" r) obarray)))) + (auto-source--symbol-keyword r)))) ;; this is the default to be offered (given-default (auth-source--aget auth-source-creation-defaults r)) @@ -1347,7 +1345,7 @@ See `auth-source-search' for details on SPEC." (setq data (or data (if (eq r 'secret) ;; Special case prompt for passwords. - ;; TODO: make the default (setq auth-source-netrc-use-gpg-tokens `((,(if (boundp 'epa-file-auto-mode-alist-entry) (car (symbol-value 'epa-file-auto-mode-alist-entry)) "\\.gpg\\'") nil) (t gpg))) + ;; TODO: make the default (setq auth-source-netrc-use-gpg-tokens `((,(if (boundp 'epa-file-auto-mode-alist-entry) (car epa-file-auto-mode-alist-entry) "\\.gpg\\'") nil) (t gpg))) ;; TODO: or maybe leave as (setq auth-source-netrc-use-gpg-tokens 'never) (let* ((ep (format "Use GPG password tokens in %s?" file)) (gpg-encrypt @@ -1363,7 +1361,10 @@ See `auth-source-search' for details on SPEC." (when (or (eq (car item) t) (string-match (car item) file)) (setq ret (cdr item)) - (setq check nil))))) + (setq check nil))) + ;; FIXME: `ret' unused. + ;; Should we return it here? + )) (t 'never))) (plain (or (eval default) (read-passwd prompt)))) ;; ask if we don't know what to do (in which case @@ -1387,7 +1388,7 @@ See `auth-source-search' for details on SPEC." (when data (setq artificial (plist-put artificial - (intern (concat ":" (symbol-name r))) + (auto-source--symbol-keyword r) (if (eq r 'secret) (lexical-let ((data data)) (lambda () data)) @@ -1540,8 +1541,7 @@ list, it matches the original pattern." (defun* auth-source-secrets-search (&rest spec - &key backend create delete label - type max host user port + &key backend create delete label max &allow-other-keys) "Search the Secrets API; spec is like `auth-source'. @@ -1638,10 +1638,7 @@ authentication tokens: items))) items)) -(defun* auth-source-secrets-create (&rest - spec - &key backend type max host user port - &allow-other-keys) +(defun auth-source-secrets-create (&rest spec) ;; TODO ;; (apply 'secrets-create-item (auth-get-source entry) name passwd spec) (debug spec)) @@ -1664,8 +1661,8 @@ authentication tokens: (defun* auth-source-macos-keychain-search (&rest spec - &key backend create delete label - type max host user port + &key backend create delete + type max &allow-other-keys) "Search the MacOS Keychain; spec is like `auth-source'. @@ -1681,7 +1678,7 @@ For the internet keychain type, the :label key searches the item's labels (\"-l LABEL\" passed to \"/usr/bin/security\"). Similarly, :host maps to \"-s HOST\", :user maps to \"-a USER\", and :port maps to \"-P PORT\" or \"-r PROT\" -(note PROT has to be a 4-character string). +\(note PROT has to be a 4-character string). For the generic keychain type, the :label key searches the item's labels (\"-l LABEL\" passed to \"/usr/bin/security\"). @@ -1752,8 +1749,7 @@ entries for git.gnus.org: items))) items)) -(defun* auth-source-macos-keychain-search-items (coll type max - &rest spec +(defun* auth-source-macos-keychain-search-items (coll _type _max &key label type host user port &allow-other-keys) @@ -1815,22 +1811,19 @@ entries for git.gnus.org: (defun auth-source-macos-keychain-result-append (result generic k v) (push v result) - (setq k (cond - ((equal k "acct") "user") - ;; for generic keychains, creator is host, service is port - ((and generic (equal k "crtr")) "host") - ((and generic (equal k "svce")) "port") - ;; for internet keychains, protocol is port, server is host - ((and (not generic) (equal k "ptcl")) "port") - ((and (not generic) (equal k "srvr")) "host") - (t k))) - - (push (intern (format ":%s" k)) result)) - -(defun* auth-source-macos-keychain-create (&rest - spec - &key backend type max host user port - &allow-other-keys) + (push (auto-source--symbol-keyword + (cond + ((equal k "acct") "user") + ;; for generic keychains, creator is host, service is port + ((and generic (equal k "crtr")) "host") + ((and generic (equal k "svce")) "port") + ;; for internet keychains, protocol is port, server is host + ((and (not generic) (equal k "ptcl")) "port") + ((and (not generic) (equal k "srvr")) "host") + (t k))) + result)) + +(defun auth-source-macos-keychain-create (&rest spec) ;; TODO (debug spec)) @@ -1838,8 +1831,8 @@ entries for git.gnus.org: (defun* auth-source-plstore-search (&rest spec - &key backend create delete label - type max host user port + &key backend create delete + max &allow-other-keys) "Search the PLSTORE; spec is like `auth-source'." (let* ((store (oref backend data)) @@ -1914,7 +1907,7 @@ entries for git.gnus.org: (defun* auth-source-plstore-create (&rest spec &key backend - secret host user port create + host port create &allow-other-keys) (let* ((base-required '(host user port secret)) (base-secret '(secret)) @@ -1925,8 +1918,6 @@ entries for git.gnus.org: :host host :port port))) (required (append base-required create-extra)) - (file (oref backend source)) - (add "") ;; `valist' is an alist valist ;; `artificial' will be returned if no creation is needed @@ -1937,23 +1928,23 @@ entries for git.gnus.org: ;; fill in the valist with whatever data we may have from the search ;; we complete the first value if it's a list and use the value otherwise (dolist (br base-required) - (when (symbol-value br) - (let ((br-choice (cond - ;; all-accepting choice (predicate is t) - ((eq t (symbol-value br)) nil) - ;; just the value otherwise - (t (symbol-value br))))) - (when br-choice - (auth-source--aput valist br br-choice))))) + (let ((val (plist-get spec (auto-source--symbol-keyword br)))) + (when val + (let ((br-choice (cond + ;; all-accepting choice (predicate is t) + ((eq t val) nil) + ;; just the value otherwise + (t val)))) + (when br-choice + (auth-source--aput valist br br-choice)))))) ;; for extra required elements, see if the spec includes a value for them (dolist (er create-extra) - (let ((name (concat ":" (symbol-name er))) + (let ((k (auto-source--symbol-keyword er)) (keys (loop for i below (length spec) by 2 collect (nth i spec)))) - (dolist (k keys) - (when (equal (symbol-name k) name) - (auth-source--aput valist er (plist-get spec k)))))) + (when (memq k keys) + (auth-source--aput valist er (plist-get spec k))))) ;; for each required element (dolist (r required) @@ -1961,7 +1952,7 @@ entries for git.gnus.org: ;; take the first element if the data is a list (data (or (auth-source-netrc-element-or-first data) (plist-get current-data - (intern (format ":%s" r) obarray)))) + (auto-source--symbol-keyword r)))) ;; this is the default to be offered (given-default (auth-source--aget auth-source-creation-defaults r)) @@ -2021,10 +2012,10 @@ entries for git.gnus.org: (if (member r base-secret) (setq secret-artificial (plist-put secret-artificial - (intern (concat ":" (symbol-name r))) + (auto-source--symbol-keyword r) data)) (setq artificial (plist-put artificial - (intern (concat ":" (symbol-name r))) + (auto-source--symbol-keyword r) data)))))) (plstore-put (oref backend data) (sha1 (format "%s@%s:%s" @@ -2075,9 +2066,9 @@ MODE can be \"login\" or \"password\"." (let* ((listy (listp mode)) (mode (if listy mode (list mode))) - (cname (if username - (format "%s %s:%s %s" mode host port username) - (format "%s %s:%s" mode host port))) + ;; (cname (if username + ;; (format "%s %s:%s %s" mode host port username) + ;; (format "%s %s:%s" mode host port))) (search (list :host host :port port)) (search (if username (append search (list :user username)) search)) (search (if create-missing commit 665a035ee2def7f004f99dae0ff5580a122446ba Author: Juanma Barranquero Date: Fri Oct 30 03:23:40 2015 +0100 ; lisp/help-fns.el: Fix typos in comments diff --git a/lisp/help-fns.el b/lisp/help-fns.el index f7d05a4..958a075 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -624,7 +624,7 @@ FILE is the file where FUNCTION was probably defined." (run-hook-with-args 'help-fns-describe-function-functions function) (insert "\n" (or doc "Not documented.")) - ;; Avoid asking the user annoyng questions if she decides + ;; Avoid asking the user annoying questions if she decides ;; to save the help buffer, when her locale's codeset ;; isn't UTF-8. (unless (memq text-quoting-style '(straight grave)) @@ -973,7 +973,7 @@ file-local variable.\n") (re-search-backward (concat "\\(" customize-label "\\)") nil t) (help-xref-button 1 'help-customize-variable variable)))) - ;; Note variable's version or package version + ;; Note variable's version or package version. (let ((output (describe-variable-custom-version-info variable))) (when output (terpri) commit 83a04da79dfb8c3c36062d092e21a706d2e49b42 Author: Juri Linkov Date: Fri Oct 30 02:57:38 2015 +0200 * lisp/dired.el (dired-unmark-all-files-query): Declare. (dired-unmark-all-files): Let-bind it and use instead of ‘query’. (Bug#21746) diff --git a/lisp/dired.el b/lisp/dired.el index c3cad0c..5f0a83a 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -3495,6 +3495,9 @@ OLD and NEW are both characters used to mark files." (interactive) (dired-unmark-all-files ?\r)) +;; Bound in dired-unmark-all-files +(defvar dired-unmark-all-files-query) + (defun dired-unmark-all-files (mark &optional arg) "Remove a specific mark (or any mark) from every file. After this command, type the mark character to remove, @@ -3505,6 +3508,7 @@ Type \\[help-command] at that time for help." (save-excursion (let* ((count 0) (inhibit-read-only t) case-fold-search + dired-unmark-all-files-query (string (format "\n%c" mark)) (help-form "\ Type SPC or `y' to unmark one file, DEL or `n' to skip to next, @@ -3516,7 +3520,8 @@ Type SPC or `y' to unmark one file, DEL or `n' to skip to next, (if (or (not arg) (let ((file (dired-get-filename t t))) (and file - (dired-query 'query "Unmark file `%s'? " + (dired-query 'dired-unmark-all-files-query + "Unmark file `%s'? " file)))) (progn (subst-char-in-region (1- (point)) (point) (preceding-char) ?\s) commit dba0659c3b37a413245b424d75e8989b0bb46a07 Author: Juri Linkov Date: Fri Oct 30 02:04:42 2015 +0200 * lisp/ielm.el (ielm-indent-line): Use non-nil arg of comint-bol to go to the beginning of text line instead of command line. http://lists.gnu.org/archive/html/emacs-devel/2015-10/msg02360.html diff --git a/lisp/ielm.el b/lisp/ielm.el index 183f8a6..b035432 100644 --- a/lisp/ielm.el +++ b/lisp/ielm.el @@ -217,7 +217,7 @@ This variable is buffer-local.") (defun ielm-indent-line nil "Indent the current line as Lisp code if it is not a prompt line." - (when (save-excursion (comint-bol) (bolp)) + (when (save-excursion (comint-bol t) (bolp)) (lisp-indent-line))) ;;; Working buffer manipulation commit 9dcbcbf2593935151b638330360cfb21efbc3f40 Author: Eli Zaretskii Date: Thu Oct 29 20:47:09 2015 +0200 ; * src/lread.c (syms_of_lread) : Improve the doc string. diff --git a/src/lread.c b/src/lread.c index 1119f3f..7c891f9 100644 --- a/src/lread.c +++ b/src/lread.c @@ -4480,9 +4480,11 @@ were read in. */); DEFVAR_LISP ("load-path", Vload_path, doc: /* List of directories to search for files to load. Each element is a string (directory file name) or nil (meaning -`default-directory'). Initialized during startup as described in Info -node `(elisp)Library Search'. Use `directory-file-name' when adding items -to this path. */); +`default-directory'). +Initialized during startup as described in Info node `(elisp)Library Search'. +Use `directory-file-name' when adding items to this path. However, Lisp +programs that process this list should tolerate directories both with +and without trailing slashes. */); DEFVAR_LISP ("load-suffixes", Vload_suffixes, doc: /* List of suffixes for (compiled or source) Emacs Lisp files. commit 8e8a06803c36fdbd4b90faf8f907a90cc33e1bd0 Author: Eli Zaretskii Date: Thu Oct 29 19:48:18 2015 +0200 ; Improve documentation of 'unhandled-file-name-directory' * doc/lispref/files.texi (Magic File Names): Better wording for the last change in the documentation of 'unhandled-file-name-directory'. diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 6083433..9a1b2cd 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -3081,12 +3081,12 @@ making connections when they don't exist. @end defun @defun unhandled-file-name-directory filename -This function returns the name of a directory that is not magic. It -turns @var{filename} into a directory name if that is not magic. For a -magic file name, it invokes the file name handler, which therefore -decides what value to return. If @var{filename} is not accessible -from a local process, then the file name handler should indicate it by -returning @code{nil}. +This function returns the name of a directory that is not magic. For +a non-magic @var{filename} it returns the corresponding directory name +(@pxref{Directory Names}). For a magic @var{filename}, it invokes the +file name handler, which therefore decides what value to return. If +@var{filename} is not accessible from a local process, then the file +name handler should indicate that by returning @code{nil}. This is useful for running a subprocess; every subprocess must have a non-magic directory to serve as its current directory, and this function commit 8485d41e1948c8966a19343533988f6d26656037 Author: Eli Zaretskii Date: Thu Oct 29 19:37:24 2015 +0200 Fix encoding of saving *Help* buffers * lisp/help-fns.el (describe-function-1): If we use curved quotes, set help buffer's buffer-file-coding-system to UTF-8. (Bug#21780) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 945b4d5..f7d05a4 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -623,7 +623,12 @@ FILE is the file where FUNCTION was probably defined." real-function key-bindings-buffer))) (run-hook-with-args 'help-fns-describe-function-functions function) (insert "\n" - (or doc "Not documented.")))))))) + (or doc "Not documented.")) + ;; Avoid asking the user annoyng questions if she decides + ;; to save the help buffer, when her locale's codeset + ;; isn't UTF-8. + (unless (memq text-quoting-style '(straight grave)) + (set-buffer-file-coding-system 'utf-8)))))))) ;; Add defaults to `help-fns-describe-function-functions'. (add-hook 'help-fns-describe-function-functions #'help-fns--obsolete) commit 84dcdbeb740222a9e3da636b87a2b757acc11334 Author: Stefan Monnier Date: Thu Oct 29 11:06:31 2015 -0400 * lisp/emacs-lisp/cl-generic.el: Add (major-mode MODE) context (cl--generic-derived-specializers): New function. (cl--generic-derived-generalizer): New generalizer. (cl-generic-generalizers): New specializer (derived-mode MODE). (cl--generic-split-args): Apply the rewriter, if any. (cl-generic-define-context-rewriter): New macro. (major-mode): Use it to define a new context-rewriter, so we can write `(major-mode MODE)' instead of `(major-mode (derived-mode MODE))'. * lisp/frame.el (window-system): New context-rewriter so we can write `(window-system VAL)' instead of (window-system (eql VAL)). (cl--generic-split-args): Apply the rewriter, if any. (frame-creation-function): Use the new syntax. * lisp/term/x-win.el (window-system-initialization) (handle-args-function, frame-creation-function) (gui-backend-set-selection, gui-backend-selection-owner-p) (gui-backend-selection-exists-p, gui-backend-get-selection): * lisp/term/w32-win.el (window-system-initialization) (handle-args-function, frame-creation-function) (gui-backend-set-selection, gui-backend-get-selection) (gui-backend-selection-owner-p, gui-backend-selection-exists-p): * lisp/term/pc-win.el (gui-backend-get-selection) (gui-backend-selection-exists-p, gui-backend-selection-owner-p) (gui-backend-set-selection, window-system-initialization) (frame-creation-function, handle-args-function): * lisp/term/ns-win.el (window-system-initialization) (handle-args-function, frame-creation-function) (gui-backend-set-selection, gui-backend-selection-exists-p) (gui-backend-get-selection): * lisp/startup.el (handle-args-function): * lisp/term/xterm.el (gui-backend-get-selection) (gui-backend-set-selection): Use the new syntax. diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 0d7ef5b..aae517e 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -266,6 +266,15 @@ BODY, if present, is used as the body of a default method. This macro can only be used within the lexical scope of a cl-generic method." (error "cl-generic-current-method-specializers used outside of a method")) +(defmacro cl-generic-define-context-rewriter (name args &rest body) + "Define a special kind of context named NAME. +Whenever a context specializer of the form (NAME . ACTUALS) appears, +the specializer used will be the one returned by BODY." + (declare (debug (&define name lambda-list def-body)) (indent defun)) + `(eval-and-compile + (put ',name 'cl-generic--context-rewriter + (lambda ,args ,@body)))) + (eval-and-compile ;Needed while compiling the cl-defmethod calls below! (defun cl--generic-fgrep (vars sexp) ;Copied from pcase.el. "Check which of the symbols VARS appear in SEXP." @@ -292,6 +301,11 @@ This macro can only be used within the lexical scope of a cl-generic method." ((let 'context mandatory) (unless (consp arg) (error "Invalid &context arg: %S" arg)) + (let* ((name (car arg)) + (rewriter + (and (symbolp name) + (get name 'cl-generic--context-rewriter)))) + (if rewriter (setq arg (apply rewriter (cdr arg))))) (push `((&context . ,(car arg)) . ,(cadr arg)) specializers) nil) (`(,name . ,type) @@ -1106,6 +1120,37 @@ The value returned is a list of elements of the form (cl--generic-prefill-dispatchers 0 integer) +;;; Dispatch on major mode. + +;; Two parts: +;; - first define a specializer (derived-mode ) to match symbols +;; representing major modes, while obeying the major mode hierarchy. +;; - then define a context-rewriter so you can write +;; "&context (major-mode c-mode)" rather than +;; "&context (major-mode (derived-mode c-mode))". + +(defun cl--generic-derived-specializers (mode &rest _) + ;; FIXME: Handle (derived-mode ... ) + (let ((specializers ())) + (while mode + (push `(derived-mode ,mode) specializers) + (setq mode (get mode 'derived-mode-parent))) + (nreverse specializers))) + +(cl-generic-define-generalizer cl--generic-derived-generalizer + 90 (lambda (name) `(and (symbolp ,name) (functionp ,name) ,name)) + #'cl--generic-derived-specializers) + +(cl-defmethod cl-generic-generalizers ((_specializer (head derived-mode))) + "Support for the `(derived-mode MODE)' specializers." + (list cl--generic-derived-generalizer)) + +(cl-generic-define-context-rewriter major-mode (mode &rest modes) + `(major-mode ,(if (consp mode) + ;;E.g. could be (eql ...) + (progn (cl-assert (null modes)) mode) + `(derived-mode ,mode . ,modes)))) + ;; Local variables: ;; generated-autoload-file: "cl-loaddefs.el" ;; End: diff --git a/lisp/frame.el b/lisp/frame.el index b9e63d5..f550851 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -33,8 +33,12 @@ The window system startup file should add its frame creation function to this method, which should take an alist of parameters as its argument.") -(cl-defmethod frame-creation-function (params - &context (window-system (eql nil))) +(cl-generic-define-context-rewriter window-system (value) + ;; If `value' is a `consp', it's probably an old-style specializer, + ;; so just use it, and anyway `eql' isn't very useful on cons cells. + `(window-system ,(if (consp value) value `(eql ,value)))) + +(cl-defmethod frame-creation-function (params &context (window-system nil)) ;; It's tempting to get rid of tty-create-frame-with-faces and turn it into ;; this method (i.e. move this method to faces.el), but faces.el is loaded ;; much earlier from loadup.el (before cl-generic and even before diff --git a/lisp/startup.el b/lisp/startup.el index 3385567..1346310 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -720,7 +720,7 @@ Window system startup files should add their own function to this method, which should parse the command line arguments. Those pertaining to the window system should be processed and removed from the returned command line.") -(cl-defmethod handle-args-function (args &context (window-system (eql nil))) +(cl-defmethod handle-args-function (args &context (window-system nil)) (tty-handle-args args)) (cl-defgeneric window-system-initialization (&optional _display) diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index 373f812..0b3e3bd 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -848,7 +848,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") ;; Do the actual Nextstep Windows setup here; the above code just ;; defines functions and variables that we use now. -(cl-defmethod window-system-initialization (&context (window-system (eql ns)) +(cl-defmethod window-system-initialization (&context (window-system ns) &optional _display) "Initialize Emacs for Nextstep (Cocoa / GNUstep) windowing." (cl-assert (not ns-initialized)) @@ -922,10 +922,10 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") ;; Any display name is OK. (add-to-list 'display-format-alist '(".*" . ns)) -(cl-defmethod handle-args-function (args &context (window-system (eql ns))) +(cl-defmethod handle-args-function (args &context (window-system ns)) (x-handle-args args)) -(cl-defmethod frame-creation-function (params &context (window-system (eql ns))) +(cl-defmethod frame-creation-function (params &context (window-system ns)) (x-create-frame-with-faces params)) (declare-function ns-own-selection-internal "nsselect.m" (selection value)) @@ -935,20 +935,20 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") (declare-function ns-get-selection "nsselect.m" (selection-symbol target-type)) (cl-defmethod gui-backend-set-selection (selection value - &context (window-system (eql ns))) + &context (window-system ns)) (if value (ns-own-selection-internal selection value) (ns-disown-selection-internal selection))) (cl-defmethod gui-backend-selection-owner-p (selection - &context (window-system (eql ns))) + &context (window-system ns)) (ns-selection-owner-p selection)) (cl-defmethod gui-backend-selection-exists-p (selection - &context (window-system (eql ns))) + &context (window-system ns)) (ns-selection-exists-p selection)) (cl-defmethod gui-backend-get-selection (selection-symbol target-type - &context (window-system (eql ns))) + &context (window-system ns)) (ns-get-selection selection-symbol target-type)) (provide 'ns-win) diff --git a/lisp/term/pc-win.el b/lisp/term/pc-win.el index e8aaa1a..d2afaba 100644 --- a/lisp/term/pc-win.el +++ b/lisp/term/pc-win.el @@ -221,7 +221,7 @@ the operating system.") ;; gui-get-selection is used in select.el (cl-defmethod gui-backend-get-selection (_selection-symbol _target-type - &context (window-system (eql pc))) + &context (window-system pc)) "Return the value of the current selection. Consult the selection. Treat empty strings as if they were unset." ;; Don't die if x-get-selection signals an error. @@ -231,11 +231,11 @@ Consult the selection. Treat empty strings as if they were unset." (declare-function w16-selection-exists-p "w16select.c") ;; gui-selection-owner-p is used in simple.el. (cl-defmethod gui-backend-selection-exists-p (selection - &context (window-system (eql pc))) + &context (window-system pc)) (w16-selection-exists-p selection)) (cl-defmethod gui-backend-selection-owner-p (selection - &context (window-system (eql pc))) + &context (window-system pc)) (w16-selection-owner-p selection)) (defun w16-selection-owner-p (_selection) @@ -258,7 +258,7 @@ Consult the selection. Treat empty strings as if they were unset." (declare-function w16-set-clipboard-data "w16select.c" (string &optional ignored)) (cl-defmethod gui-backend-set-selection (selection value - &context (window-system (eql pc))) + &context (window-system pc)) (if (not value) (if (w16-selection-owner-p selection) t) @@ -333,7 +333,7 @@ Errors out because it is not supposed to be called, ever." (window-system))) ;; window-system-initialization is called by startup.el:command-line. -(cl-defmethod window-system-initialization (&context (window-system (eql pc)) +(cl-defmethod window-system-initialization (&context (window-system pc) &optional _display) "Initialization function for the `pc' \"window system\"." (or (eq (window-system) 'pc) @@ -377,12 +377,12 @@ Errors out because it is not supposed to be called, ever." (run-hooks 'terminal-init-msdos-hook)) ;; frame-creation-function is called by frame.el:make-frame. -(cl-defmethod frame-creation-function (params &context (window-system (eql pc))) +(cl-defmethod frame-creation-function (params &context (window-system pc)) (msdos-create-frame-with-faces params)) ;; We don't need anything beyond tty-handle-args for handling ;; command-line argument; see startup.el. -(cl-defmethod handle-args-function (args &context (window-system (eql pc))) +(cl-defmethod handle-args-function (args &context (window-system pc)) (tty-handle-args args)) ;; --------------------------------------------------------------------------- diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el index 8bbc3dd..181fd49 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el @@ -290,7 +290,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") (declare-function x-parse-geometry "frame.c" (string)) (defvar x-command-line-resources) -(cl-defmethod window-system-initialization (&context (window-system (eql w32)) +(cl-defmethod window-system-initialization (&context (window-system w32) &optional _display) "Initialize Emacs for W32 GUI frames." (cl-assert (not w32-initialized)) @@ -377,10 +377,10 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") (setq w32-initialized t)) (add-to-list 'display-format-alist '("\\`w32\\'" . w32)) -(cl-defmethod handle-args-function (args &context (window-system (eql w32))) +(cl-defmethod handle-args-function (args &context (window-system w32)) (x-handle-args args)) -(cl-defmethod frame-creation-function (params &context (window-system (eql w32))) +(cl-defmethod frame-creation-function (params &context (window-system w32)) (x-create-frame-with-faces params)) ;;;; Selections @@ -408,19 +408,19 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") (get 'x-selections (or selection 'PRIMARY)))) (cl-defmethod gui-backend-set-selection (type value - &context (window-system (eql w32))) + &context (window-system w32)) (w32--set-selection type value)) (cl-defmethod gui-backend-get-selection (type data-type - &context (window-system (eql w32))) + &context (window-system w32)) (w32--get-selection type data-type)) (cl-defmethod gui-backend-selection-owner-p (selection - &context (window-system (eql w32))) + &context (window-system w32)) (w32--selection-owner-p selection)) (cl-defmethod gui-backend-selection-exists-p (selection - &context (window-system (eql w32))) + &context (window-system w32)) (w32-selection-exists-p selection)) (when (eq system-type 'windows-nt) @@ -428,19 +428,19 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") ;; We could move those cl-defmethods outside of the `when' and use ;; "&context (system-type (eql windows-nt))" instead! (cl-defmethod gui-backend-set-selection (type value - &context (window-system (eql nil))) + &context (window-system nil)) (w32--set-selection type value)) (cl-defmethod gui-backend-get-selection (type data-type - &context (window-system (eql nil))) + &context (window-system nil)) (w32--get-selection type data-type)) (cl-defmethod gui-backend-selection-owner-p (selection - &context (window-system (eql nil))) + &context (window-system nil)) (w32--selection-owner-p selection)) (cl-defmethod gui-selection-exists-p (selection - &context (window-system (eql nil))) + &context (window-system nil)) (w32-selection-exists-p selection))) ;; The "Windows" keys on newer keyboards bring up the Start menu diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index 5eb6f11..690401e 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el @@ -1197,7 +1197,7 @@ This returns an error if any Emacs frames are X frames." (defvar x-display-name) (defvar x-command-line-resources) -(cl-defmethod window-system-initialization (&context (window-system (eql x)) +(cl-defmethod window-system-initialization (&context (window-system x) &optional display) "Initialize Emacs for X frames and open the first connection to an X server." (cl-assert (not x-initialized)) @@ -1327,27 +1327,27 @@ This returns an error if any Emacs frames are X frames." (selection-symbol target-type &optional time-stamp terminal)) (add-to-list 'display-format-alist '("\\`[^:]*:[0-9]+\\(\\.[0-9]+\\)?\\'" . x)) -(cl-defmethod handle-args-function (args &context (window-system (eql x))) +(cl-defmethod handle-args-function (args &context (window-system x)) (x-handle-args args)) -(cl-defmethod frame-creation-function (params &context (window-system (eql x))) +(cl-defmethod frame-creation-function (params &context (window-system x)) (x-create-frame-with-faces params)) (cl-defmethod gui-backend-set-selection (selection value - &context (window-system (eql x))) + &context (window-system x)) (if value (x-own-selection-internal selection value) (x-disown-selection-internal selection))) (cl-defmethod gui-backend-selection-owner-p (selection - &context (window-system (eql x))) + &context (window-system x)) (x-selection-owner-p selection)) (cl-defmethod gui-backend-selection-exists-p (selection - &context (window-system (eql x))) + &context (window-system x)) (x-selection-exists-p selection)) (cl-defmethod gui-backend-get-selection (selection-symbol target-type - &context (window-system (eql x)) + &context (window-system x) &optional time-stamp terminal) (x-get-selection-internal selection-symbol target-type time-stamp terminal)) diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el index 300e494..00ed027 100644 --- a/lisp/term/xterm.el +++ b/lisp/term/xterm.el @@ -821,7 +821,7 @@ We run the first FUNCTION whose STRING matches the input events." (cl-defmethod gui-backend-get-selection (type data-type - &context (window-system (eql nil)) + &context (window-system nil) ;; Only applies to terminals which have it enabled. ((terminal-parameter nil 'xterm--get-selection) (eql t))) (unless (eq data-type 'STRING) @@ -844,7 +844,7 @@ We run the first FUNCTION whose STRING matches the input events." (cl-defmethod gui-backend-set-selection (type data - &context (window-system (eql nil)) + &context (window-system nil) ;; Only applies to terminals which have it enabled. ((terminal-parameter nil 'xterm--set-selection) (eql t))) "Copy DATA to the X selection using the OSC 52 escape sequence. commit a4f754ca0bc00311b38adf3d498c30ce82c3170d Author: Stefan Monnier Date: Thu Oct 29 10:36:52 2015 -0400 * test/indent/css-mode.css: Add tests for url(...) syntax. diff --git a/test/indent/css-mode.css b/test/indent/css-mode.css index 2f04e96..24166b0 100644 --- a/test/indent/css-mode.css +++ b/test/indent/css-mode.css @@ -30,7 +30,9 @@ a.b:c,d.e:f,g[h]:i,j[k]:l,.m.n:o,.p.q:r,.s[t]:u,.v[w]:x { /* bug:20282 */ .x2 { /* foo: bar; */ foo2: bar2; - bar: baz; + bar1: url("http://toto/titi"); + bar2: url('http://toto/titi'); + bar3: url(http://toto/titi); } div.x3 commit be81cc2707e1f7c6ae6e86c4df548356c44ff06c Author: Stefan Monnier Date: Thu Oct 29 10:35:08 2015 -0400 * lisp/emacs-lisp/smie.el: Use `declare' for `pure' (smie-precs->prec2, smie-merge-prec2s, smie-bnf->prec2, smie-prec2->grammar): Use `declare'. diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el index f305025..738bddd 100644 --- a/lisp/emacs-lisp/smie.el +++ b/lisp/emacs-lisp/smie.el @@ -169,13 +169,13 @@ (cl-incf smie-warning-count)) (puthash key val table)))) -(put 'smie-precs->prec2 'pure t) (defun smie-precs->prec2 (precs) "Compute a 2D precedence table from a list of precedences. PRECS should be a list, sorted by precedence (e.g. \"+\" will come before \"*\"), of elements of the form \(left OP ...) or (right OP ...) or (nonassoc OP ...) or (assoc OP ...). All operators in one of those elements share the same precedence level and associativity." + (declare (pure t)) (let ((prec2-table (make-hash-table :test 'equal))) (dolist (prec precs) (dolist (op (cdr prec)) @@ -193,8 +193,8 @@ one of those elements share the same precedence level and associativity." (smie-set-prec2tab prec2-table other-op op op1))))))) prec2-table)) -(put 'smie-merge-prec2s 'pure t) (defun smie-merge-prec2s (&rest tables) + (declare (pure t)) (if (null (cdr tables)) (car tables) (let ((prec2 (make-hash-table :test 'equal))) @@ -209,7 +209,6 @@ one of those elements share the same precedence level and associativity." table)) prec2))) -(put 'smie-bnf->prec2 'pure t) (defun smie-bnf->prec2 (bnf &rest resolvers) "Convert the BNF grammar into a prec2 table. BNF is a list of nonterminal definitions of the form: @@ -232,6 +231,7 @@ Conflicts can be resolved via RESOLVERS, which is a list of elements that can be either: - a precs table (see `smie-precs->prec2') to resolve conflicting constraints, - a constraint (T1 REL T2) where REL is one of = < or >." + (declare (pure t)) ;; FIXME: Add repetition operator like (repeat ). ;; Maybe also add (or ...) for things like ;; (exp (exp (or "+" "*" "=" ..) exp)). @@ -503,11 +503,11 @@ CSTS is a list of pairs representing arcs in a graph." ;; (t (cl-assert (eq v '=)))))))) ;; prec2)) -(put 'smie-prec2->grammar 'pure t) (defun smie-prec2->grammar (prec2) "Take a 2D precedence table and turn it into an alist of precedence levels. PREC2 is a table as returned by `smie-precs->prec2' or `smie-bnf->prec2'." + (declare (pure t)) ;; For each operator, we create two "variables" (corresponding to ;; the left and right precedence level), which are represented by ;; cons cells. Those are the very cons cells that appear in the commit aa1c4ae271733cf7dc64918b570bab4034488fa1 Author: Stefan Monnier Date: Thu Oct 29 10:33:36 2015 -0400 * lisp/emacs-lisp/cl-generic.el: Accomodate future changes (cl--generic-generalizer): Add `name' field. (cl-generic-make-generalizer): Add corresponding `name' argument. (cl-generic-define-generalizer): New macro. (cl--generic-head-generalizer, cl--generic-eql-generalizer) (cl--generic-struct-generalizer, cl--generic-typeof-generalizer) (cl--generic-t-generalizer): Use it. (cl-generic-ensure-function): Add `noerror' argument. (cl-generic-define): Use it so we don't follow aliases. (cl-generic-define-method): Preserve pre-existing ordering of methods. (cl--generic-arg-specializer): New function. (cl--generic-cache-miss): Use it. (cl-generic-generalizers): Only fset a temporary definition during bootstrap. (cl--generic-struct-tag, cl--generic-struct-specializers): Allow extra arguments. * lisp/emacs-lisp/eieio-compat.el (eieio--generic-static-symbol-generalizer) (eieio--generic-static-object-generalizer): Use cl-generic-define-generalizer. (eieio--generic-static-symbol-specializers): Allow extra arguments. * lisp/emacs-lisp/eieio-core.el (eieio--generic-generalizer) (eieio--generic-subclass-generalizer): Use cl-generic-define-generalizer. (eieio--generic-subclass-specializers): Allow extra arguments. diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index dd01ebe..0d7ef5b 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -80,7 +80,7 @@ ;; TODO: ;; -;; - A generic "filter" generalizer (e.g. could be used to cleanly adds methods +;; - A generic "filter" generalizer (e.g. could be used to cleanly add methods ;; to cl-generic-combine-methods with a specializer that says it applies only ;; when some particular qualifier is used). ;; - A way to dispatch on the context (e.g. the major-mode, some global @@ -101,14 +101,33 @@ (cl-defstruct (cl--generic-generalizer (:constructor nil) (:constructor cl-generic-make-generalizer - (priority tagcode-function specializers-function))) + (name priority tagcode-function specializers-function))) + (name nil :type string) (priority nil :type integer) tagcode-function specializers-function) -(defconst cl--generic-t-generalizer - (cl-generic-make-generalizer - 0 (lambda (_name) nil) (lambda (_tag) '(t)))) + +(defmacro cl-generic-define-generalizer + (name priority tagcode-function specializers-function) + "Define a new kind of generalizer. +NAME is the name of the variable that will hold it. +PRIORITY defines which generalizer takes precedence. + The catch-all generalizer has priority 0. + Then `eql' generalizer has priority 100. +TAGCODE-FUNCTION takes as first argument a varname and should return + a chunk of code that computes the tag of the value held in that variable. + Further arguments are reserved for future use. +SPECIALIZERS-FUNCTION takes as first argument a tag value TAG + and should return a list of specializers that match TAG. + Further arguments are reserved for future use." + (declare (indent 1) (debug (symbolp body))) + `(defconst ,name + (cl-generic-make-generalizer + ',name ,priority ,tagcode-function ,specializers-function))) + +(cl-generic-define-generalizer cl--generic-t-generalizer + 0 (lambda (_name &rest _) nil) (lambda (_tag &rest _) '(t))) (cl-defstruct (cl--generic-method (:constructor nil) @@ -144,16 +163,18 @@ (defmacro cl--generic (name) `(get ,name 'cl--generic)) -(defun cl-generic-ensure-function (name) +(defun cl-generic-ensure-function (name &optional noerror) (let (generic (origname name)) (while (and (null (setq generic (cl--generic name))) (fboundp name) + (null noerror) (symbolp (symbol-function name))) (setq name (symbol-function name))) (unless (or (not (fboundp name)) (autoloadp (symbol-function name)) - (and (functionp name) generic)) + (and (functionp name) generic) + noerror) (error "%s is already defined as something else than a generic function" origname)) (if generic @@ -220,7 +241,7 @@ BODY, if present, is used as the body of a default method. ;;;###autoload (defun cl-generic-define (name args options) - (pcase-let* ((generic (cl-generic-ensure-function name)) + (pcase-let* ((generic (cl-generic-ensure-function name 'noerror)) (`(,spec-args . ,_) (cl--generic-split-args args)) (mandatory (mapcar #'car spec-args)) (apo (assq :argument-precedence-order options))) @@ -418,8 +439,12 @@ which case this method will be invoked when the argument is `eql' to VAL. (setq i (1+ i)))) ;; We used to (setcar me method), but that can cause false positives in ;; the hash-consing table of the method-builder (bug#20644). - ;; See the related FIXME in cl--generic-build-combined-method. - (setf (cl--generic-method-table generic) (cons method (delq (car me) mt))) + ;; See also the related FIXME in cl--generic-build-combined-method. + (setf (cl--generic-method-table generic) + (if (null me) + (cons method mt) + ;; Keep the ordering; important for methods with :extra qualifiers. + (mapcar (lambda (x) (if (eq x (car me)) method x)) mt))) (cl-pushnew `(cl-defmethod . (,(cl--generic-name generic) . ,specializers)) current-load-list :test #'equal) ;; FIXME: Try to avoid re-constructing a new function if the old one @@ -623,16 +648,19 @@ FUN is the function that should be called when METHOD calls (setq fun (cl-generic-call-method generic method fun))) fun))))) +(defun cl--generic-arg-specializer (method dispatch-arg) + (or (if (integerp dispatch-arg) + (nth dispatch-arg + (cl--generic-method-specializers method)) + (cdr (assoc dispatch-arg + (cl--generic-method-specializers method)))) + t)) + (defun cl--generic-cache-miss (generic dispatch-arg dispatches-left methods-left types) (let ((methods '())) (dolist (method methods-left) - (let* ((specializer (or (if (integerp dispatch-arg) - (nth dispatch-arg - (cl--generic-method-specializers method)) - (cdr (assoc dispatch-arg - (cl--generic-method-specializers method)))) - t)) + (let* ((specializer (cl--generic-arg-specializer method dispatch-arg)) (m (member specializer types))) (when m (push (cons (length m) method) methods)))) @@ -682,10 +710,12 @@ The METHODS list is sorted from most specific first to most generic last. The function can use `cl-generic-call-method' to create functions that call those methods.") -;; Temporary definition to let the next defmethod succeed. -(fset 'cl-generic-generalizers - (lambda (_specializer) (list cl--generic-t-generalizer))) -(fset 'cl-generic-combine-methods #'cl--generic-standard-method-combination) +(unless (ignore-errors (cl-generic-generalizers t)) + ;; Temporary definition to let the next defmethod succeed. + (fset 'cl-generic-generalizers + (lambda (specializer) + (if (eq t specializer) (list cl--generic-t-generalizer)))) + (fset 'cl-generic-combine-methods #'cl--generic-standard-method-combination)) (cl-defmethod cl-generic-generalizers (specializer) "Support for the catch-all t specializer." @@ -940,10 +970,9 @@ The value returned is a list of elements of the form (defvar cl--generic-head-used (make-hash-table :test #'eql)) -(defconst cl--generic-head-generalizer - (cl-generic-make-generalizer - 80 (lambda (name) `(gethash (car-safe ,name) cl--generic-head-used)) - (lambda (tag) (if (eq (car-safe tag) 'head) (list tag))))) +(cl-generic-define-generalizer cl--generic-head-generalizer + 80 (lambda (name &rest _) `(gethash (car-safe ,name) cl--generic-head-used)) + (lambda (tag &rest _) (if (eq (car-safe tag) 'head) (list tag)))) (cl-defmethod cl-generic-generalizers :extra "head" (specializer) "Support for the `(head VAL)' specializers." @@ -961,10 +990,9 @@ The value returned is a list of elements of the form (defvar cl--generic-eql-used (make-hash-table :test #'eql)) -(defconst cl--generic-eql-generalizer - (cl-generic-make-generalizer - 100 (lambda (name) `(gethash ,name cl--generic-eql-used)) - (lambda (tag) (if (eq (car-safe tag) 'eql) (list tag))))) +(cl-generic-define-generalizer cl--generic-eql-generalizer + 100 (lambda (name &rest _) `(gethash ,name cl--generic-eql-used)) + (lambda (tag &rest _) (if (eq (car-safe tag) 'eql) (list tag)))) (cl-defmethod cl-generic-generalizers ((specializer (head eql))) "Support for the `(eql VAL)' specializers." @@ -976,7 +1004,7 @@ The value returned is a list of elements of the form ;;; Support for cl-defstructs specializers. -(defun cl--generic-struct-tag (name) +(defun cl--generic-struct-tag (name &rest _) ;; It's tempting to use (and (vectorp ,name) (aref ,name 0)) ;; but that would suffer from some problems: ;; - the vector may have size 0. @@ -1007,16 +1035,15 @@ The value returned is a list of elements of the form (cl--class-parents class))))) (nreverse parents))) -(defun cl--generic-struct-specializers (tag) +(defun cl--generic-struct-specializers (tag &rest _) (and (symbolp tag) (boundp tag) (let ((class (symbol-value tag))) (when (cl-typep class 'cl-structure-class) (cl--generic-class-parents class))))) -(defconst cl--generic-struct-generalizer - (cl-generic-make-generalizer - 50 #'cl--generic-struct-tag - #'cl--generic-struct-specializers)) +(cl-generic-define-generalizer cl--generic-struct-generalizer + 50 #'cl--generic-struct-tag + #'cl--generic-struct-specializers) (cl-defmethod cl-generic-generalizers :extra "cl-struct" (type) "Support for dispatch on cl-struct types." @@ -1056,11 +1083,11 @@ The value returned is a list of elements of the form (sequence) (number))) -(defconst cl--generic-typeof-generalizer - (cl-generic-make-generalizer - ;; FIXME: We could also change `type-of' to return `null' for nil. - 10 (lambda (name) `(if ,name (type-of ,name) 'null)) - (lambda (tag) (and (symbolp tag) (assq tag cl--generic-typeof-types))))) +(cl-generic-define-generalizer cl--generic-typeof-generalizer + ;; FIXME: We could also change `type-of' to return `null' for nil. + 10 (lambda (name &rest _) `(if ,name (type-of ,name) 'null)) + (lambda (tag &rest _) + (and (symbolp tag) (assq tag cl--generic-typeof-types)))) (cl-defmethod cl-generic-generalizers :extra "typeof" (type) "Support for dispatch on builtin types." diff --git a/lisp/emacs-lisp/eieio-compat.el b/lisp/emacs-lisp/eieio-compat.el index 386ff2f..638c475 100644 --- a/lisp/emacs-lisp/eieio-compat.el +++ b/lisp/emacs-lisp/eieio-compat.el @@ -124,7 +124,7 @@ Summary: (defgeneric ,method ,args) (eieio--defmethod ',method ',key ',class #',code)))) -(defun eieio--generic-static-symbol-specializers (tag) +(defun eieio--generic-static-symbol-specializers (tag &rest _) (cl-assert (or (null tag) (eieio--class-p tag))) (when (eieio--class-p tag) (let ((superclasses (eieio--generic-subclass-specializers tag)) @@ -134,27 +134,25 @@ Summary: (push `(eieio--static ,(cadr superclass)) specializers)) (nreverse specializers)))) -(defconst eieio--generic-static-symbol-generalizer - (cl-generic-make-generalizer - ;; Give it a slightly higher priority than `subclass' so that the - ;; interleaved list comes before subclass's non-interleaved list. - 61 (lambda (name) `(and (symbolp ,name) (cl--find-class ,name))) - #'eieio--generic-static-symbol-specializers)) -(defconst eieio--generic-static-object-generalizer - (cl-generic-make-generalizer - ;; Give it a slightly higher priority than `class' so that the - ;; interleaved list comes before the class's non-interleaved list. - 51 #'cl--generic-struct-tag - (lambda (tag) - (and (symbolp tag) (boundp tag) (setq tag (symbol-value tag)) - (eieio--class-p tag) - (let ((superclasses (eieio--class-precedence-list tag)) - (specializers ())) - (dolist (superclass superclasses) - (setq superclass (eieio--class-name superclass)) - (push superclass specializers) - (push `(eieio--static ,superclass) specializers)) - (nreverse specializers)))))) +(cl-generic-define-generalizer eieio--generic-static-symbol-generalizer + ;; Give it a slightly higher priority than `subclass' so that the + ;; interleaved list comes before subclass's non-interleaved list. + 61 (lambda (name &rest _) `(and (symbolp ,name) (cl--find-class ,name))) + #'eieio--generic-static-symbol-specializers) +(cl-generic-define-generalizer eieio--generic-static-object-generalizer + ;; Give it a slightly higher priority than `class' so that the + ;; interleaved list comes before the class's non-interleaved list. + 51 #'cl--generic-struct-tag + (lambda (tag _targets) + (and (symbolp tag) (boundp tag) (setq tag (symbol-value tag)) + (eieio--class-p tag) + (let ((superclasses (eieio--class-precedence-list tag)) + (specializers ())) + (dolist (superclass superclasses) + (setq superclass (eieio--class-name superclass)) + (push superclass specializers) + (push `(eieio--static ,superclass) specializers)) + (nreverse specializers))))) (cl-defmethod cl-generic-generalizers ((_specializer (head eieio--static))) (list eieio--generic-static-symbol-generalizer diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index e3f7b11..7011a30 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -1059,16 +1059,15 @@ method invocation orders of the involved classes." ;;;; General support to dispatch based on the type of the argument. -(defconst eieio--generic-generalizer - (cl-generic-make-generalizer - ;; Use the exact same tagcode as for cl-struct, so that methods - ;; that dispatch on both kinds of objects get to share this - ;; part of the dispatch code. - 50 #'cl--generic-struct-tag - (lambda (tag) - (and (symbolp tag) (boundp tag) (eieio--class-p (symbol-value tag)) - (mapcar #'eieio--class-name - (eieio--class-precedence-list (symbol-value tag))))))) +(cl-generic-define-generalizer eieio--generic-generalizer + ;; Use the exact same tagcode as for cl-struct, so that methods + ;; that dispatch on both kinds of objects get to share this + ;; part of the dispatch code. + 50 #'cl--generic-struct-tag + (lambda (tag &rest _) + (and (symbolp tag) (boundp tag) (eieio--class-p (symbol-value tag)) + (mapcar #'eieio--class-name + (eieio--class-precedence-list (symbol-value tag)))))) (cl-defmethod cl-generic-generalizers :extra "class" (specializer) ;; CLHS says: @@ -1088,22 +1087,21 @@ method invocation orders of the involved classes." ;; would not make much sense (e.g. to which argument should it apply?). ;; Instead, we add a new "subclass" specializer. -(defun eieio--generic-subclass-specializers (tag) +(defun eieio--generic-subclass-specializers (tag &rest _) (when (eieio--class-p tag) (mapcar (lambda (class) `(subclass ,(eieio--class-name class))) (eieio--class-precedence-list tag)))) -(defconst eieio--generic-subclass-generalizer - (cl-generic-make-generalizer - 60 (lambda (name) `(and (symbolp ,name) (cl--find-class ,name))) - #'eieio--generic-subclass-specializers)) +(cl-generic-define-generalizer eieio--generic-subclass-generalizer + 60 (lambda (name &rest _) `(and (symbolp ,name) (cl--find-class ,name))) + #'eieio--generic-subclass-specializers) (cl-defmethod cl-generic-generalizers ((_specializer (head subclass))) (list eieio--generic-subclass-generalizer)) -;;;### (autoloads nil "eieio-compat" "eieio-compat.el" "ea8c7f24ed47c6b71ac37cbdae1c9931") +;;;### (autoloads nil "eieio-compat" "eieio-compat.el" "bd51800d7de6429a2c9a6a600ba2dc52") ;;; Generated autoloads from eieio-compat.el (autoload 'eieio--defalias "eieio-compat" "\ commit c0d866dd690ffef08894dbce573c636ab0b42665 Author: Stefan Monnier Date: Thu Oct 29 09:25:18 2015 -0400 * lisp/emacs-lisp/bytecomp.el (compile-defun): Add defvars in scope. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index d138eff..db200f3 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1901,7 +1901,10 @@ With argument ARG, insert value in current buffer after the form." (let ((read-with-symbol-positions (current-buffer)) (read-symbol-positions-list nil)) (displaying-byte-compile-warnings - (byte-compile-sexp (read (current-buffer))))) + (byte-compile-sexp + (eval-sexp-add-defvars + (read (current-buffer)) + byte-compile-read-position)))) lexical-binding))) (cond (arg (message "Compiling from buffer... done.") commit 270a17fe4d357d64cfef7a3991e6a69db587a3fb Author: Michael Albinus Date: Thu Oct 29 14:05:55 2015 +0100 Add "afp" method to Tramp * doc/misc/tramp.texi (GVFS based methods): Describe `afp' method. * lisp/net/tramp-gvfs.el (tramp-gvfs-methods): Add "afp" method. (tramp-gvfs-handle-expand-file-name) (tramp-gvfs-handler-mounted-unmounted) (tramp-gvfs-connection-mounted-p, tramp-gvfs-mount-spec) (tramp-gvfs-maybe-open-connection): Support also "afp". (tramp-gvfs-handle-file-attributes): Handle the case of empty "owner::user" and "owner::group" entries. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 8673b00..07d34bd 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -1062,6 +1062,16 @@ Therefore, your @value{emacsname} must have D-Bus integration, @pxref{Top, , D-Bus, dbus}. @table @asis +@item @option{afp} +@cindex method afp +@cindex afp method + +Access to Mac OS X volumes via the Apple Filing Protocol is offered by +this method. The access must always be performed with a leading +volume (share) name, like @file{@trampfn{afp, user, host, /volume}}. + + + @item @option{dav} @cindex method dav @cindex method davs @@ -1107,9 +1117,10 @@ FUSE, it also needs the SYNCE-GVFS plugin. @vindex tramp-gvfs-methods @defopt tramp-gvfs-methods This custom option, a list, defines the external methods which shall -be used with GVFS@. Per default, these are @option{dav}, -@option{davs}, @option{obex}, @option{sftp} and @option{synce}. Other -possible values are @option{ftp} and @option{smb}. +be used with GVFS@. Per default, these are @option{afp}, +@option{dav}, @option{davs}, @option{obex}, @option{sftp} and +@option{synce}. Other possible values are @option{ftp} and +@option{smb}. @end defopt @end ifset diff --git a/etc/NEWS b/etc/NEWS index 512b491..0dbfd3f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -671,6 +671,10 @@ plist will contain a :peer element that has the output of ** Tramp +++ +*** New connection method "afp", which allows to access Mac OS X +volumes via the Apple Filing Protocol. + ++++ *** New connection method "nc", which allows to access dumb busyboxes. +++ diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 177ccfc..c68b5e4 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -110,11 +110,12 @@ (require 'custom)) ;;;###tramp-autoload -(defcustom tramp-gvfs-methods '("dav" "davs" "obex" "sftp" "synce") +(defcustom tramp-gvfs-methods '("afp" "dav" "davs" "obex" "sftp" "synce") "List of methods for remote files, accessed with GVFS." :group 'tramp - :version "23.2" - :type '(repeat (choice (const "dav") + :version "25.1" + :type '(repeat (choice (const "afp") + (const "dav") (const "davs") (const "ftp") (const "obex") @@ -231,7 +232,8 @@ It has been changed in GVFS 1.14.") ;; ARRAY BYTE mount_prefix ;; ARRAY ;; STRUCT mount_spec_item -;; STRING key (server, share, type, user, host, port) +;; STRING key (type, user, domain, host, server, +;; share, volume, port, ssl) ;; ARRAY BYTE value ;; ARRAY BYTE default_location Since GVFS 1.5 only !!! @@ -770,7 +772,7 @@ file names." (unless (tramp-run-real-handler 'file-name-absolute-p (list localname)) (setq localname (concat "/" localname))) ;; We do not pass "/..". - (if (string-equal "smb" method) + (if (string-match "^\\(afp\\|smb\\)$" method) (when (string-match "^/[^/]+\\(/\\.\\./?\\)" localname) (setq localname (replace-match "/" t t localname 1))) (when (string-match "^/\\.\\./?" localname) @@ -825,8 +827,9 @@ file names." (if (re-search-forward "unix::uid:\\s-+\\([0-9]+\\)" nil t) (string-to-number (match-string 1))) - (if (re-search-forward - "owner::user:\\s-+\\(\\S-+\\)" nil t) + (if (and + (re-search-forward "owner::user:\\s-+" nil t) + (re-search-forward "(\\S-+\\)" (point-at-eol) t)) (match-string 1))) (tramp-get-local-uid id-format))) (setq res-gid @@ -834,8 +837,9 @@ file names." (if (re-search-forward "unix::gid:\\s-+\\([0-9]+\\)" nil t) (string-to-number (match-string 1))) - (if (re-search-forward - "owner::group:\\s-+\\(\\S-+\\)" nil t) + (if (and + (re-search-forward "owner::group:\\s-+" nil t) + (re-search-forward "(\\S-+\\)" (point-at-eol) t)) (match-string 1))) (tramp-get-local-gid id-format))) ;; ... last access, modification and change time @@ -1346,12 +1350,14 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"." (cadr (assoc "port" (cadr mount-spec))))) (ssl (tramp-gvfs-dbus-byte-array-to-string (cadr (assoc "ssl" (cadr mount-spec))))) - (prefix (concat (tramp-gvfs-dbus-byte-array-to-string - (car mount-spec)) - (tramp-gvfs-dbus-byte-array-to-string - (cadr (assoc "share" (cadr mount-spec))))))) - (when (string-match "^smb" method) - (setq method "smb")) + (prefix (concat + (tramp-gvfs-dbus-byte-array-to-string + (car mount-spec)) + (tramp-gvfs-dbus-byte-array-to-string + (or (cadr (assoc "share" (cadr mount-spec))) + (cadr (assoc "volume" (cadr mount-spec)))))))) + (when (string-match "^\\(afp\\|smb\\)" method) + (setq method (match-string 1 method))) (when (string-equal "obex" method) (setq host (tramp-bluez-device host))) (when (and (string-equal "dav" method) (string-equal "true" ssl)) @@ -1428,12 +1434,15 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"." (cadr (assoc "port" (cadr mount-spec))))) (ssl (tramp-gvfs-dbus-byte-array-to-string (cadr (assoc "ssl" (cadr mount-spec))))) - (prefix (concat (tramp-gvfs-dbus-byte-array-to-string - (car mount-spec)) - (tramp-gvfs-dbus-byte-array-to-string - (cadr (assoc "share" (cadr mount-spec))))))) - (when (string-match "^smb" method) - (setq method "smb")) + (prefix (concat + (tramp-gvfs-dbus-byte-array-to-string + (car mount-spec)) + (tramp-gvfs-dbus-byte-array-to-string + (or + (cadr (assoc "share" (cadr mount-spec))) + (cadr (assoc "volume" (cadr mount-spec)))))))) + (when (string-match "^\\(afp\\|smb\\)" method) + (setq method (match-string 1 method))) (when (string-equal "obex" method) (setq host (tramp-bluez-device host))) (when (and (string-equal "dav" method) (string-equal "true" ssl)) @@ -1473,16 +1482,16 @@ It was \"a(say)\", but has changed to \"a{sv})\"." (host (tramp-file-name-real-host vec)) (port (tramp-file-name-port vec)) (localname (tramp-file-name-localname vec)) - (ssl (if (string-match "^davs" method) "true" "false")) + (share (when (string-match "^/?\\([^/]+\\)" localname) + (match-string 1 localname))) + (ssl (when (string-match "^davs" method) "true" "false")) (mount-spec `(:array ,@(cond ((string-equal "smb" method) - (string-match "^/?\\([^/]+\\)" localname) (list (tramp-gvfs-mount-spec-entry "type" "smb-share") (tramp-gvfs-mount-spec-entry "server" host) - (tramp-gvfs-mount-spec-entry - "share" (match-string 1 localname)))) + (tramp-gvfs-mount-spec-entry "share" share))) ((string-equal "obex" method) (list (tramp-gvfs-mount-spec-entry "type" method) (tramp-gvfs-mount-spec-entry @@ -1491,6 +1500,10 @@ It was \"a(say)\", but has changed to \"a{sv})\"." (list (tramp-gvfs-mount-spec-entry "type" "dav") (tramp-gvfs-mount-spec-entry "host" host) (tramp-gvfs-mount-spec-entry "ssl" ssl))) + ((string-equal "afp" method) + (list (tramp-gvfs-mount-spec-entry "type" "afp-volume") + (tramp-gvfs-mount-spec-entry "host" host) + (tramp-gvfs-mount-spec-entry "volume" share))) (t (list (tramp-gvfs-mount-spec-entry "type" method) (tramp-gvfs-mount-spec-entry "host" host)))) @@ -1546,6 +1559,10 @@ connection if a previous connection has died for some reason." (string-equal localname "/")) (tramp-error vec 'file-error "Filename must contain a Windows share")) + (when (and (string-equal method "afp") + (string-equal localname "/")) + (tramp-error vec 'file-error "Filename must contain an AFP volume")) + (with-tramp-progress-reporter vec 3 (if (zerop (length user)) @@ -1795,7 +1812,7 @@ They are retrieved from the hal daemon." ;;; TODO: -;; * Host name completion via smb-server or smb-network. +;; * Host name completion via afp-server, smb-server or smb-network. ;; * Check how two shares of the same SMB server can be mounted in ;; parallel. ;; * Apply SDP on bluetooth devices, in order to filter out obex