Now on revision 108042. ------------------------------------------------------------ revno: 108042 fixes bug(s): http://debbugs.gnu.org/5302 committer: Chong Yidong branch nick: trunk timestamp: Thu 2012-04-26 11:43:32 +0800 message: Allow undoing in read-only diff-mode buffers. * lisp/vc/diff-mode.el (diff-undo): New command. (diff-mode-shared-map): Bind it to / and [remap undo]. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-04-26 03:18:47 +0000 +++ lisp/ChangeLog 2012-04-26 03:43:32 +0000 @@ -14,6 +14,9 @@ 2012-04-26 Chong Yidong + * vc/diff-mode.el (diff-undo): New command (Bug#5302). + (diff-mode-shared-map): Bind it to / and [remap undo]. + * vc/ediff-wind.el (ediff-setup-windows-default): New function. (ediff-window-setup-function): Use it as the default, to set up windows based on whether the current frame is graphical (Bug#2138). === modified file 'lisp/vc/diff-mode.el' --- lisp/vc/diff-mode.el 2012-04-25 15:06:51 +0000 +++ lisp/vc/diff-mode.el 2012-04-26 03:43:32 +0000 @@ -107,8 +107,7 @@ ;;;; (easy-mmode-defmap diff-mode-shared-map - '(;; From Pavel Machek's patch-mode. - ("n" . diff-hunk-next) + '(("n" . diff-hunk-next) ("N" . diff-file-next) ("p" . diff-hunk-prev) ("P" . diff-file-prev) @@ -116,27 +115,17 @@ ([backtab] . diff-hunk-prev) ("k" . diff-hunk-kill) ("K" . diff-file-kill) - ;; From compilation-minor-mode. - ("}" . diff-file-next) + ("}" . diff-file-next) ; From compilation-minor-mode. ("{" . diff-file-prev) ("\C-m" . diff-goto-source) ([mouse-2] . diff-goto-source) - ;; From XEmacs's diff-mode. ("W" . widen) - ;;("." . diff-goto-source) ;display-buffer - ;;("f" . diff-goto-source) ;find-file - ("o" . diff-goto-source) ;other-window - ;;("w" . diff-goto-source) ;other-frame - ;;("N" . diff-narrow) - ;;("h" . diff-show-header) - ;;("j" . diff-show-difference) ;jump to Nth diff - ;;("q" . diff-quit) - ;; Not useful if you have to metafy them. - ;;(" " . scroll-up) - ;;("\177" . scroll-down) + ("o" . diff-goto-source) ; other-window ("A" . diff-ediff-patch) ("r" . diff-restrict-view) - ("R" . diff-reverse-direction)) + ("R" . diff-reverse-direction) + ("/" . diff-undo) + ([remap undo] . diff-undo)) "Basic keymap for `diff-mode', bound to various prefix keys." :inherit special-mode-map) @@ -1904,6 +1893,11 @@ (match-end 0) end props 'diff-refine-preproc)))))))) +(defun diff-undo (&optional arg) + "Perform `undo', ignoring the buffer's read-only status." + (interactive "P") + (let ((inhibit-read-only t)) + (undo arg))) (defun diff-add-change-log-entries-other-window () "Iterate through the current diff and create ChangeLog entries. ------------------------------------------------------------ revno: 108041 committer: Stefan Monnier branch nick: trunk timestamp: Wed 2012-04-25 23:18:47 -0400 message: * lisp/vc/vc-mtn.el: * lisp/vc/vc-hg.el: * lisp/vc/vc-git.el: * lisp/vc/vc-dir.el: * lisp/vc/vc-cvs.el: * lisp/vc/vc-bzr.el: * lisp/vc/vc-arch.el: * lisp/vc/vc.el: Replace lexical-let by lexical-binding. * lisp/minibuffer.el (lazy-completion-table): Avoid ((λ ...) ...). * lisp/emacs-lisp/cl-macs.el (lexical-let): Fix use in lexical-binding. * lisp/emacs-lisp/cconv.el (cconv-analyse-form): Warn use of ((λ ...) ...). diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-04-26 03:04:36 +0000 +++ lisp/ChangeLog 2012-04-26 03:18:47 +0000 @@ -1,3 +1,17 @@ +2012-04-26 Stefan Monnier + + * vc/vc-mtn.el: + * vc/vc-hg.el: + * vc/vc-git.el: + * vc/vc-dir.el: + * vc/vc-cvs.el: + * vc/vc-bzr.el: + * vc/vc-arch.el: + * vc/vc.el: Replace lexical-let by lexical-binding. + * minibuffer.el (lazy-completion-table): Avoid ((λ ...) ...). + * emacs-lisp/cl-macs.el (lexical-let): Fix use in lexical-binding. + * emacs-lisp/cconv.el (cconv-analyse-form): Warn use of ((λ ...) ...). + 2012-04-26 Chong Yidong * vc/ediff-wind.el (ediff-setup-windows-default): New function. === modified file 'lisp/emacs-lisp/cconv.el' --- lisp/emacs-lisp/cconv.el 2012-01-05 09:46:05 +0000 +++ lisp/emacs-lisp/cconv.el 2012-04-26 03:18:47 +0000 @@ -639,7 +639,9 @@ (cconv-analyse-form (cadr forms) env) (setq forms (cddr forms)))) - (`((lambda . ,_) . ,_) ; first element is lambda expression + (`((lambda . ,_) . ,_) ; First element is lambda expression. + (byte-compile-log-warning + "Use of deprecated ((lambda ...) ...) form" t :warning) (dolist (exp `((function ,(car form)) . ,(cdr form))) (cconv-analyse-form exp env))) === modified file 'lisp/emacs-lisp/cl-loaddefs.el' --- lisp/emacs-lisp/cl-loaddefs.el 2012-04-17 10:21:15 +0000 +++ lisp/emacs-lisp/cl-loaddefs.el 2012-04-26 03:18:47 +0000 @@ -286,7 +286,7 @@ ;;;;;; flet progv psetq do-all-symbols do-symbols dotimes dolist ;;;;;; do* do loop return-from return block etypecase typecase ecase ;;;;;; case load-time-value eval-when destructuring-bind function* -;;;;;; defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "91b45885535a73dd8015973cb8c988e1") +;;;;;; defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "abb2e33c6f61539d69ddbe7c4046261b") ;;; Generated autoloads from cl-macs.el (autoload 'gensym "cl-macs" "\ === modified file 'lisp/emacs-lisp/cl-macs.el' --- lisp/emacs-lisp/cl-macs.el 2012-01-19 07:21:25 +0000 +++ lisp/emacs-lisp/cl-macs.el 2012-04-26 03:18:47 +0000 @@ -1483,18 +1483,24 @@ (cons 'progn body) (nconc (mapcar (function (lambda (x) (list (symbol-name (car x)) - (list 'symbol-value (caddr x)) + (list 'symbol-value (caddr x)) t))) vars) (list '(defun . cl-defun-expander)) cl-macro-environment)))) (if (not (get (car (last cl-closure-vars)) 'used)) - (list 'let (mapcar (function (lambda (x) - (list (caddr x) (cadr x)))) vars) - (sublis (mapcar (function (lambda (x) - (cons (caddr x) - (list 'quote (caddr x))))) - vars) - ebody)) + ;; Turn (let ((foo (gensym))) (set foo ) ...(symbol-value foo)...) + ;; into (let ((foo )) ...(symbol-value 'foo)...). + ;; This is good because it's more efficient but it only works with + ;; dynamic scoping, since with lexical scoping we'd need + ;; (let ((foo )) ...foo...). + `(progn + ,@(mapcar (lambda (x) `(defvar ,(caddr x))) vars) + (let ,(mapcar (lambda (x) (list (caddr x) (cadr x))) vars) + ,(sublis (mapcar (lambda (x) + (cons (caddr x) + (list 'quote (caddr x)))) + vars) + ebody))) (list 'let (mapcar (function (lambda (x) (list (caddr x) (list 'make-symbol === modified file 'lisp/files.el' --- lisp/files.el 2012-04-25 14:47:33 +0000 +++ lisp/files.el 2012-04-26 03:18:47 +0000 @@ -3642,7 +3642,8 @@ (when (and enable-local-variables (not (file-remote-p (or (buffer-file-name) default-directory)))) ;; Find the variables file. - (let ((variables-file (dir-locals-find-file (or (buffer-file-name) default-directory))) + (let ((variables-file (dir-locals-find-file + (or (buffer-file-name) default-directory))) (class nil) (dir-name nil)) (cond === modified file 'lisp/minibuffer.el' --- lisp/minibuffer.el 2012-04-25 18:57:09 +0000 +++ lisp/minibuffer.el 2012-04-26 03:18:47 +0000 @@ -199,7 +199,7 @@ `(completion-table-dynamic (lambda (,str) (when (functionp ,var) - (setq ,var (,fun))) + (setq ,var (funcall #',fun))) ,var)))) (defun completion-table-case-fold (table &optional dont-fold) === modified file 'lisp/vc/vc-arch.el' --- lisp/vc/vc-arch.el 2012-02-25 04:29:09 +0000 +++ lisp/vc/vc-arch.el 2012-04-26 03:18:47 +0000 @@ -1,4 +1,4 @@ -;;; vc-arch.el --- VC backend for the Arch version-control system +;;; vc-arch.el --- VC backend for the Arch version-control system -*- lexical-binding: t -*- ;; Copyright (C) 2004-2012 Free Software Foundation, Inc. @@ -59,7 +59,7 @@ ;;; Properties of the backend (defun vc-arch-revision-granularity () 'repository) -(defun vc-arch-checkout-model (files) 'implicit) +(defun vc-arch-checkout-model (_files) 'implicit) ;;; ;;; Customization options @@ -227,7 +227,7 @@ (vc-file-setprop file 'arch-root root))))) -(defun vc-arch-register (files &optional rev comment) +(defun vc-arch-register (files &optional rev _comment) (if rev (error "Explicit initial revision not supported for Arch")) (dolist (file files) (let ((tagmet (vc-arch-tagging-method file))) @@ -258,7 +258,7 @@ ;; Strip the terminating newline. (buffer-substring (point-min) (1- (point-max))))))))) -(defun vc-arch-workfile-unchanged-p (file) +(defun vc-arch-workfile-unchanged-p (_file) "Stub: arch workfiles are always considered to be in a changed state," nil) @@ -508,12 +508,11 @@ "*")))))) (defun vc-arch-revision-completion-table (files) - (lexical-let ((files files)) - (lambda (string pred action) - ;; FIXME: complete revision patches as well. - (let* ((root (expand-file-name "{arch}" (vc-arch-root (car files)))) - (table (vc-arch--version-completion-table root string))) - (complete-with-action action table string pred))))) + (lambda (string pred action) + ;; FIXME: complete revision patches as well. + (let* ((root (expand-file-name "{arch}" (vc-arch-root (car files)))) + (table (vc-arch--version-completion-table root string))) + (complete-with-action action table string pred)))) ;;; Trimming revision libraries. @@ -547,13 +546,12 @@ minrev)) (defun vc-arch-trim-make-sentinel (revs) - (if (null revs) (lambda (proc msg) (message "VC-Arch trimming ... done")) - (lexical-let ((revs revs)) - (lambda (proc msg) - (message "VC-Arch trimming %s..." (file-name-nondirectory (car revs))) - (rename-file (car revs) (concat (car revs) "*rm*")) - (setq proc (start-process "vc-arch-trim" nil - "rm" "-rf" (concat (car revs) "*rm*"))) + (if (null revs) (lambda (_proc _msg) (message "VC-Arch trimming ... done")) + (lambda (_proc _msg) + (message "VC-Arch trimming %s..." (file-name-nondirectory (car revs))) + (rename-file (car revs) (concat (car revs) "*rm*")) + (let ((proc (start-process "vc-arch-trim" nil + "rm" "-rf" (concat (car revs) "*rm*")))) (set-process-sentinel proc (vc-arch-trim-make-sentinel (cdr revs))))))) (defun vc-arch-trim-one-revlib (dir) @@ -572,7 +570,7 @@ 'car-less-than-car)) (subdirs nil)) (when (cddr revs) - (dotimes (i (/ (length revs) 2)) + (dotimes (_i (/ (length revs) 2)) (let ((minrev (vc-arch-trim-find-least-useful-rev revs))) (setq revs (delq minrev revs)) (push minrev subdirs))) === modified file 'lisp/vc/vc-bzr.el' --- lisp/vc/vc-bzr.el 2012-04-11 03:24:26 +0000 +++ lisp/vc/vc-bzr.el 2012-04-26 03:18:47 +0000 @@ -1,4 +1,4 @@ -;;; vc-bzr.el --- VC backend for the bzr revision control system +;;; vc-bzr.el --- VC backend for the bzr revision control system -*- lexical-binding: t -*- ;; Copyright (C) 2006-2012 Free Software Foundation, Inc. @@ -41,7 +41,7 @@ ;;; Properties of the backend (defun vc-bzr-revision-granularity () 'repository) -(defun vc-bzr-checkout-model (files) 'implicit) +(defun vc-bzr-checkout-model (_files) 'implicit) ;;; Code: @@ -208,9 +208,9 @@ ;; + working ( = packed_stat ) ;; parent = common ( as above ) + history ( = rev_id ) ;; kinds = (r)elocated, (a)bsent, (d)irectory, (f)ile, (l)ink - (lexical-let ((root (vc-bzr-root file))) + (let ((root (vc-bzr-root file))) (when root ; Short cut. - (lexical-let ((dirstate (expand-file-name vc-bzr-admin-dirstate root))) + (let ((dirstate (expand-file-name vc-bzr-admin-dirstate root))) (condition-case nil (with-temp-buffer (insert-file-contents dirstate) @@ -303,9 +303,8 @@ (defun vc-bzr-file-name-relative (filename) "Return file name FILENAME stripped of the initial Bzr repository path." - (lexical-let* - ((filename* (expand-file-name filename)) - (rootdir (vc-bzr-root filename*))) + (let* ((filename* (expand-file-name filename)) + (rootdir (vc-bzr-root filename*))) (when rootdir (file-relative-name filename* rootdir)))) @@ -412,9 +411,8 @@ (with-temp-buffer ;; This is with-demoted-errors without the condition-case-unless-debug ;; annoyance, which makes it fail during ert testing. - (let (err) - (condition-case err (vc-bzr-command "status" t 0 file) - (error (message "Error: %S" err) nil))) + (condition-case err (vc-bzr-command "status" t 0 file) + (error (message "Error: %S" err) nil)) (let ((status 'unchanged)) ;; the only secure status indication in `bzr status' output ;; is a couple of lines following the pattern:: @@ -433,7 +431,7 @@ (if (file-directory-p file) "/?" "\\*?") "[ \t\n]*$") nil t) - (lexical-let ((statusword (match-string 1))) + (let ((statusword (match-string 1))) ;; Erase the status text that matched. (delete-region (match-beginning 0) (match-end 0)) (setq status @@ -452,7 +450,7 @@ (unless (eobp) (buffer-substring (point) (point-max)))))))) (defun vc-bzr-state (file) - (lexical-let ((result (vc-bzr-status file))) + (let ((result (vc-bzr-status file))) (when (consp result) (let ((warnings (cdr result))) (when warnings @@ -504,16 +502,15 @@ (defun vc-bzr-working-revision (file) ;; Together with the code in vc-state-heuristic, this makes it possible ;; to get the initial VC state of a Bzr file even if Bzr is not installed. - (lexical-let* - ((rootdir (vc-bzr-root file)) - (branch-format-file (expand-file-name vc-bzr-admin-branch-format-file - rootdir)) - (revhistory-file (expand-file-name vc-bzr-admin-revhistory rootdir)) - (lastrev-file (expand-file-name vc-bzr-admin-lastrev rootdir))) + (let* ((rootdir (vc-bzr-root file)) + (branch-format-file (expand-file-name vc-bzr-admin-branch-format-file + rootdir)) + (revhistory-file (expand-file-name vc-bzr-admin-revhistory rootdir)) + (lastrev-file (expand-file-name vc-bzr-admin-lastrev rootdir))) ;; This looks at internal files to avoid forking a bzr process. ;; May break if they change their format. (if (and (file-exists-p branch-format-file) - ;; For lightweight checkouts (obtained with bzr checkout --lightweight) + ;; For lightweight checkouts (obtained with bzr co --lightweight) ;; the branch-format-file does not contain the revision ;; information, we need to look up the branch-format-file ;; in the place where the lightweight checkout comes @@ -532,17 +529,21 @@ (when (re-search-forward "file://\\(.+\\)" nil t) (let ((l-c-parent-dir (match-string 1))) (when (and (memq system-type '(ms-dos windows-nt)) - (string-match-p "^/[[:alpha:]]:" l-c-parent-dir)) - ;;; The non-Windows code takes a shortcut by using the host/path - ;;; separator slash as the start of the absolute path. That - ;;; does not work on Windows, so we must remove it (bug#5345) + (string-match-p "^/[[:alpha:]]:" + l-c-parent-dir)) + ;;; The non-Windows code takes a shortcut by using + ;;; the host/path separator slash as the start of + ;;; the absolute path. That does not work on + ;;; Windows, so we must remove it (bug#5345) (setq l-c-parent-dir (substring l-c-parent-dir 1))) (setq branch-format-file (expand-file-name vc-bzr-admin-branch-format-file l-c-parent-dir)) (setq lastrev-file - (expand-file-name vc-bzr-admin-lastrev l-c-parent-dir)) - ;; FIXME: maybe it's overkill to check if both these files exist. + (expand-file-name vc-bzr-admin-lastrev + l-c-parent-dir)) + ;; FIXME: maybe it's overkill to check if both these + ;; files exist. (and (file-exists-p branch-format-file) (file-exists-p lastrev-file))))) t))) @@ -564,11 +565,10 @@ (when (re-search-forward "[0-9]+" nil t) (buffer-substring (match-beginning 0) (match-end 0)))))) ;; fallback to calling "bzr revno" - (lexical-let* - ((result (vc-bzr-command-discarding-stderr - vc-bzr-program "revno" (file-relative-name file))) - (exitcode (car result)) - (output (cdr result))) + (let* ((result (vc-bzr-command-discarding-stderr + vc-bzr-program "revno" (file-relative-name file))) + (exitcode (car result)) + (output (cdr result))) (cond ((eq exitcode 0) (substring output 0 -1)) (t nil)))))) @@ -577,21 +577,21 @@ "Create a new Bzr repository." (vc-bzr-command "init" nil 0 nil)) -(defun vc-bzr-init-revision (&optional file) +(defun vc-bzr-init-revision (&optional _file) "Always return nil, as Bzr cannot register explicit versions." nil) -(defun vc-bzr-previous-revision (file rev) +(defun vc-bzr-previous-revision (_file rev) (if (string-match "\\`[0-9]+\\'" rev) (number-to-string (1- (string-to-number rev))) (concat "before:" rev))) -(defun vc-bzr-next-revision (file rev) +(defun vc-bzr-next-revision (_file rev) (if (string-match "\\`[0-9]+\\'" rev) (number-to-string (1+ (string-to-number rev))) (error "Don't know how to compute the next revision of %s" rev))) -(defun vc-bzr-register (files &optional rev comment) +(defun vc-bzr-register (files &optional rev _comment) "Register FILES under bzr. Signal an error unless REV is nil. COMMENT is ignored." @@ -640,7 +640,7 @@ (vc-bzr-command "cat" t 0 file "-r" rev) (vc-bzr-command "cat" t 0 file)))) -(defun vc-bzr-checkout (file &optional editable rev) +(defun vc-bzr-checkout (_file &optional _editable rev) (if rev (error "Operation not supported") ;; Else, there's nothing to do. nil)) @@ -791,7 +791,7 @@ property containing author and date information." (apply #'vc-bzr-command "annotate" buffer 'async file "--long" "--all" (if revision (list "-r" revision))) - (lexical-let ((table (make-hash-table :test 'equal))) + (let ((table (make-hash-table :test 'equal))) (set-process-filter (get-buffer-process buffer) (lambda (proc string) @@ -956,7 +956,7 @@ ;; frob the results accordingly. (file-relative-name ,dir (vc-bzr-root ,dir))))) -(defun vc-bzr-dir-status-files (dir files default-state update-function) +(defun vc-bzr-dir-status-files (dir files _default-state update-function) "Return a list of conses (file . state) for DIR." (apply 'vc-bzr-command "status" (current-buffer) 'async dir "-v" "-S" files) (vc-exec-after @@ -1193,74 +1193,73 @@ "revno" "submit" "tag"))) (defun vc-bzr-revision-completion-table (files) - (lexical-let ((files files)) - ;; What about using `files'?!? --Stef - (lambda (string pred action) - (cond - ((string-match "\\`\\(ancestor\\|branch\\|\\(revno:\\)?[-0-9]+:\\):" - string) - (completion-table-with-context (substring string 0 (match-end 0)) - (apply-partially - 'completion-table-with-predicate - 'completion-file-name-table - 'file-directory-p t) - (substring string (match-end 0)) - pred - action)) - ((string-match "\\`\\(before\\):" string) - (completion-table-with-context (substring string 0 (match-end 0)) - (vc-bzr-revision-completion-table files) - (substring string (match-end 0)) - pred - action)) - ((string-match "\\`\\(tag\\):" string) - (let ((prefix (substring string 0 (match-end 0))) - (tag (substring string (match-end 0))) - (table nil) - process-file-side-effects) - (with-temp-buffer - ;; "bzr-1.2 tags" is much faster with --show-ids. - (process-file vc-bzr-program nil '(t) nil "tags" "--show-ids") - ;; The output is ambiguous, unless we assume that revids do not - ;; contain spaces. - (goto-char (point-min)) - (while (re-search-forward "^\\(.*[^ \n]\\) +[^ \n]*$" nil t) - (push (match-string-no-properties 1) table))) - (completion-table-with-context prefix table tag pred action))) - - ((string-match "\\`annotate:" string) - (completion-table-with-context - (substring string 0 (match-end 0)) - (apply-partially #'completion-table-with-terminator '(":" . "\\`a\\`") - #'completion-file-name-table) - (substring string (match-end 0)) pred action)) - - ((string-match "\\`date:" string) - (completion-table-with-context - (substring string 0 (match-end 0)) - '("yesterday" "today" "tomorrow") - (substring string (match-end 0)) pred action)) - - ((string-match "\\`\\([a-z]+\\):" string) - ;; no actual completion for the remaining keywords. - (completion-table-with-context (substring string 0 (match-end 0)) - (if (member (match-string 1 string) - vc-bzr-revision-keywords) - ;; If it's a valid keyword, - ;; use a non-empty table to - ;; indicate it. - '("") nil) - (substring string (match-end 0)) - pred - action)) - (t - ;; Could use completion-table-with-terminator, except that it - ;; currently doesn't work right w.r.t pcm and doesn't give - ;; the *Completions* output we want. - (complete-with-action action (eval-when-compile - (mapcar (lambda (s) (concat s ":")) - vc-bzr-revision-keywords)) - string pred)))))) + ;; What about using `files'?!? --Stef + (lambda (string pred action) + (cond + ((string-match "\\`\\(ancestor\\|branch\\|\\(revno:\\)?[-0-9]+:\\):" + string) + (completion-table-with-context (substring string 0 (match-end 0)) + (apply-partially + 'completion-table-with-predicate + 'completion-file-name-table + 'file-directory-p t) + (substring string (match-end 0)) + pred + action)) + ((string-match "\\`\\(before\\):" string) + (completion-table-with-context (substring string 0 (match-end 0)) + (vc-bzr-revision-completion-table files) + (substring string (match-end 0)) + pred + action)) + ((string-match "\\`\\(tag\\):" string) + (let ((prefix (substring string 0 (match-end 0))) + (tag (substring string (match-end 0))) + (table nil) + process-file-side-effects) + (with-temp-buffer + ;; "bzr-1.2 tags" is much faster with --show-ids. + (process-file vc-bzr-program nil '(t) nil "tags" "--show-ids") + ;; The output is ambiguous, unless we assume that revids do not + ;; contain spaces. + (goto-char (point-min)) + (while (re-search-forward "^\\(.*[^ \n]\\) +[^ \n]*$" nil t) + (push (match-string-no-properties 1) table))) + (completion-table-with-context prefix table tag pred action))) + + ((string-match "\\`annotate:" string) + (completion-table-with-context + (substring string 0 (match-end 0)) + (apply-partially #'completion-table-with-terminator '(":" . "\\`a\\`") + #'completion-file-name-table) + (substring string (match-end 0)) pred action)) + + ((string-match "\\`date:" string) + (completion-table-with-context + (substring string 0 (match-end 0)) + '("yesterday" "today" "tomorrow") + (substring string (match-end 0)) pred action)) + + ((string-match "\\`\\([a-z]+\\):" string) + ;; no actual completion for the remaining keywords. + (completion-table-with-context (substring string 0 (match-end 0)) + (if (member (match-string 1 string) + vc-bzr-revision-keywords) + ;; If it's a valid keyword, + ;; use a non-empty table to + ;; indicate it. + '("") nil) + (substring string (match-end 0)) + pred + action)) + (t + ;; Could use completion-table-with-terminator, except that it + ;; currently doesn't work right w.r.t pcm and doesn't give + ;; the *Completions* output we want. + (complete-with-action action (eval-when-compile + (mapcar (lambda (s) (concat s ":")) + vc-bzr-revision-keywords)) + string pred))))) (provide 'vc-bzr) === modified file 'lisp/vc/vc-cvs.el' --- lisp/vc/vc-cvs.el 2012-02-25 04:29:09 +0000 +++ lisp/vc/vc-cvs.el 2012-04-26 03:18:47 +0000 @@ -1,4 +1,4 @@ -;;; vc-cvs.el --- non-resident support for CVS version-control +;;; vc-cvs.el --- non-resident support for CVS version-control -*- lexical-binding: t -*- ;; Copyright (C) 1995, 1998-2012 Free Software Foundation, Inc. @@ -280,7 +280,7 @@ ;;; State-changing functions ;;; -(defun vc-cvs-register (files &optional rev comment) +(defun vc-cvs-register (files &optional _rev comment) "Register FILES into the CVS version-control system. COMMENT can be used to provide an initial description of FILES. Passes either `vc-cvs-register-switches' or `vc-register-switches' @@ -502,7 +502,7 @@ (declare-function vc-rcs-print-log-cleanup "vc-rcs" ()) -(defun vc-cvs-print-log (files buffer &optional shortlog start-revision-ignored limit) +(defun vc-cvs-print-log (files buffer &optional _shortlog _start-revision limit) "Get change logs associated with FILES." (require 'vc-rcs) ;; It's just the catenation of the individual logs. @@ -1006,7 +1006,7 @@ (vc-exec-after `(vc-cvs-after-dir-status (quote ,update-function)))))) -(defun vc-cvs-dir-status-files (dir files default-state update-function) +(defun vc-cvs-dir-status-files (dir files _default-state update-function) "Create a list of conses (file . state) for DIR." (apply 'vc-cvs-command (current-buffer) 'async dir "-f" "status" files) (vc-exec-after @@ -1021,7 +1021,7 @@ (buffer-substring (point) (point-max))) (file-error nil))) -(defun vc-cvs-dir-extra-headers (dir) +(defun vc-cvs-dir-extra-headers (_dir) "Extract and represent per-directory properties of a CVS working copy." (let ((repo (condition-case nil @@ -1206,10 +1206,8 @@ res))) (defun vc-cvs-revision-completion-table (files) - (lexical-let ((files files) - table) - (setq table (lazy-completion-table - table (lambda () (vc-cvs-revision-table (car files))))) + (letrec ((table (lazy-completion-table + table (lambda () (vc-cvs-revision-table (car files)))))) table)) === modified file 'lisp/vc/vc-dir.el' --- lisp/vc/vc-dir.el 2012-04-16 23:57:09 +0000 +++ lisp/vc/vc-dir.el 2012-04-26 03:18:47 +0000 @@ -1,4 +1,4 @@ -;;; vc-dir.el --- Directory status display under VC +;;; vc-dir.el --- Directory status display under VC -*- lexical-binding: t -*- ;; Copyright (C) 2007-2012 Free Software Foundation, Inc. @@ -529,7 +529,7 @@ (defun vc-dir-mark-unmark (mark-unmark-function) (if (use-region-p) - (let ((firstl (line-number-at-pos (region-beginning))) + (let (;; (firstl (line-number-at-pos (region-beginning))) (lastl (line-number-at-pos (region-end)))) (save-excursion (goto-char (region-beginning)) @@ -546,7 +546,7 @@ ;; Non-nil iff a parent directory of arg is marked. ;; Return value, if non-nil is the `ewoc-data' for the marked parent. (let* ((argdir (vc-dir-node-directory arg)) - (arglen (length argdir)) + ;; (arglen (length argdir)) (crt arg) (found nil)) ;; Go through the predecessors, checking if any directory that is @@ -814,7 +814,7 @@ ;; FIXME: use vc-dir-child-files-and-states here instead of duplicating it. (if (vc-dir-fileinfo->directory crt-data) (let* ((dir (vc-dir-fileinfo->directory crt-data)) - (dirlen (length dir)) + ;; (dirlen (length dir)) data) (while (and (setq crt (ewoc-next vc-ewoc crt)) @@ -842,7 +842,7 @@ result) (if (vc-dir-fileinfo->directory crt-data) (let* ((dir (vc-dir-fileinfo->directory crt-data)) - (dirlen (length dir)) + ;; (dirlen (length dir)) data) (while (and (setq crt (ewoc-next vc-ewoc crt)) @@ -861,7 +861,7 @@ (defun vc-dir-recompute-file-state (fname def-dir) (let* ((file-short (file-relative-name fname def-dir)) - (remove-me-when-CVS-works + (_remove-me-when-CVS-works (when (eq vc-dir-backend 'CVS) ;; FIXME: Warning: UGLY HACK. The CVS backend caches the state ;; info, this forces the backend to update it. @@ -875,15 +875,14 @@ ;; Give a DIRNAME string return the list of all child files shown in ;; the current *vc-dir* buffer. (let ((crt (ewoc-nth vc-ewoc 0)) - children - dname) + children) ;; Find DIR (while (and crt (not (string-prefix-p dirname (vc-dir-node-directory crt)))) (setq crt (ewoc-next vc-ewoc crt))) (while (and crt (string-prefix-p dirname - (setq dname (vc-dir-node-directory crt)))) + (vc-dir-node-directory crt))) (let ((data (ewoc-data crt))) (unless (vc-dir-fileinfo->directory data) (push (expand-file-name (vc-dir-fileinfo->name data)) children))) @@ -1014,7 +1013,7 @@ (unless (buffer-live-p vc-dir-process-buffer) (setq vc-dir-process-buffer (generate-new-buffer (format " *VC-%s* tmp status" backend)))) - (lexical-let ((buffer (current-buffer))) + (let ((buffer (current-buffer))) (with-current-buffer vc-dir-process-buffer (setq default-directory def-dir) (erase-buffer) @@ -1045,7 +1044,7 @@ (not (vc-dir-fileinfo->needs-update info)))))))))))) -(defun vc-dir-revert-buffer-function (&optional ignore-auto noconfirm) +(defun vc-dir-revert-buffer-function (&optional _ignore-auto _noconfirm) (vc-dir-refresh)) (defun vc-dir-refresh () @@ -1079,7 +1078,7 @@ ;; Bzr has serious locking problems, so setup the headers first (this is ;; synchronous) rather than doing it while dir-status is running. (ewoc-set-hf vc-ewoc (vc-dir-headers backend def-dir) "") - (lexical-let ((buffer (current-buffer))) + (let ((buffer (current-buffer))) (with-current-buffer vc-dir-process-buffer (setq default-directory def-dir) (erase-buffer) @@ -1219,7 +1218,7 @@ (let ((use-vc-backend backend)) (vc-dir-mode)))) -(defun vc-default-dir-extra-headers (backend dir) +(defun vc-default-dir-extra-headers (_backend _dir) ;; Be loud by default to remind people to add code to display ;; backend specific headers. ;; XXX: change this to return nil before the release. @@ -1234,7 +1233,7 @@ map) "Local keymap for visiting a file.") -(defun vc-default-dir-printer (backend fileentry) +(defun vc-default-dir-printer (_backend fileentry) "Pretty print FILEENTRY." ;; If you change the layout here, change vc-dir-move-to-goal-column. ;; VC backends can implement backend specific versions of this @@ -1267,10 +1266,10 @@ 'mouse-face 'highlight 'keymap vc-dir-filename-mouse-map)))) -(defun vc-default-extra-status-menu (backend) +(defun vc-default-extra-status-menu (_backend) nil) -(defun vc-default-status-fileinfo-extra (backend file) +(defun vc-default-status-fileinfo-extra (_backend _file) "Default absence of extra information returned for a file." nil) === modified file 'lisp/vc/vc-git.el' --- lisp/vc/vc-git.el 2012-03-28 10:12:02 +0000 +++ lisp/vc/vc-git.el 2012-04-26 03:18:47 +0000 @@ -1,4 +1,4 @@ -;;; vc-git.el --- VC backend for the git version control system +;;; vc-git.el --- VC backend for the git version control system -*- lexical-binding: t -*- ;; Copyright (C) 2006-2012 Free Software Foundation, Inc. @@ -160,7 +160,7 @@ ;;; BACKEND PROPERTIES (defun vc-git-revision-granularity () 'repository) -(defun vc-git-checkout-model (files) 'implicit) +(defun vc-git-checkout-model (_files) 'implicit) ;;; STATE-QUERYING FUNCTIONS @@ -233,7 +233,7 @@ (vc-git--state-code diff-letter))) (if (vc-git--empty-db-p) 'added 'up-to-date))))) -(defun vc-git-working-revision (file) +(defun vc-git-working-revision (_file) "Git-specific version of `vc-working-revision'." (let* (process-file-side-effects (str (with-output-to-string @@ -471,14 +471,14 @@ (vc-exec-after `(vc-git-after-dir-status-stage ',stage ',files ',update-function))) -(defun vc-git-dir-status (dir update-function) +(defun vc-git-dir-status (_dir update-function) "Return a list of (FILE STATE EXTRA) entries for DIR." ;; Further things that would have to be fixed later: ;; - how to handle unregistered directories ;; - how to support vc-dir on a subdir of the project tree (vc-git-dir-status-goto-stage 'update-index nil update-function)) -(defun vc-git-dir-status-files (dir files default-state update-function) +(defun vc-git-dir-status-files (_dir files _default-state update-function) "Return a list of (FILE STATE EXTRA) entries for FILES in DIR." (vc-git-dir-status-goto-stage 'update-index files update-function)) @@ -512,7 +512,7 @@ :help "Show the contents of the current stash")) map)) -(defun vc-git-dir-extra-headers (dir) +(defun vc-git-dir-extra-headers (_dir) (let ((str (with-output-to-string (with-current-buffer standard-output (vc-git--out-ok "symbolic-ref" "HEAD")))) @@ -590,7 +590,7 @@ "Create a new Git repository." (vc-git-command nil 0 nil "init")) -(defun vc-git-register (files &optional rev comment) +(defun vc-git-register (files &optional _rev _comment) "Register FILES into the git version-control system." (let (flist dlist) (dolist (crt files) @@ -609,7 +609,7 @@ (declare-function log-edit-extract-headers "log-edit" (headers string)) -(defun vc-git-checkin (files rev comment) +(defun vc-git-checkin (files _rev comment) (let ((coding-system-for-write vc-git-commits-coding-system)) (apply 'vc-git-command nil 0 files (nconc (list "commit" "-m") @@ -635,7 +635,7 @@ nil "cat-file" "blob" (concat (if rev rev "HEAD") ":" fullname)))) -(defun vc-git-checkout (file &optional editable rev) +(defun vc-git-checkout (file &optional _editable rev) (vc-git-command nil 0 file "checkout" (or rev "HEAD"))) (defun vc-git-revert (file &optional contents-done) @@ -821,7 +821,7 @@ (append (vc-switches 'git 'diff) (list "-p" (or rev1 "HEAD") rev2 "--"))))) -(defun vc-git-revision-table (files) +(defun vc-git-revision-table (_files) ;; What about `files'?!? --Stef (let (process-file-side-effects (table (list "HEAD"))) @@ -834,10 +834,8 @@ table)) (defun vc-git-revision-completion-table (files) - (lexical-let ((files files) - table) - (setq table (lazy-completion-table - table (lambda () (vc-git-revision-table files)))) + (letrec ((table (lazy-completion-table + table (lambda () (vc-git-revision-table files))))) table)) (defun vc-git-annotate-command (file buf &optional rev) @@ -876,7 +874,7 @@ (vc-git-command nil 0 nil "checkout" "-b" name) (vc-git-command nil 0 nil "tag" name))))) -(defun vc-git-retrieve-tag (dir name update) +(defun vc-git-retrieve-tag (dir name _update) (let ((default-directory dir)) (vc-git-command nil 0 nil "checkout" name) ;; FIXME: update buffers if `update' is true === modified file 'lisp/vc/vc-hg.el' --- lisp/vc/vc-hg.el 2012-04-16 18:48:46 +0000 +++ lisp/vc/vc-hg.el 2012-04-26 03:18:47 +0000 @@ -1,4 +1,4 @@ -;;; vc-hg.el --- VC backend for the mercurial version control system +;;; vc-hg.el --- VC backend for the mercurial version control system -*- lexical-binding: t -*- ;; Copyright (C) 2006-2012 Free Software Foundation, Inc. @@ -168,7 +168,7 @@ (defvar vc-hg-history nil) (defun vc-hg-revision-granularity () 'repository) -(defun vc-hg-checkout-model (files) 'implicit) +(defun vc-hg-checkout-model (_files) 'implicit) ;;; State querying functions @@ -338,10 +338,8 @@ ;; Modeled after the similar function in vc-cvs.el (defun vc-hg-revision-completion-table (files) - (lexical-let ((files files) - table) - (setq table (lazy-completion-table - table (lambda () (vc-hg-revision-table files)))) + (letrec ((table (lazy-completion-table + table (lambda () (vc-hg-revision-table files))))) table)) (defun vc-hg-annotate-command (file buffer &optional revision) @@ -377,12 +375,12 @@ (expand-file-name (match-string-no-properties 4) (vc-hg-root default-directory))))))) -(defun vc-hg-previous-revision (file rev) +(defun vc-hg-previous-revision (_file rev) (let ((newrev (1- (string-to-number rev)))) (when (>= newrev 0) (number-to-string newrev)))) -(defun vc-hg-next-revision (file rev) +(defun vc-hg-next-revision (_file rev) (let ((newrev (1+ (string-to-number rev))) (tip-revision (with-temp-buffer @@ -408,7 +406,7 @@ "Rename file from OLD to NEW using `hg mv'." (vc-hg-command nil 0 new "mv" old)) -(defun vc-hg-register (files &optional rev comment) +(defun vc-hg-register (files &optional _rev _comment) "Register FILES under hg. REV is ignored. COMMENT is ignored." @@ -438,7 +436,7 @@ (declare-function log-edit-extract-headers "log-edit" (headers string)) -(defun vc-hg-checkin (files rev comment) +(defun vc-hg-checkin (files _rev comment) "Hg-specific version of `vc-backend-checkin'. REV is ignored." (apply 'vc-hg-command nil 0 files @@ -455,7 +453,7 @@ (vc-hg-command buffer 0 file "cat")))) ;; Modeled after the similar function in vc-bzr.el -(defun vc-hg-checkout (file &optional editable rev) +(defun vc-hg-checkout (file &optional _editable rev) "Retrieve a revision of FILE. EDITABLE is ignored. REV is the revision to check out into WORKFILE." @@ -511,8 +509,7 @@ 'face 'font-lock-comment-face))))) (defun vc-hg-after-dir-status (update-function) - (let ((status-char nil) - (file nil) + (let ((file nil) (translation '((?= . up-to-date) (?C . up-to-date) (?A . added) @@ -567,7 +564,7 @@ (vc-exec-after `(vc-hg-after-dir-status (quote ,update-function)))) -(defun vc-hg-dir-status-files (dir files default-state update-function) +(defun vc-hg-dir-status-files (dir files _default-state update-function) (apply 'vc-hg-command (current-buffer) 'async dir "status" "-C" files) (vc-exec-after `(vc-hg-after-dir-status (quote ,update-function)))) === modified file 'lisp/vc/vc-mtn.el' --- lisp/vc/vc-mtn.el 2012-02-25 04:29:09 +0000 +++ lisp/vc/vc-mtn.el 2012-04-26 03:18:47 +0000 @@ -1,4 +1,4 @@ -;;; vc-mtn.el --- VC backend for Monotone +;;; vc-mtn.el --- VC backend for Monotone -*- lexical-binding: t -*- ;; Copyright (C) 2007-2012 Free Software Foundation, Inc. @@ -76,7 +76,7 @@ ;;;###autoload (vc-mtn-registered file)))) (defun vc-mtn-revision-granularity () 'repository) -(defun vc-mtn-checkout-model (files) 'implicit) +(defun vc-mtn-checkout-model (_files) 'implicit) (defun vc-mtn-root (file) (setq file (if (file-directory-p file) @@ -173,7 +173,7 @@ (t ?:)) branch))) -(defun vc-mtn-register (files &optional rev comment) +(defun vc-mtn-register (files &optional _rev _comment) (vc-mtn-command nil 0 files "add")) (defun vc-mtn-responsible-p (file) (vc-mtn-root file)) @@ -181,7 +181,7 @@ (declare-function log-edit-extract-headers "log-edit" (headers string)) -(defun vc-mtn-checkin (files rev comment) +(defun vc-mtn-checkin (files _rev comment) (apply 'vc-mtn-command nil 0 files (nconc (list "commit" "-m") (log-edit-extract-headers '(("Author" . "--author") @@ -201,7 +201,7 @@ ;; (defun vc-mtn-rollback (files) ;; ) -(defun vc-mtn-print-log (files buffer &optional shortlog start-revision limit) +(defun vc-mtn-print-log (files buffer &optional _shortlog start-revision limit) (apply 'vc-mtn-command buffer 0 files "log" (append (when start-revision (list "--from" (format "%s" start-revision))) @@ -304,44 +304,43 @@ (push (match-string 0) ids)) ids))) -(defun vc-mtn-revision-completion-table (files) +(defun vc-mtn-revision-completion-table (_files) ;; TODO: Implement completion for selectors ;; TODO: Implement completion for composite selectors. - (lexical-let ((files files)) - ;; What about using `files'?!? --Stef - (lambda (string pred action) - (cond - ;; "Tag" selectors. - ((string-match "\\`t:" string) - (complete-with-action action - (mapcar (lambda (tag) (concat "t:" tag)) - (vc-mtn-list-tags)) - string pred)) - ;; "Branch" selectors. - ((string-match "\\`b:" string) - (complete-with-action action - (mapcar (lambda (tag) (concat "b:" tag)) - (vc-mtn-list-branches)) - string pred)) - ;; "Head" selectors. Not sure how they differ from "branch" selectors. - ((string-match "\\`h:" string) - (complete-with-action action - (mapcar (lambda (tag) (concat "h:" tag)) - (vc-mtn-list-branches)) - string pred)) - ;; "ID" selectors. - ((string-match "\\`i:" string) - (complete-with-action action - (mapcar (lambda (tag) (concat "i:" tag)) - (vc-mtn-list-revision-ids - (substring string (match-end 0)))) - string pred)) - (t - (complete-with-action action - '("t:" "b:" "h:" "i:" - ;; Completion not implemented for these. - "a:" "c:" "d:" "e:" "l:") - string pred)))))) + ;; What about using `files'?!? --Stef + (lambda (string pred action) + (cond + ;; "Tag" selectors. + ((string-match "\\`t:" string) + (complete-with-action action + (mapcar (lambda (tag) (concat "t:" tag)) + (vc-mtn-list-tags)) + string pred)) + ;; "Branch" selectors. + ((string-match "\\`b:" string) + (complete-with-action action + (mapcar (lambda (tag) (concat "b:" tag)) + (vc-mtn-list-branches)) + string pred)) + ;; "Head" selectors. Not sure how they differ from "branch" selectors. + ((string-match "\\`h:" string) + (complete-with-action action + (mapcar (lambda (tag) (concat "h:" tag)) + (vc-mtn-list-branches)) + string pred)) + ;; "ID" selectors. + ((string-match "\\`i:" string) + (complete-with-action action + (mapcar (lambda (tag) (concat "i:" tag)) + (vc-mtn-list-revision-ids + (substring string (match-end 0)))) + string pred)) + (t + (complete-with-action action + '("t:" "b:" "h:" "i:" + ;; Completion not implemented for these. + "a:" "c:" "d:" "e:" "l:") + string pred))))) === modified file 'lisp/vc/vc.el' --- lisp/vc/vc.el 2012-04-25 15:06:51 +0000 +++ lisp/vc/vc.el 2012-04-26 03:18:47 +0000 @@ -1,4 +1,4 @@ -;;; vc.el --- drive a version-control system from within Emacs +;;; vc.el --- drive a version-control system from within Emacs -*- lexical-binding: t -*- ;; Copyright (C) 1992-1998, 2000-2012 Free Software Foundation, Inc. @@ -1075,7 +1075,7 @@ (let* ((vc-fileset (vc-deduce-fileset nil t 'state-model-only-files)) (backend (car vc-fileset)) (files (nth 1 vc-fileset)) - (fileset-only-files (nth 2 vc-fileset)) + ;; (fileset-only-files (nth 2 vc-fileset)) ;; FIXME: We used to call `vc-recompute-state' here. (state (nth 3 vc-fileset)) ;; The backend should check that the checkout-model is consistent @@ -1410,34 +1410,31 @@ Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'." (when vc-before-checkin-hook (run-hooks 'vc-before-checkin-hook)) - (lexical-let - ((backend backend)) - (vc-start-logentry - files comment initial-contents - "Enter a change comment." - "*vc-log*" - (lambda () - (vc-call-backend backend 'log-edit-mode)) - (lexical-let ((rev rev)) - (lambda (files comment) - (message "Checking in %s..." (vc-delistify files)) - ;; "This log message intentionally left almost blank". - ;; RCS 5.7 gripes about white-space-only comments too. - (or (and comment (string-match "[^\t\n ]" comment)) - (setq comment "*** empty log message ***")) - (with-vc-properties - files - ;; We used to change buffers to get local value of - ;; vc-checkin-switches, but 'the' local buffer is - ;; not a well-defined concept for filesets. - (progn - (vc-call-backend backend 'checkin files rev comment) - (mapc 'vc-delete-automatic-version-backups files)) - `((vc-state . up-to-date) - (vc-checkout-time . ,(nth 5 (file-attributes file))) - (vc-working-revision . nil))) - (message "Checking in %s...done" (vc-delistify files)))) - 'vc-checkin-hook))) + (vc-start-logentry + files comment initial-contents + "Enter a change comment." + "*vc-log*" + (lambda () + (vc-call-backend backend 'log-edit-mode)) + (lambda (files comment) + (message "Checking in %s..." (vc-delistify files)) + ;; "This log message intentionally left almost blank". + ;; RCS 5.7 gripes about white-space-only comments too. + (or (and comment (string-match "[^\t\n ]" comment)) + (setq comment "*** empty log message ***")) + (with-vc-properties + files + ;; We used to change buffers to get local value of + ;; vc-checkin-switches, but 'the' local buffer is + ;; not a well-defined concept for filesets. + (progn + (vc-call-backend backend 'checkin files rev comment) + (mapc 'vc-delete-automatic-version-backups files)) + `((vc-state . up-to-date) + (vc-checkout-time . ,(nth 5 (file-attributes file))) + (vc-working-revision . nil))) + (message "Checking in %s...done" (vc-delistify files))) + 'vc-checkin-hook)) ;;; Additional entry points for examining version histories @@ -1671,7 +1668,7 @@ (list files rev1 rev2)))) ;;;###autoload -(defun vc-version-diff (files rev1 rev2) +(defun vc-version-diff (_files rev1 rev2) "Report diffs between revisions of the fileset in the repository history." (interactive (vc-diff-build-argument-list-internal)) ;; All that was just so we could do argument completion! @@ -1883,11 +1880,9 @@ "Enter a replacement change comment." "*vc-log*" (lambda () (vc-call-backend backend 'log-edit-mode)) - (lexical-let ((rev rev) - (backend backend)) - (lambda (files comment) - (vc-call-backend backend - 'modify-change-comment files rev comment)))))) + (lambda (files comment) + (vc-call-backend backend + 'modify-change-comment files rev comment))))) ;;;###autoload (defun vc-merge () @@ -1952,7 +1947,7 @@ (error "Sorry, merging is not implemented for %s" backend))))) -(defun vc-maybe-resolve-conflicts (file status &optional name-A name-B) +(defun vc-maybe-resolve-conflicts (file status &optional _name-A _name-B) (vc-resynch-buffer file t (not (buffer-modified-p))) (if (zerop status) (message "Merge successful") (smerge-mode 1) @@ -2077,22 +2072,20 @@ (when (and limit (not (eq 'limit-unsupported pl-return)) (not is-start-revision)) (goto-char (point-max)) - (lexical-let ((working-revision working-revision) - (limit limit)) - (insert "\n") - (insert-text-button "Show 2X entries" - 'action (lambda (&rest ignore) - (vc-print-log-internal - log-view-vc-backend log-view-vc-fileset - working-revision nil (* 2 limit))) - 'help-echo "Show the log again, and double the number of log entries shown") - (insert " ") - (insert-text-button "Show unlimited entries" - 'action (lambda (&rest ignore) - (vc-print-log-internal - log-view-vc-backend log-view-vc-fileset - working-revision nil nil)) - 'help-echo "Show the log again, including all entries")))) + (insert "\n") + (insert-text-button "Show 2X entries" + 'action (lambda (&rest _ignore) + (vc-print-log-internal + log-view-vc-backend log-view-vc-fileset + working-revision nil (* 2 limit))) + 'help-echo "Show the log again, and double the number of log entries shown") + (insert " ") + (insert-text-button "Show unlimited entries" + 'action (lambda (&rest _ignore) + (vc-print-log-internal + log-view-vc-backend log-view-vc-fileset + working-revision nil nil)) + 'help-echo "Show the log again, including all entries"))) (defun vc-print-log-internal (backend files working-revision &optional is-start-revision limit) @@ -2102,8 +2095,7 @@ (let ((dir-present nil) (vc-short-log nil) (buffer-name "*vc-change-log*") - type - pl-return) + type) (dolist (file files) (when (file-directory-p file) (setq dir-present t))) @@ -2112,25 +2104,20 @@ (memq 'directory vc-log-short-style) (memq 'file vc-log-short-style))))) (setq type (if vc-short-log 'short 'long)) - (lexical-let - ((working-revision working-revision) - (backend backend) - (limit limit) - (shortlog vc-short-log) - (files files) - (is-start-revision is-start-revision)) + (let ((shortlog vc-short-log)) (vc-log-internal-common backend buffer-name files type - (lambda (bk buf type-arg files-arg) - (vc-call-backend bk 'print-log files-arg buf - shortlog (when is-start-revision working-revision) limit)) - (lambda (bk files-arg ret) + (lambda (bk buf _type-arg files-arg) + (vc-call-backend bk 'print-log files-arg buf shortlog + (when is-start-revision working-revision) limit)) + (lambda (_bk _files-arg ret) (vc-print-log-setup-buttons working-revision is-start-revision limit ret)) (lambda (bk) (vc-call-backend bk 'show-log-entry working-revision)) - (lambda (ignore-auto noconfirm) - (vc-print-log-internal backend files working-revision is-start-revision limit)))))) + (lambda (_ignore-auto _noconfirm) + (vc-print-log-internal backend files working-revision + is-start-revision limit)))))) (defvar vc-log-view-type nil "Set this to differentiate the different types of logs.") @@ -2168,20 +2155,12 @@ (defun vc-incoming-outgoing-internal (backend remote-location buffer-name type) (vc-log-internal-common backend buffer-name nil type - (lexical-let - ((remote-location remote-location)) - (lambda (bk buf type-arg files) - (vc-call-backend bk type-arg buf remote-location))) - (lambda (bk files-arg ret)) - (lambda (bk) - (goto-char (point-min))) - (lexical-let - ((backend backend) - (remote-location remote-location) - (buffer-name buffer-name) - (type type)) - (lambda (ignore-auto noconfirm) - (vc-incoming-outgoing-internal backend remote-location buffer-name type))))) + (lambda (bk buf type-arg _files) + (vc-call-backend bk type-arg buf remote-location)) + (lambda (_bk _files-arg _ret) nil) + (lambda (_bk) (goto-char (point-min))) + (lambda (_ignore-auto _noconfirm) + (vc-incoming-outgoing-internal backend remote-location buffer-name type)))) ;;;###autoload (defun vc-print-log (&optional working-revision limit) @@ -2246,11 +2225,11 @@ (interactive (when current-prefix-arg (list (read-string "Remote location (empty for default): ")))) - (let ((backend (vc-deduce-backend)) - rootdir working-revision) + (let ((backend (vc-deduce-backend))) (unless backend (error "Buffer is not version controlled")) - (vc-incoming-outgoing-internal backend remote-location "*vc-incoming*" 'log-incoming))) + (vc-incoming-outgoing-internal backend remote-location "*vc-incoming*" + 'log-incoming))) ;;;###autoload (defun vc-log-outgoing (&optional remote-location) @@ -2259,11 +2238,11 @@ (interactive (when current-prefix-arg (list (read-string "Remote location (empty for default): ")))) - (let ((backend (vc-deduce-backend)) - rootdir working-revision) + (let ((backend (vc-deduce-backend))) (unless backend (error "Buffer is not version controlled")) - (vc-incoming-outgoing-internal backend remote-location "*vc-outgoing*" 'log-outgoing))) + (vc-incoming-outgoing-internal backend remote-location "*vc-outgoing*" + 'log-outgoing))) ;;;###autoload (defun vc-revert () @@ -2688,23 +2667,23 @@ (when index (substring rev 0 index)))) -(defun vc-default-responsible-p (backend file) +(defun vc-default-responsible-p (_backend _file) "Indicate whether BACKEND is responsible for FILE. The default is to return nil always." nil) -(defun vc-default-could-register (backend file) +(defun vc-default-could-register (_backend _file) "Return non-nil if BACKEND could be used to register FILE. The default implementation returns t for all files." t) -(defun vc-default-latest-on-branch-p (backend file) +(defun vc-default-latest-on-branch-p (_backend _file) "Return non-nil if FILE is the latest on its branch. This default implementation always returns non-nil, which means that editing non-current revisions is not supported by default." t) -(defun vc-default-init-revision (backend) vc-default-init-revision) +(defun vc-default-init-revision (_backend) vc-default-init-revision) (defun vc-default-find-revision (backend file rev buffer) "Provide the new `find-revision' op based on the old `checkout' op. @@ -2718,7 +2697,7 @@ (insert-file-contents-literally tmpfile))) (delete-file tmpfile)))) -(defun vc-default-rename-file (backend old new) +(defun vc-default-rename-file (_backend old new) (condition-case nil (add-name-to-file old new) (error (rename-file old new))) @@ -2730,11 +2709,11 @@ (declare-function log-edit-mode "log-edit" ()) -(defun vc-default-log-edit-mode (backend) (log-edit-mode)) - -(defun vc-default-log-view-mode (backend) (log-view-mode)) - -(defun vc-default-show-log-entry (backend rev) +(defun vc-default-log-edit-mode (_backend) (log-edit-mode)) + +(defun vc-default-log-view-mode (_backend) (log-view-mode)) + +(defun vc-default-show-log-entry (_backend rev) (with-no-warnings (log-view-goto-rev rev))) @@ -2800,7 +2779,7 @@ (defalias 'vc-default-revision-completion-table 'ignore) (defalias 'vc-default-mark-resolved 'ignore) -(defun vc-default-dir-status-files (backend dir files default-state update-function) +(defun vc-default-dir-status-files (_backend _dir files default-state update-function) (funcall update-function (mapcar (lambda (file) (list file default-state)) files))) ------------------------------------------------------------ revno: 108040 fixes bug(s): http://debbugs.gnu.org/2138 committer: Chong Yidong branch nick: trunk timestamp: Thu 2012-04-26 11:04:36 +0800 message: Adapt ediff window handling to multi-tty. * vc/ediff-init.el: Always define ediff-pixel-width/height. * vc/ediff-wind.el (ediff-setup-windows-default): New function. (ediff-window-setup-function): Use it as the default, to set up windows based on whether the current frame is graphical. (ediff-choose-window-setup-function-automatically): Make obsolete. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-04-25 19:00:18 +0000 +++ lisp/ChangeLog 2012-04-26 03:04:36 +0000 @@ -1,3 +1,12 @@ +2012-04-26 Chong Yidong + + * vc/ediff-wind.el (ediff-setup-windows-default): New function. + (ediff-window-setup-function): Use it as the default, to set up + windows based on whether the current frame is graphical (Bug#2138). + (ediff-choose-window-setup-function-automatically): Make obsolete. + + * vc/ediff-init.el: Always define ediff-pixel-width/height. + 2012-04-25 Stefan Monnier * ffap.el: Remove old code for obsolete package. === modified file 'lisp/vc/ediff-init.el' --- lisp/vc/ediff-init.el 2012-04-09 13:05:48 +0000 +++ lisp/vc/ediff-init.el 2012-04-26 03:04:36 +0000 @@ -786,19 +786,12 @@ "") -(if (ediff-window-display-p) - (if (featurep 'xemacs) - (progn - (defalias 'ediff-display-pixel-width 'device-pixel-width) - (defalias 'ediff-display-pixel-height 'device-pixel-height)) - (defalias 'ediff-display-pixel-width - (if (fboundp 'display-pixel-width) - 'display-pixel-width - 'x-display-pixel-width)) - (defalias 'ediff-display-pixel-height - (if (fboundp 'display-pixel-height) - 'display-pixel-height - 'x-display-pixel-height)))) +(if (featurep 'xemacs) + (progn + (defalias 'ediff-display-pixel-width 'device-pixel-width) + (defalias 'ediff-display-pixel-height 'device-pixel-height)) + (defalias 'ediff-display-pixel-width 'display-pixel-width) + (defalias 'ediff-display-pixel-height 'display-pixel-height)) ;; A-list of current-diff-overlay symbols associated with buf types (defconst ediff-current-diff-overlay-alist === modified file 'lisp/vc/ediff-wind.el' --- lisp/vc/ediff-wind.el 2012-01-19 07:21:25 +0000 +++ lisp/vc/ediff-wind.el 2012-04-26 03:04:36 +0000 @@ -67,16 +67,23 @@ 'ediff-setup-windows-multiframe 'ediff-setup-windows-plain)) -(defcustom ediff-window-setup-function (ediff-choose-window-setup-function-automatically) +(make-obsolete 'ediff-choose-window-setup-function-automatically + 'ediff-setup-windows-default "24.2") + +(defcustom ediff-window-setup-function 'ediff-setup-windows-default "Function called to set up windows. -Ediff provides a choice of two functions: `ediff-setup-windows-plain', for -doing everything in one frame and `ediff-setup-windows-multiframe', which sets -the control panel in a separate frame. By default, the appropriate function is -chosen automatically depending on the current window system. -However, `ediff-toggle-multiframe' can be used to toggle between the multiframe -display and the single frame display. -If the multiframe function detects that one of the buffers A/B is seen in some -other frame, it will try to keep that buffer in that frame. +Ediff provides a choice of three functions: + (1) `ediff-setup-windows-multiframe', which sets the control panel + in a separate frame. + (2) `ediff-setup-windows-plain', which does everything in one frame + (3) `ediff-setup-windows-default' (the default), which does (1) + on a graphical display and (2) on a text terminal. + +The command \\[ediff-toggle-multiframe] can be used to toggle +between the multiframe display and the single frame display. If +the multiframe function detects that one of the buffers A/B is +seen in some other frame, it will try to keep that buffer in that +frame. If you don't like any of the two provided functions, write your own one. The basic guidelines: @@ -90,10 +97,12 @@ Buffer C may not be used in jobs that compare only two buffers. If you plan to do something fancy, take a close look at how the two provided functions are written." - :type '(choice (const :tag "Multi Frame" ediff-setup-windows-multiframe) + :type '(choice (const :tag "Choose Automatically" ediff-setup-windows-default) + (const :tag "Multi Frame" ediff-setup-windows-multiframe) (const :tag "Single Frame" ediff-setup-windows-plain) (function :tag "Other function")) - :group 'ediff-window) + :group 'ediff-window + :version "24.2") ;; indicates if we are in a multiframe setup (ediff-defvar-local ediff-multiframe nil "") @@ -333,6 +342,12 @@ buffer-A buffer-B buffer-C control-buffer)) (run-hooks 'ediff-after-setup-windows-hook)) +(defun ediff-setup-windows-default (buffer-A buffer-B buffer-C control-buffer) + (funcall (if (display-graphic-p) + 'ediff-setup-windows-multiframe + 'ediff-setup-windows-plain) + buffer-A buffer-B buffer-C control-buffer)) + ;; Just set up 3 windows. ;; Usually used without windowing systems ;; With windowing, we want to use dedicated frames. ------------------------------------------------------------ revno: 108039 committer: Daiki Ueno branch nick: trunk timestamp: Thu 2012-04-26 11:03:19 +0900 message: Revive plstore editing mode previously reverted due to feature freeze. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2012-04-16 19:09:19 +0000 +++ lisp/gnus/ChangeLog 2012-04-26 02:03:19 +0000 @@ -1,3 +1,13 @@ +2012-04-26 Daiki Ueno + + * plstore.el: Revive the editing feature. + (plstore-mode): New mode to edit plstore file. + (plstore-mode-toggle-display, plstore-mode-original) + (plstore-mode-decoded): New command. + (plstore--encode, plstore--decode, plstore--write-contents-functions) + (plstore--insert-buffer, plstore--make): New function. + (plstore-open, plstore-save): Simplify by using them. + 2012-04-16 Glenn Morris * nndraft.el (nndraft-request-list): Fix declaration. === modified file 'lisp/gnus/plstore.el' --- lisp/gnus/plstore.el 2012-01-05 09:46:05 +0000 +++ lisp/gnus/plstore.el 2012-04-26 02:03:19 +0000 @@ -64,8 +64,18 @@ ;; ;; Editing: ;; -;; Currently not supported but in the future plstore will provide a -;; major mode to edit PLSTORE files. +;; This file also provides `plstore-mode', a major mode for editing +;; the PLSTORE format file. Visit a non-existing file and put the +;; following line: +;; +;; (("foo" :host "foo.example.org" :secret-user "user")) +;; +;; where the prefixing `:secret-' means the property (without +;; `:secret-' prefix) is marked as secret. Thus, when you save the +;; buffer, the `:secret-user' property is encrypted as `:user'. +;; +;; You can toggle the view between encrypted form and the decrypted +;; form with C-c C-c. ;;; Code: @@ -107,6 +117,10 @@ (put 'plstore-encrypt-to 'permanent-local t) +(defvar plstore-encoded nil) + +(put 'plstore-encoded 'permanent-local t) + (defvar plstore-cache-passphrase-for-symmetric-encryption nil) (defvar plstore-passphrase-alist nil) @@ -194,10 +208,6 @@ (generate-new-buffer (format " plstore %s" filename)))) (store (plstore--make buffer))) (with-current-buffer buffer - ;; In the future plstore will provide a major mode called - ;; `plstore-mode' to edit PLSTORE files. - (if (eq major-mode 'plstore-mode) - (error "%s is opened for editing; kill the buffer first" file)) (erase-buffer) (condition-case nil (insert-file-contents-literally file) @@ -435,6 +445,119 @@ (plstore--insert-buffer plstore) (save-buffer))) +(defun plstore--encode (plstore) + (plstore--decrypt plstore) + (let ((merged-alist (plstore--get-merged-alist plstore))) + (concat "(" + (mapconcat + (lambda (entry) + (setq entry (copy-sequence entry)) + (let ((merged-plist (cdr (assoc (car entry) merged-alist))) + (plist (cdr entry))) + (while plist + (if (string-match "\\`:secret-" (symbol-name (car plist))) + (setcar (cdr plist) + (plist-get + merged-plist + (intern (concat ":" + (substring (symbol-name + (car plist)) + (match-end 0))))))) + (setq plist (nthcdr 2 plist))) + (prin1-to-string entry))) + (plstore--get-alist plstore) + "\n") + ")"))) + +(defun plstore--decode (string) + (let* ((alist (car (read-from-string string))) + (pointer alist) + secret-alist + plist + entry) + (while pointer + (unless (stringp (car (car pointer))) + (error "Invalid PLSTORE format %s" string)) + (setq plist (cdr (car pointer))) + (while plist + (when (string-match "\\`:secret-" (symbol-name (car plist))) + (setq entry (assoc (car (car pointer)) secret-alist)) + (unless entry + (setq entry (list (car (car pointer))) + secret-alist (cons entry secret-alist))) + (setcdr entry (plist-put (cdr entry) + (intern (concat ":" + (substring (symbol-name + (car plist)) + (match-end 0)))) + (car (cdr plist)))) + (setcar (cdr plist) t)) + (setq plist (nthcdr 2 plist))) + (setq pointer (cdr pointer))) + (plstore--make nil alist nil secret-alist))) + +(defun plstore--write-contents-functions () + (when plstore-encoded + (let ((store (plstore--decode (buffer-string))) + (file (buffer-file-name))) + (unwind-protect + (progn + (set-visited-file-name nil) + (with-temp-buffer + (plstore--insert-buffer store) + (write-region (buffer-string) nil file))) + (set-visited-file-name file) + (set-buffer-modified-p nil)) + t))) + +(defun plstore-mode-original () + "Show the original form of the this buffer." + (interactive) + (when plstore-encoded + (if (and (buffer-modified-p) + (y-or-n-p "Save buffer before reading the original form? ")) + (save-buffer)) + (erase-buffer) + (insert-file-contents-literally (buffer-file-name)) + (set-buffer-modified-p nil) + (setq plstore-encoded nil))) + +(defun plstore-mode-decoded () + "Show the decoded form of the this buffer." + (interactive) + (unless plstore-encoded + (if (and (buffer-modified-p) + (y-or-n-p "Save buffer before decoding? ")) + (save-buffer)) + (let ((store (plstore--make (current-buffer)))) + (plstore--init-from-buffer store) + (erase-buffer) + (insert + (substitute-command-keys "\ +;;; You are looking at the decoded form of the PLSTORE file.\n\ +;;; To see the original form content, do \\[plstore-mode-toggle-display]\n\n")) + (insert (plstore--encode store)) + (set-buffer-modified-p nil) + (setq plstore-encoded t)))) + +(defun plstore-mode-toggle-display () + "Toggle the display mode of PLSTORE between the original and decoded forms." + (interactive) + (if plstore-encoded + (plstore-mode-original) + (plstore-mode-decoded))) + +;;;###autoload +(define-derived-mode plstore-mode emacs-lisp-mode "PLSTORE" + "Major mode for editing PLSTORE files." + (make-local-variable 'plstore-encoded) + (add-hook 'write-contents-functions #'plstore--write-contents-functions) + (define-key plstore-mode-map "\C-c\C-c" #'plstore-mode-toggle-display) + ;; to create a new file with plstore-mode, mark it as already decoded + (if (called-interactively-p 'any) + (setq plstore-encoded t) + (plstore-mode-decoded))) + (provide 'plstore) ;;; plstore.el ends here ------------------------------------------------------------ revno: 108038 committer: Glenn Morris branch nick: trunk timestamp: Wed 2012-04-25 18:51:41 -0700 message: * doc/lispref/elisp-covers.texi: Remove file. Nothing includes or refers to it, and it has not been updated since Emacs 19. diff: === modified file 'doc/lispref/ChangeLog' --- doc/lispref/ChangeLog 2012-04-26 01:49:03 +0000 +++ doc/lispref/ChangeLog 2012-04-26 01:51:41 +0000 @@ -1,6 +1,6 @@ 2012-04-26 Glenn Morris - * front-cover-1.texi: Remove file. + * elisp-covers.texi, front-cover-1.texi: Remove files. * tindex.pl: Remove file. === removed file 'doc/lispref/elisp-covers.texi' --- doc/lispref/elisp-covers.texi 2012-01-19 07:21:25 +0000 +++ doc/lispref/elisp-covers.texi 1970-01-01 00:00:00 +0000 @@ -1,252 +0,0 @@ -\input texinfo @c -*-texinfo-*- -@c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 2001-2012 Free Software Foundation, Inc. -@c See the file elisp.texi for copying conditions. -@c -@comment %**start of header -@setfilename covers.info -@settitle GNU Emacs Lisp Reference Manual -@comment %**end of header - -@titlepage -@c ================ Volume 1 ================ -@w{ } -@sp 2 -@center @titlefont{The} -@sp 1 -@center @titlefont{GNU} -@sp 1 -@center @titlefont{Emacs Lisp} -@sp 1 -@center @titlefont{Reference} -@sp 1 -@center @titlefont{Manual} -@sp 2 -@center GNU Emacs Version 19 -@center for Unix Users -@center Edition 2.3, June 1994 -@sp 2 -@center @titlefont{Volume 1} -@sp 2 -@center by Bil Lewis, Dan LaLiberte, -@center and the GNU Manual Group - -@page -@c ================ Volume 2 ================ -@w{ } -@sp 5 -@center @titlefont{The} -@sp 1 -@center @titlefont{GNU} -@sp 1 -@center @titlefont{Emacs Lisp} -@sp 1 -@center @titlefont{Reference} -@sp 1 -@center @titlefont{Manual} -@sp 2 -@center GNU Emacs Version 19 -@center for Unix Users -@center Edition 2.3, June 1994 -@sp 2 -@center @titlefont{Volume 2} -@sp 2 -@center by Bil Lewis, -@center Dan LaLiberte, and -@center the GNU Manual Group - -@page -@c ================ Volume 1 with baseline skip 16pt ================ - -@tex -\global\baselineskip = 16pt -@end tex - -16 pts baseline skip: - -@w{ } -@sp 2 -@center @titlefont{The} -@sp 1 -@center @titlefont{GNU} -@sp 1 -@center @titlefont{Emacs Lisp} -@sp 1 -@center @titlefont{Reference} -@sp 1 -@center @titlefont{Manual} -@sp 2 -@center GNU Emacs Version 19 -@center for Unix Users -@center Edition 2.3, June 1994 -@sp 2 -@center @titlefont{Volume 1} -@sp 2 -@center by Bil Lewis, Dan LaLiberte, -@center and the GNU Manual Group - -@page -@c ================ Volume 1 with baseline skip 18pt ================ - -@tex -\global\baselineskip = 18pt -@end tex - -18 pts baseline skip, with 15pts between sections - -@w{ } -@sp 2 -@center @titlefont{The} -@sp 1 -@center @titlefont{GNU} -@sp 1 -@center @titlefont{Emacs Lisp} -@sp 1 -@center @titlefont{Reference} -@sp 1 -@center @titlefont{Manual} -@tex -\global\baselineskip = 15pt -@end tex - -@sp 2 -@center GNU Emacs Version 19 -@center for Unix Users -@center Edition 2.3, June 1994 -@sp 2 -@center @titlefont{Volume 1} -@sp 2 -@center by Bil Lewis, -@center Dan LaLiberte, and -@center the GNU Manual Group - -@page -@c ================ Volume 1 with more baseline skip 24 pts ================ - -@tex -\global\baselineskip = 24pt -@end tex - -24 pts baseline skip: - -@w{ } -@sp 2 -@center @titlefont{The} -@sp 1 -@center @titlefont{GNU} -@sp 1 -@center @titlefont{Emacs Lisp} -@sp 1 -@center @titlefont{Reference} -@sp 1 -@center @titlefont{Manual} -@sp 2 -@center GNU Emacs Version 19 -@center for Unix Users -@center Edition 2.3, June 1994 -@sp 2 -@center @titlefont{Volume 1} -@sp 2 -@center by Bil Lewis, Dan LaLiberte, -@center and the GNU Manual Group - -@page -@c ================ Volume 2 with more baseline skip 18 pts ================ - -@tex -\global\baselineskip = 18pt -@end tex - -18 pts baseline skip: - -@w{ } -@sp 5 -@center @titlefont{The} -@sp 1 -@center @titlefont{GNU} -@sp 1 -@center @titlefont{Emacs Lisp} -@sp 1 -@center @titlefont{Reference} -@sp 1 -@center @titlefont{Manual} -@sp 2 -@center GNU Emacs Version 19 -@center for Unix Users -@center Edition 2.3, June 1994 -@sp 2 -@center @titlefont{Volume 2} -@sp 2 -@center by Bil Lewis, Dan LaLiberte, -@center and the GNU Manual Group - -@page -@c ================ Volume 2 with more baseline skip 24 pts ================ - -@tex -\global\baselineskip = 24pt -@end tex - -24 pts baseline skip: - -@w{ } -@sp 5 -@center @titlefont{The} -@sp 1 -@center @titlefont{GNU} -@sp 1 -@center @titlefont{Emacs Lisp} -@sp 1 -@center @titlefont{Reference} -@sp 1 -@center @titlefont{Manual} -@sp 2 -@center GNU Emacs Version 19 -@center for Unix Users -@center Edition 2.3, June 1994 -@sp 2 -@center @titlefont{Volume 2} -@sp 2 -@center by Bil Lewis, Dan LaLiberte, -@center and the GNU Manual Group - - -@page -@c ================ Spine 1 ================ - -@w{@titlefont{The GNU Emacs Lisp Reference Manual --- Vol. 1}} -@sp 4 -@center GNU Emacs Version 19 -@center for Unix Users -@center Edition 2.3, June 1994 -@sp 4 -@center by Bil Lewis, Dan LaLiberte, -@center and the GNU Manual Group - -@sp 4 -@author The GNU Emacs Lisp Reference Manual --- Vol. 1 -@sp 3 -@author FSF - -@author - -@page -@c ================ Spine 2 ================ - -@w{@titlefont{The GNU Emacs Lisp Reference Manual --- Vol. 2}} -@sp 4 -@center GNU Emacs Version 19 -@center for Unix Users -@center Edition 2.3, June 1994 -@sp 4 -@center by Bil Lewis, Dan LaLiberte, -@center and the GNU Manual Group - - -@sp 4 -@author The GNU Emacs Lisp Reference Manual --- Vol. 2 -@sp 3 -@author FSF - -@end titlepage -@bye ------------------------------------------------------------ revno: 108037 committer: Glenn Morris branch nick: trunk timestamp: Wed 2012-04-25 18:49:03 -0700 message: * doc/lispref/front-cover-1.texi: Remove file. Nothing includes or refers to it, and it has not been updated since Emacs 19. diff: === modified file 'doc/lispref/ChangeLog' --- doc/lispref/ChangeLog 2012-04-26 01:47:05 +0000 +++ doc/lispref/ChangeLog 2012-04-26 01:49:03 +0000 @@ -1,5 +1,7 @@ 2012-04-26 Glenn Morris + * front-cover-1.texi: Remove file. + * tindex.pl: Remove file. * makefile.w32-in (srcs): === removed file 'doc/lispref/front-cover-1.texi' --- doc/lispref/front-cover-1.texi 2011-01-15 23:16:57 +0000 +++ doc/lispref/front-cover-1.texi 1970-01-01 00:00:00 +0000 @@ -1,52 +0,0 @@ -\input texinfo @c -*-texinfo-*- -@comment %**start of header -@setfilename front1.info -@settitle GNU Emacs Lisp Reference Manual -@smallbook -@comment %**end of header - -@titlepage -. -@sp 2 -@center @titlefont{The} -@sp 1 -@center @titlefont{GNU} -@sp 1 -@center @titlefont{Emacs Lisp} -@sp 1 -@center @titlefont{Reference} -@sp 1 -@center @titlefont{Manual} -@sp 2 -@center GNU Emacs Version 19.29 -@center for Unix Users -@center Edition 2.4, June 1995 -@sp 2 -@center @titlefont{Volume 1} -@sp 2 -@center by Bil Lewis, Dan LaLiberte, -@center and the GNU Manual Group -@page -. -@sp 5 -@center @titlefont{The} -@sp 1 -@center @titlefont{GNU} -@sp 1 -@center @titlefont{Emacs Lisp} -@sp 1 -@center @titlefont{Reference} -@sp 1 -@center @titlefont{Manual} -@sp 2 -@center GNU Emacs Version 19.29 -@center for Unix Users -@center Edition 2.4, June 1995 -@sp 2 -@center @titlefont{Volume 2} -@sp 2 -@center by Bil Lewis, Dan LaLiberte, -@center and the GNU Manual Group - -@end titlepage -@bye ------------------------------------------------------------ revno: 108036 committer: Glenn Morris branch nick: trunk timestamp: Wed 2012-04-25 18:47:05 -0700 message: Remove doc/lispref/tindex.pl I think it is not needed any more. * doc/lispref/tindex.pl: Remove file. * make-dist: No more doc/lispref/tindex.pl. diff: === modified file 'ChangeLog' --- ChangeLog 2012-04-22 14:11:43 +0000 +++ ChangeLog 2012-04-26 01:47:05 +0000 @@ -1,3 +1,7 @@ +2012-04-26 Glenn Morris + + * make-dist: No more doc/lispref/tindex.pl. + 2012-04-22 Michael Albinus * configure.in (dbus_validate_bus_name, dbus_validate_path) === modified file 'doc/lispref/ChangeLog' --- doc/lispref/ChangeLog 2012-04-26 01:08:03 +0000 +++ doc/lispref/ChangeLog 2012-04-26 01:47:05 +0000 @@ -1,5 +1,7 @@ 2012-04-26 Glenn Morris + * tindex.pl: Remove file. + * makefile.w32-in (srcs): * Makefile.in (srcs): Remove back.texi (which is unused). === removed file 'doc/lispref/tindex.pl' --- doc/lispref/tindex.pl 2012-01-19 07:21:25 +0000 +++ doc/lispref/tindex.pl 1970-01-01 00:00:00 +0000 @@ -1,124 +0,0 @@ -#! /usr/bin/perl - -# Copyright (C) 2000-2012 Free Software Foundation, Inc. - -# This file is part of GNU Emacs. - -# GNU Emacs is free software: you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation, either version 3 of the License, or -# (at your option) any later version. - -# GNU Emacs is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. - -# You should have received a copy of the GNU General Public License -# along with GNU Emacs. If not, see . - - -require 5; -use Getopt::Long; - -my $USAGE = < \$help, 'version' => \$version, - 'old=s' => \$old); -if ($version) { - print "0.1\n"; - exit 0; -} elsif (!$rc || !$old || @ARGV) { - print $USAGE; - exit 1; -} elsif ($help) { - print $USAGE; - exit 0; -} - -# Fill the hash %tindex with associations VAR -> COUNT where -# the keys VAR are identifiers mentioned in @tindex lines in the older -# files to process and COUNT is the number of times they are seen in -# the files. - -my %tindex; -my %removed; -my @old_files = glob "$old/*.texi"; -my @new_files = glob "*.texi"; -fatal ("No Texinfo files found in `$old'") unless @old_files; -fatal ("No Texinfo files found in current directory") unless @new_files; - -print "Scanning old files for \@tindex lines\n"; -foreach $file (@old_files) { - open (IN, "<$file") or fatal "Cannot open $file: $!"; - while () { - ++$tindex{$1} if /^\s*\@tindex\s+(\S+)/; - } - close IN; -} - -# Process current files and remove those @tindex lines which we -# know were already present in the files scanned above. - -print "Removing old \@tindex lines\n"; -foreach $file (@new_files) { - my $modified = 0; - my $contents = ""; - - open (IN, "< $file") or fatal "Cannot open $file.orig for reading: $!"; - while () { - if (/^\s*\@tindex\s+(\S+)/ && $tindex{$1}) { - ++$removed{$1}; - $modified = 1; - } else { - $contents = $contents . $_; - } - } - - close IN; - - if ($modified) { - print " $file\n"; - system ("cp $file $file.orig") == 0 or fatal "Cannot backup $file: $!"; - open (OUT, ">$file") or fatal "Cannot open $file for writing: $!"; - print OUT $contents; - close OUT; - } -} - -# Print a list of identifiers removed. - -print "Removed \@tindex commands for:\n"; -my $key; -foreach $key (keys %removed) { - print " $key\n"; -} - === modified file 'make-dist' --- make-dist 2012-02-05 20:56:41 +0000 +++ make-dist 2012-04-26 01:47:05 +0000 @@ -478,7 +478,7 @@ echo "Making links to \`doc/lispref'" (cd doc/lispref ln *.texi *.in makefile.w32-in README ChangeLog* ../../${tempdir}/doc/lispref - ln *.txt *.el spellfile tindex.pl ../../${tempdir}/doc/lispref + ln *.txt *.el spellfile ../../${tempdir}/doc/lispref ln two-volume.make ../../${tempdir}/doc/lispref) echo "Making links to \`doc/lispintro'" ------------------------------------------------------------ revno: 108035 committer: Glenn Morris branch nick: trunk timestamp: Wed 2012-04-25 21:08:03 -0400 message: * doc/lispref/Makefile.in (srcs): Remove back.texi (which is unused). * doc/lispref/makefile.w32-in (srcs): Same. diff: === modified file 'doc/lispref/ChangeLog' --- doc/lispref/ChangeLog 2012-04-24 17:56:30 +0000 +++ doc/lispref/ChangeLog 2012-04-26 01:08:03 +0000 @@ -1,3 +1,8 @@ +2012-04-26 Glenn Morris + + * makefile.w32-in (srcs): + * Makefile.in (srcs): Remove back.texi (which is unused). + 2012-04-24 Michael Albinus * os.texi (Notifications): Extend possible notification hints. === modified file 'doc/lispref/Makefile.in' --- doc/lispref/Makefile.in 2012-04-07 19:23:53 +0000 +++ doc/lispref/Makefile.in 2012-04-26 01:08:03 +0000 @@ -47,7 +47,6 @@ $(srcdir)/abbrevs.texi \ $(srcdir)/advice.texi \ $(srcdir)/anti.texi \ - $(srcdir)/back.texi \ $(srcdir)/backups.texi \ $(srcdir)/buffers.texi \ $(srcdir)/commands.texi \ === modified file 'doc/lispref/makefile.w32-in' --- doc/lispref/makefile.w32-in 2012-02-28 07:30:20 +0000 +++ doc/lispref/makefile.w32-in 2012-04-26 01:08:03 +0000 @@ -48,7 +48,6 @@ $(srcdir)/abbrevs.texi \ $(srcdir)/advice.texi \ $(srcdir)/anti.texi \ - $(srcdir)/back.texi \ $(srcdir)/backups.texi \ $(srcdir)/buffers.texi \ $(srcdir)/commands.texi \ ------------------------------------------------------------ revno: 108034 [merge] committer: Stefan Monnier branch nick: trunk timestamp: Wed 2012-04-25 15:00:18 -0400 message: Add support for completion of quoted/escaped data. diff: === modified file 'etc/NEWS' --- etc/NEWS 2012-04-24 21:52:37 +0000 +++ etc/NEWS 2012-04-25 18:40:42 +0000 @@ -169,6 +169,14 @@ * Lisp changes in Emacs 24.2 + +** Completion + +*** New function `completion-table-with-quoting' to handle completion +in the presence of quoting, such as file completion in shell buffers. + +*** New function `completion-table-subvert' to use an existing completion +table, but with a different prefix. * Changes in Emacs 24.2 on non-free operating systems === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-04-25 16:46:01 +0000 +++ lisp/ChangeLog 2012-04-25 19:00:18 +0000 @@ -1,7 +1,44 @@ +2012-04-25 Stefan Monnier + + * ffap.el: Remove old code for obsolete package. + (ffap-complete-as-file-p): Remove. + + Use completion-table-with-quoting for comint and pcomplete. + * comint.el (comint--unquote&requote-argument) + (comint--unquote-argument, comint--requote-argument): New functions. + (comint--unquote&expand-filename, comint-unquote-filename): Obsolete. + (comint-quote-filename): Use regexp-opt-charset. + (comint--common-suffix, comint--common-quoted-suffix) + (comint--table-subvert): Remove. + (comint-unquote-function, comint-requote-function): New vars. + (comint--complete-file-name-data): Use them with + completion-table-with-quoting. + * pcmpl-unix.el (pcomplete/scp): Use completion-table-subvert. + * pcomplete.el (pcomplete-arg-quote-list) + (pcomplete-quote-arg-hook, pcomplete-quote-argument): Obsolete. + (pcomplete-unquote-argument-function): Default to non-nil. + (pcomplete-unquote-argument): Simplify. + (pcomplete--common-quoted-suffix): Remove. + (pcomplete-requote-argument-function): New var. + (pcomplete--common-suffix): New function. + (pcomplete-completions-at-point): Use completion-table-with-quoting + and completion-table-subvert. + + * minibuffer.el: Use completion-table-with-quoting for read-file-name. + (minibuffer--double-dollars): Preserve properties. + (completion--sifn-requote): New function. + (completion--file-name-table): Rewrite using it and c-t-with-quoting. + + * minibuffer.el: Add support for completion of quoted/escaped data. + (completion-table-with-quoting, completion-table-subvert): New funs. + (completion--twq-try, completion--twq-all): New functions. + (completion--nth-completion): New function. + (completion-try-completion, completion-all-completions): Use it. + 2012-04-25 Leo Liu - * progmodes/python.el (python-pdbtrack-get-source-buffer): Use - compilation-message if available to find real filename. + * progmodes/python.el (python-pdbtrack-get-source-buffer): + Use compilation-message if available to find real filename. 2012-04-25 Chong Yidong @@ -21,32 +58,31 @@ 2012-04-25 Alex Harsanyi - Sync with soap-client repository. Support SOAP simpleType. (Bug#10331) + Sync with soap-client repository. Support SOAP simpleType (Bug#10331). * soap-client.el (soap-resolve-references-for-sequence-type) - (soap-resolve-references-for-array-type): hack to prevent self + (soap-resolve-references-for-array-type): Hack to prevent self references, see Bug#9. - (soap-parse-envelope): report the contents of the 'detail' node + (soap-parse-envelope): Report the contents of the 'detail' node when receiving a fault reply. - (soap-parse-envelope): report the contents of the entire 'detail' - node. + (soap-parse-envelope): Report the contents of the entire 'detail' node. * soap-inspect.el (soap-sample-value-for-simple-type) - (soap-inspect-simple-type): new function + (soap-inspect-simple-type): New function. - * soap-client.el (soap-simple-type): new struct + * soap-client.el (soap-simple-type): New struct. (soap-default-xsd-types, soap-default-soapenc-types) - (soap-decode-basic-type, soap-encode-basic-type): support - unsignedInt and double basic types + (soap-decode-basic-type, soap-encode-basic-type): + support unsignedInt and double basic types. (soap-resolve-references-for-simple-type) - (soap-parse-simple-type, soap-encode-simple-type): new function - (soap-parse-schema): parse xsd:simpleType declarations + (soap-parse-simple-type, soap-encode-simple-type): New function. + (soap-parse-schema): Parse xsd:simpleType declarations. * soap-client.el (soap-default-xsd-types) - (soap-default-soapenc-types): add integer, byte and anyURI types - (soap-parse-complex-type-complex-content): use `soap-wk2l' to find - the local name of "soapenc:Array" - (soap-decode-basic-type, soap-encode-basic-type): support encoding + (soap-default-soapenc-types): Add integer, byte and anyURI types. + (soap-parse-complex-type-complex-content): Use `soap-wk2l' to find + the local name of "soapenc:Array". + (soap-decode-basic-type, soap-encode-basic-type): Support encoding decoding integer, byte and anyURI xsd types. 2012-04-25 Chong Yidong @@ -166,8 +202,8 @@ * ispell.el (ispell-insert-word) Remove unneeded function using obsolete `translation-table-for-input'. - (ispell-word, ispell-process-line, ispell-complete-word): Use - plain `insert' instead of removed `ispell-insert-word'. + (ispell-word, ispell-process-line, ispell-complete-word): + Use plain `insert' instead of removed `ispell-insert-word'. 2012-04-22 Chong Yidong @@ -185,8 +221,8 @@ Move functions from C to Lisp. Make non-blocking method calls the default. Implement further D-Bus standard interfaces. - * net/dbus.el (dbus-message-internal): Declare function. Remove - unneeded function declarations. + * net/dbus.el (dbus-message-internal): Declare function. + Remove unneeded function declarations. (defvar dbus-message-type-invalid, dbus-message-type-method-call) (dbus-message-type-method-return, dbus-message-type-error) (dbus-message-type-signal): Declare variables. Remove local @@ -202,8 +238,8 @@ (dbus-register-signal, dbus-register-method): New defuns, moved from dbusbind.c (dbus-call-method-handler, dbus-setenv) - (dbus-get-all-managed-objects, dbus-managed-objects-handler): New - defuns. + (dbus-get-all-managed-objects, dbus-managed-objects-handler): + New defuns. (dbus-call-method-non-blocking): Make it an obsolete function. (dbus-unregister-object, dbus-unregister-service) (dbus-handle-event, dbus-register-property) @@ -328,8 +364,8 @@ 2012-04-20 Chong Yidong - * progmodes/gdb-mi.el (gdb-inferior-io--maybe-delete-pty): New - function to call delete-process on the gdb-inferior buffer's pty. + * progmodes/gdb-mi.el (gdb-inferior-io--maybe-delete-pty): + New function to call delete-process on the gdb-inferior buffer's pty. (gdb-reset): Use it, instead of relying on kill-buffer to kill the pty process (Bug#11273). (gdb-update): New arg to suppress talking to the gdb process. @@ -360,8 +396,8 @@ (c-comment-indent, c-scan-conditionals, c-indent-defun) (c-context-line-break): Bind case-fold-search to nil. - * progmodes/cc-mode.el (c-font-lock-fontify-region): Bind - case-fold-search to nil. + * progmodes/cc-mode.el (c-font-lock-fontify-region): + Bind case-fold-search to nil. 2012-04-20 Chong Yidong @@ -1112,8 +1148,8 @@ 2012-03-30 Agustín Martín Domingo - * ispell.el (ispell-get-extended-character-mode): Disable - extended-char-mode for hunspell. hunspell does not support it + * ispell.el (ispell-get-extended-character-mode): + Disable extended-char-mode for hunspell. hunspell does not support it and treats ~word as ordinary words in pipe mode. 2012-03-30 Glenn Morris === modified file 'lisp/comint.el' --- lisp/comint.el 2012-04-19 08:09:30 +0000 +++ lisp/comint.el 2012-04-25 18:53:57 +0000 @@ -104,6 +104,7 @@ (eval-when-compile (require 'cl)) (require 'ring) (require 'ansi-color) +(require 'regexp-opt) ;For regexp-opt-charset. ;; Buffer Local Variables: ;;============================================================================ @@ -3000,26 +3001,62 @@ See `comint-word'." (comint-word comint-file-name-chars)) -(defun comint--unquote&expand-filename (filename) - ;; FIXME: The code below does unquote-then-expand which means that "\\$HOME" - ;; gets expanded to the same as "$HOME" - (comint-substitute-in-file-name - (comint-unquote-filename filename))) +(defun comint--unquote&requote-argument (qstr &optional upos) + (unless upos (setq upos 0)) + (let* ((qpos 0) + (dquotes nil) + (ustrs '()) + (re (concat + "[\"']\\|\\\\\\(.\\)" + "\\|\\$\\(?:\\([[:alpha:]][[:alnum:]]*\\)" + "\\|{\\(?2:[^{}]+\\)}\\)" + (when (memq system-type '(ms-dos windows-nt)) + "\\|%\\(?2:[^\\\\/]*\\)%"))) + (qupos nil) + (push (lambda (str end) + (push str ustrs) + (setq upos (- upos (length str))) + (unless (or qupos (> upos 0)) + (setq qupos (if (< end 0) (- end) (+ upos end)))))) + match) + (while (setq match (string-match re qstr qpos)) + (funcall push (substring qstr qpos match) match) + (cond + ((match-beginning 1) (funcall push (match-string 1 qstr) (match-end 0))) + ((match-beginning 2) (funcall push (getenv (match-string 2 qstr)) + (- (match-end 0)))) + ((eq (aref qstr match) ?\") (setq dquotes (not dquotes))) + ((eq (aref qstr match) ?\') + (cond + (dquotes (funcall push "'" (match-end 0))) + ((< match (1+ (length qstr))) + (let ((end (string-match "'" qstr (1+ match)))) + (funcall push (substring qstr (1+ match) end) + (or end (length qstr))))) + (t nil))) + (t (error "Unexpected case in comint--unquote&requote-argument!"))) + (setq qpos (match-end 0))) + (funcall push (substring qstr qpos) (length qstr)) + (list (mapconcat #'identity (nreverse ustrs) "") + qupos #'comint-quote-filename))) + +(defun comint--unquote-argument (str) + (car (comint--unquote&requote-argument str))) +(define-obsolete-function-alias 'comint--unquote&expand-filename + #'comint--unquote-argument "24.2") (defun comint-match-partial-filename () "Return the unquoted&expanded filename at point, or nil if none is found. Environment variables are substituted. See `comint-word'." (let ((filename (comint--match-partial-filename))) - (and filename (comint--unquote&expand-filename filename)))) + (and filename (comint--unquote-argument filename)))) (defun comint-quote-filename (filename) "Return FILENAME with magic characters quoted. Magic characters are those in `comint-file-name-quote-list'." (if (null comint-file-name-quote-list) filename - (let ((regexp - (format "[%s]" - (mapconcat 'char-to-string comint-file-name-quote-list "")))) + (let ((regexp (regexp-opt-charset comint-file-name-quote-list))) (save-match-data (let ((i 0)) (while (string-match regexp filename i) @@ -3033,6 +3070,12 @@ filename (save-match-data (replace-regexp-in-string "\\\\\\(.\\)" "\\1" filename t)))) +(make-obsolete 'comint-unquote-filename nil "24.2") + +(defun comint--requote-argument (upos qstr) + ;; See `completion-table-with-quoting'. + (let ((res (comint--unquote&requote-argument qstr upos))) + (cons (nth 1 res) (nth 2 res)))) (defun comint-completion-at-point () (run-hook-with-args-until-success 'comint-dynamic-complete-functions)) @@ -3066,87 +3109,6 @@ (when (comint--match-partial-filename) (comint--complete-file-name-data))) -;; FIXME: comint--common-suffix, comint--common-quoted-suffix, and -;; comint--table-subvert don't fully solve the problem, since -;; selecting a file from *Completions* won't quote it, among several -;; other problems. - -(defun comint--common-suffix (s1 s2) - (assert (not (or (string-match "\n" s1) (string-match "\n" s2)))) - ;; Since S2 is expected to be the "unquoted/expanded" version of S1, - ;; there shouldn't be any case difference, even if the completion is - ;; case-insensitive. - (let ((case-fold-search nil)) - (string-match ".*?\\(.*\\)\n.*\\1\\'" (concat s1 "\n" s2)) - (- (match-end 1) (match-beginning 1)))) - -(defun comint--common-quoted-suffix (s1 s2) - ;; FIXME: Copied in pcomplete.el. - "Find the common suffix between S1 and S2 where S1 is the expanded S2. -S1 is expected to be the unquoted and expanded version of S2. -Returns (PS1 . PS2), i.e. the shortest prefixes of S1 and S2, such that -S1 = (concat PS1 SS1) and S2 = (concat PS2 SS2) and -SS1 = (unquote SS2)." - (let* ((cs (comint--common-suffix s1 s2)) - (ss1 (substring s1 (- (length s1) cs))) - (qss1 (comint-quote-filename ss1)) - qc s2b) - (if (and (not (equal ss1 qss1)) - (setq qc (comint-quote-filename (substring ss1 0 1))) - (setq s2b (- (length s2) cs (length qc) -1)) - (>= s2b 0) ;bug#11158. - (eq t (compare-strings s2 s2b (- (length s2) cs -1) - qc nil nil))) - ;; The difference found is just that one char is quoted in S2 - ;; but not in S1, keep looking before this difference. - (comint--common-quoted-suffix - (substring s1 0 (- (length s1) cs)) - (substring s2 0 s2b)) - (cons (substring s1 0 (- (length s1) cs)) - (substring s2 0 (- (length s2) cs)))))) - -(defun comint--table-subvert (table s1 s2 &optional quote-fun unquote-fun) - "Completion table that replaces the prefix S1 with S2 in STRING. -The result is a completion table which completes strings of the -form (concat S1 S) in the same way as TABLE completes strings of -the form (concat S2 S)." - (lambda (string pred action) - (let* ((str (if (eq t (compare-strings string 0 (length s1) s1 nil nil - completion-ignore-case)) - (let ((rest (substring string (length s1)))) - (concat s2 (if unquote-fun - (funcall unquote-fun rest) rest))))) - (res (if str (complete-with-action action table str pred)))) - (when res - (cond - ((and (eq (car-safe action) 'boundaries)) - (let ((beg (or (and (eq (car-safe res) 'boundaries) (cadr res)) 0))) - (list* 'boundaries - (max (length s1) - ;; FIXME: Adjust because of quoting/unquoting. - (+ beg (- (length s1) (length s2)))) - (and (eq (car-safe res) 'boundaries) (cddr res))))) - ((stringp res) - (if (eq t (compare-strings res 0 (length s2) s2 nil nil - completion-ignore-case)) - (let ((rest (substring res (length s2)))) - (concat s1 (if quote-fun (funcall quote-fun rest) rest))))) - ((eq action t) - (let ((bounds (completion-boundaries str table pred ""))) - (if (>= (car bounds) (length s2)) - (if quote-fun (mapcar quote-fun res) res) - (let ((re (concat "\\`" - (regexp-quote (substring s2 (car bounds)))))) - (delq nil - (mapcar (lambda (c) - (if (string-match re c) - (let ((str (substring c (match-end 0)))) - (if quote-fun - (funcall quote-fun str) str)))) - res)))))) - ;; E.g. action=nil and it's the only completion. - (res)))))) - (defun comint-completion-file-name-table (string pred action) (if (not (file-name-absolute-p string)) (completion-file-name-table string pred action) @@ -3165,6 +3127,13 @@ res))) (t (completion-file-name-table string pred action))))) +(defvar comint-unquote-function #'comint--unquote-argument + "Function to use for completion of quoted data. +See `completion-table-with-quoting' and `comint-requote-function'.") +(defvar comint-requote-function #'comint--requote-argument + "Function to use for completion of quoted data. +See `completion-table-with-quoting' and `comint-requote-function'.") + (defun comint--complete-file-name-data () "Return the completion data for file name at point." (let* ((filesuffix (cond ((not comint-completion-addsuffix) "") @@ -3175,14 +3144,11 @@ (filename (comint--match-partial-filename)) (filename-beg (if filename (match-beginning 0) (point))) (filename-end (if filename (match-end 0) (point))) - (unquoted (if filename (comint--unquote&expand-filename filename) "")) (table - (let ((prefixes (comint--common-quoted-suffix - unquoted filename))) - (comint--table-subvert - #'comint-completion-file-name-table - (cdr prefixes) (car prefixes) - #'comint-quote-filename #'comint-unquote-filename)))) + (completion-table-with-quoting + #'comint-completion-file-name-table + comint-unquote-function + comint-requote-function))) (nconc (list filename-beg filename-end === modified file 'lisp/ffap.el' --- lisp/ffap.el 2012-04-09 13:05:48 +0000 +++ lisp/ffap.el 2012-04-25 18:57:09 +0000 @@ -1340,20 +1340,6 @@ ;; We must inform complete about whether our completion function ;; will do filename style completion. -(defun ffap-complete-as-file-p () - ;; Will `minibuffer-completion-table' complete the minibuffer - ;; contents as a filename? Assumes the minibuffer is current. - ;; Note: t and non-nil mean somewhat different reasons. - (if (eq minibuffer-completion-table 'ffap-read-file-or-url-internal) - (not (ffap-url-p (buffer-string))) ; t - (and minibuffer-completing-file-name '(t)))) ;list - -(and - (featurep 'complete) - (if (boundp 'PC-completion-as-file-name-predicate) - ;; modern version of complete.el, just set the variable: - (setq PC-completion-as-file-name-predicate 'ffap-complete-as-file-p))) - ;;; Highlighting (`ffap-highlight'): ;; === modified file 'lisp/mh-e/ChangeLog' --- lisp/mh-e/ChangeLog 2012-04-21 16:57:49 +0000 +++ lisp/mh-e/ChangeLog 2012-04-25 18:57:09 +0000 @@ -1,3 +1,7 @@ +2012-04-25 Stefan Monnier + + * mh-utils.el (minibuffer-completing-file-name): Don't declare, unused. + 2012-04-21 Juanma Barranquero * mh-folder.el (top): Check whether which-func-modes is t before @@ -179,8 +183,8 @@ * mh-mime.el (mh-decode-message-subject): New function to decode RFC2047 encoded Subject lines. Used for reply drafts. - * mh-comp.el (mh-compose-and-send-mail): Call - `mh-decode-message-subject' on (reply or forward) message drafts. + * mh-comp.el (mh-compose-and-send-mail): + Call `mh-decode-message-subject' on (reply or forward) message drafts. 2010-05-07 Chong Yidong @@ -353,8 +357,8 @@ * mh-show.el (mh-show-preferred-alternative) * mh-e.el (mh-annotate-msg-hook): Sync docstring with manual. - * mh-comp.el (mh-send-letter, mh-redistribute): Mention - mh-annotate-msg-hook in docstring. + * mh-comp.el (mh-send-letter, mh-redistribute): + Mention mh-annotate-msg-hook in docstring. 2008-06-29 Jeffrey C Honig @@ -404,8 +408,8 @@ 2008-05-23 Bill Wohler - * mh-e.el (mh-invisible-header-fields-internal): Remove - DKIM-Signature as it is covered by DKIM-. Fully qualify X-EID. + * mh-e.el (mh-invisible-header-fields-internal): + Remove DKIM-Signature as it is covered by DKIM-. Fully qualify X-EID. 2008-05-19 Sergey Poznyakoff @@ -488,8 +492,8 @@ 2007-08-21 Jeffrey C Honig - * mh-folder.el (mh-folder-message-menu, mh-folder-mode-map): Add - folder mode support for mh-show-preferred-alternative (closes SF + * mh-folder.el (mh-folder-message-menu, mh-folder-mode-map): + Add folder mode support for mh-show-preferred-alternative (closes SF #1777321). * mh-show.el (mh-show-preferred-alternative) @@ -500,8 +504,8 @@ HTML when text content is lacking (closes SF #1777321). * mh-e.el: - (mh-invisible-header-fields-internal): Exclude Fax and Phone. Put - known exclusions as comments before the list and move parens to + (mh-invisible-header-fields-internal): Exclude Fax and Phone. + Put known exclusions as comments before the list and move parens to separate lines to aid in sorting (closes SF #1701231). * mh-mime.el (mm-decode-body): Remove explicit autoload of @@ -750,16 +754,16 @@ (mh-tool-bar-folder-buttons-set, mh-tool-bar-letter-buttons-set): Call it (closes SF #1452718). - * mh-folder.el (mh-folder-buttons-init-flag): Delete. Use - mh-folder-tool-bar-map instead. + * mh-folder.el (mh-folder-buttons-init-flag): Delete. + Use mh-folder-tool-bar-map instead. (image-load-path): Delete. No longer used. - (mh-folder-mode): Moved setting of image-load-path into + (mh-folder-mode): Move setting of image-load-path into mh-tool-bar-folder-buttons-init. - * mh-letter.el (mh-letter-buttons-init-flag): Delete. Use - mh-letter-tool-bar-map instead. + * mh-letter.el (mh-letter-buttons-init-flag): Delete. + Use mh-letter-tool-bar-map instead. (image-load-path): Delete. No longer used. - (mh-letter-mode): Moved setting of image-load-path into + (mh-letter-mode): Move setting of image-load-path into mh-tool-bar-letter-buttons-init. * mh-seq.el (mh-narrow-to-seq, mh-widen): Use with-current-buffer @@ -1007,8 +1011,8 @@ (mh-print-background-flag, mh-show-maximum-size) (mh-show-use-xface-flag, mh-store-default-directory) (mh-summary-height, mh-speed-update-interval) - (mh-show-threads-flag, mh-tool-bar-search-function): Add - :package-version keyword to these options (closes SF #1452724). + (mh-show-threads-flag, mh-tool-bar-search-function): + Add :package-version keyword to these options (closes SF #1452724). (mh-after-commands-processed-hook) (mh-alias-reloaded-hook, mh-before-commands-processed-hook) (mh-before-quit-hook, mh-before-send-letter-hook) @@ -1035,15 +1039,15 @@ (mh-speedbar-selected-folder-with-unseen-messages): : Add :package-version keyword to these faces (closes SF #1452724). - * mh-tool-bar.el (mh-tool-bar-define): Added commented-out + * mh-tool-bar.el (mh-tool-bar-define): Add commented-out :package-version keywords (closes SF #1452724). 2006-03-28 Bill Wohler * mh-tool-bar.el: Use clipboard-kill-region, clipboard-kill-ring-save, and clipboard-yank instead of undo, - kill-region, and menu-bar-kill-ring-save respectively. In - MH-Letter mode, move save-buffer and mh-fully-kill-draft icons in + kill-region, and menu-bar-kill-ring-save respectively. + In MH-Letter mode, move save-buffer and mh-fully-kill-draft icons in front of mh-compose-insertion to be consistent with other mailers, such as Evolution. In MH-Folder mode, move vanilla reply icon to the left of the other reply icons. Use mail/inbox icon instead of @@ -1099,8 +1103,8 @@ 2006-03-14 Bill Wohler - * mh-compat.el (mh-image-load-path-for-library): Incorporate - changes from image-load-path-for-library, which are: + * mh-compat.el (mh-image-load-path-for-library): + Incorporate changes from image-load-path-for-library, which are: (image-load-path-for-library): Pass value of path rather than symbol. Always return list of directories. Guarantee that image directory comes first. @@ -1126,8 +1130,8 @@ flag to replace-in-string. This was badly needed by mh-quote-pick-expr in order to properly quote subjects when using / s on XEmacs (closes SF #1447598). - (mh-image-load-path-for-library): Merged changes from Reiner. Add - no-error argument. If path t, just return directory. + (mh-image-load-path-for-library): Merged changes from Reiner. + Add no-error argument. If path t, just return directory. * mh-e.el (mh-profile-component): Drop `s' from mhparam -components for Mailutils compatibility (closes SF #1446985). @@ -1185,8 +1189,8 @@ local variable mh-image-directory to image-directory. Move error checks to default case in cond and simplify. - * mh-comp.el (mh-send-letter, mh-insert-auto-fields): Sync - docstrings with manual. + * mh-comp.el (mh-send-letter, mh-insert-auto-fields): + Sync docstrings with manual. 2006-03-02 Bill Wohler @@ -1212,8 +1216,8 @@ * mh-utils.el (mh-image-directory) (mh-image-load-path-called-flag): Delete. - (mh-image-load-path): Incorporate changes from Gnus team. Biggest - changes are that it no longer uses/sets mh-image-directory or + (mh-image-load-path): Incorporate changes from Gnus team. + Biggest changes are that it no longer uses/sets mh-image-directory or mh-image-load-path-called-flag, and returns the updated path rather than change it. (mh-logo-display): Change usage of mh-image-load-path. @@ -1278,8 +1282,8 @@ goto-addr.el. (mh-alias-suggest-alias): Use goto-address-mail-regexp instead of mh-address-mail-regexp. - (mh-alias-add-address-under-point): Use - goto-address-find-address-at-point instead of + (mh-alias-add-address-under-point): + Use goto-address-find-address-at-point instead of mh-goto-address-find-address-at-point. * mh-e.el (mh-show-use-goto-addr-flag): Delete. @@ -1360,7 +1364,7 @@ 2006-02-08 Peter S Galbraith - * mh-e.el (mh-invisible-header-fields-internal): Added entries + * mh-e.el (mh-invisible-header-fields-internal): Add entries "X-BrightmailFiltered:", "X-Brightmail-Tracker:" and "X-Hashcash". 2006-02-04 Bill Wohler @@ -1429,17 +1433,17 @@ * mh-search.el (which-func-mode): Shush compiler on Emacs 21 too. - * mh-alias.el (mh-alias-gecos-name): Use - mh-replace-regexp-in-string instead of replace-regexp-in-string. + * mh-alias.el (mh-alias-gecos-name): + Use mh-replace-regexp-in-string instead of replace-regexp-in-string. (crm, multi-prompt): Use mh-require instead of require. - (mh-goto-address-find-address-at-point): Use - mh-line-beginning-position and mh-line-end-position instead of - line-beginning-position and line-end-position. Use - mh-match-string-no-properties instead of + (mh-goto-address-find-address-at-point): + Use mh-line-beginning-position and mh-line-end-position instead of + line-beginning-position and line-end-position. + Use mh-match-string-no-properties instead of match-string-no-properties. - * mh-comp.el (mh-modify-header-field): Use - mh-line-beginning-position and mh-line-end-position instead of + * mh-comp.el (mh-modify-header-field): + Use mh-line-beginning-position and mh-line-end-position instead of line-beginning-position and line-end-position. * mh-compat.el (mailabbrev): Use mh-require instead of require. @@ -1474,16 +1478,16 @@ mh-line-end-position instead of line-beginning-position and line-end-position. - * mh-limit.el (mh-subject-to-sequence-unthreaded): Use - mh-match-string-no-properties instead of + * mh-limit.el (mh-subject-to-sequence-unthreaded): + Use mh-match-string-no-properties instead of match-string-no-properties. (mh-narrow-to-header-field): Use mh-line-beginning-position and mh-line-end-position instead of line-beginning-position and line-end-position. * mh-mime.el (mh-mime-inline-part, mh-mm-display-part) - (mh-mh-quote-unescaped-sharp, mh-mh-directive-present-p): Use - mh-line-beginning-position and mh-line-end-position instead of + (mh-mh-quote-unescaped-sharp, mh-mh-directive-present-p): + Use mh-line-beginning-position and mh-line-end-position instead of line-beginning-position and line-end-position. * mh-search.el (which-func): Use mh-require instead of require. @@ -1492,8 +1496,8 @@ (mh-mairix-next-result, mh-namazu-next-result) (mh-pick-next-result, mh-grep-next-result) (mh-index-create-imenu-index, mh-index-match-checksum) - (mh-md5sum-parser, mh-openssl-parser, mh-index-update-maps): Use - mh-line-beginning-position and mh-line-end-position instead of + (mh-md5sum-parser, mh-openssl-parser, mh-index-update-maps): + Use mh-line-beginning-position and mh-line-end-position instead of line-beginning-position and line-end-position. * mh-seq.el (mh-list-sequences): Use mh-view-mode-enter instead of @@ -1516,8 +1520,8 @@ (mh-speed-flists): Use mh-cancel-timer instead of cancel-timer. * mh-thread.el (mh-thread-find-children) - (mh-thread-parse-scan-line, mh-thread-generate): Use - mh-line-beginning-position and mh-line-end-position instead of + (mh-thread-parse-scan-line, mh-thread-generate): + Use mh-line-beginning-position and mh-line-end-position instead of line-beginning-position and line-end-position. * mh-utils.el (mh-colors-available-p): Use mh-display-color-cells @@ -1738,8 +1742,8 @@ (mh-letter-header-field-regexp, mh-pgp-support-flag) (mh-x-mailer-string): Move here from mh-comp.el. (mh-folder-line-matches-show-buffer-p): Move to mh-alias.el. - (mh-thread-scan-line-map, mh-thread-scan-line-map-stack): Move - here from mh-seq.el. + (mh-thread-scan-line-map, mh-thread-scan-line-map-stack): + Move here from mh-seq.el. (mh-draft-folder, mh-inbox, mh-user-path, mh-current-folder) (mh-previous-window-config, mh-seen-list, mh-seq-list) (mh-show-buffer, mh-showing-mode, mh-globals-hash) @@ -2042,10 +2046,10 @@ (mh-show-mouse, mh-modify, mh-goto-msg, mh-set-folder-modified-p): Move to new file mh-folder.el. (with-mh-folder-updating, mh-in-show-buffer) - (mh-do-at-event-location, mh-seq-msgs): Moved to mh-acros.el. + (mh-do-at-event-location, mh-seq-msgs): Move to mh-acros.el. (mh-make-seq, mh-seq-name, mh-notate, mh-find-seq) (mh-seq-to-msgs, mh-add-msgs-to-seq, mh-canonicalize-sequence): - Moved to mh-seq.el. + Move to mh-seq.el. (mh-show-xface-function, mh-uncompface-executable, mh-face-to-png) (mh-uncompface, mh-icontopbm, mh-face-foreground-compat) (mh-face-background-compat, mh-face-display-function) @@ -2070,8 +2074,8 @@ mh-init.el. (mh-help-messages): Now an alist of modes to an alist of messages. (mh-set-help): New function used to set mh-help-messages. - (mh-help): Adjust for new format of mh-help-messages. Add - help-messages argument. + (mh-help): Adjust for new format of mh-help-messages. + Add help-messages argument. (mh-prefix-help): Refactor to use mh-help. (mh-coalesce-msg-list, mh-greaterp, mh-lessp): Move here from mh-e.el. @@ -2202,8 +2206,8 @@ (mh-search-mode-map): Autoload so that keys are shown in help even before mh-search is loaded. (mh-search-mode): Sync docstring with manual. - (mh-index-do-search): Rename argument indexer to searcher. Sync - docstring with manual. + (mh-index-do-search): Rename argument indexer to searcher. + Sync docstring with manual. (mh-pick-do-search): Sync docstring with manual. (mh-index-p): Rename to mh-search-p. (mh-indexer-choices): Rename to mh-search-choices. @@ -2220,7 +2224,7 @@ 2006-01-13 Bill Wohler - * mh-acros.el (require): Added Satyaki's comment regarding what + * mh-acros.el (require): Add Satyaki's comment regarding what needs to happen to remove this defadvice which caused a little discussion on emacs-devel today (see Subject: mh-e/mh-acros.el advices `require' incorrectly). @@ -2292,8 +2296,8 @@ * mh-gnus.el: Require mh-acros. (mh-defmacro-compat, mh-defun-compat): Move to mh-acros.el. - * mh-utils.el (mh-x-image-url-cache-canonicalize): Use - url-hexify-string to remove special characters from filenames + * mh-utils.el (mh-x-image-url-cache-canonicalize): + Use url-hexify-string to remove special characters from filenames (closes SF #1396499). Note that this invalidates the existing names in your cache so you might as well remove ~/Mail/.mhe-x-image-cache/* now. @@ -2352,16 +2356,16 @@ than file-executable-p which returns t for directories. (mh-file-command-p): Move here from mh-utils, since mh-variant-*-info are the only functions to use it. - (mh-variant-set, mh-variant-set-variant, mh-variant-p): Use - function mh-variants instead of variable. More robust. + (mh-variant-set, mh-variant-set-variant, mh-variant-p): + Use function mh-variants instead of variable. More robust. (mh-find-path-run): Move here from mh-utils.el. Mention that checking this variable is unnecessary. (mh-find-path): Move here from mh-utils.el. With the advent of MH variants and an mhparam command that doesn't work if there isn't - an MH profile, we can't get libdir for running install-mh. So - don't bother. If there's an issue with the environment, direct the - user to install MH and run install-mh (closes SF #835192). Don't - read ~/.mh_profile directly. Use mh-profile-component which uses + an MH profile, we can't get libdir for running install-mh. + So don't bother. If there's an issue with the environment, direct the + user to install MH and run install-mh (closes SF #835192). + Don't read ~/.mh_profile directly. Use mh-profile-component which uses mhparam (closes SF #1016027). * mh-utils.el (mh-get-profile-field): Rename to @@ -2376,12 +2380,12 @@ (mh-no-install, mh-install): Delete. * mh-customize.el (mh-folder-msg-number): - * mh-mime.el (mh-file-mime-type): Removed trailing whitespace. + * mh-mime.el (mh-file-mime-type): Remove trailing whitespace. 2006-01-09 Bill Wohler - * mh-init.el (mh-variant-mu-mh-info, mh-variant-nmh-info): Applied - patch from Satyaki from SF #1016027. + * mh-init.el (mh-variant-mu-mh-info, mh-variant-nmh-info): + Applied patch from Satyaki from SF #1016027. * mh-e.el (mh-rescan-folder): Try to keep cursor at current message, even if cur sequence is no longer present (closes SF @@ -2429,7 +2433,7 @@ * mh-comp.el: Require cleanup, wrap compiler-shushing defvars with eval-when-compile. - (mh-file-is-vcard-p): Removed redundant test. + (mh-file-is-vcard-p): Remove redundant test. * mh-customize.el: Require cleanup, wrap compiler-shushing defvars with eval-when-compile. @@ -2455,8 +2459,8 @@ * mh-mime.el: Wrap compiler-shushing defvars with eval-when-compile. - (mh-have-file-command): Initialize variable to 'undefined. Add - docstring. Update function of same name accordingly. Also don't + (mh-have-file-command): Initialize variable to 'undefined. + Add docstring. Update function of same name accordingly. Also don't need to load executable any more. (mh-mime-content-types): Delete. (mh-minibuffer-read-type): Prompt user for type if @@ -2695,11 +2699,11 @@ with manual. (mh-yank-cur-msg): Mention that mh-ins-buf-prefix isn't used if you have added a mail-citation-hook and neither are used if you - use one of the supercite flavors of mh-yank-behavior. Sync - docstrings with manual. + use one of the supercite flavors of mh-yank-behavior. + Sync docstrings with manual. - * mh-customize.el (mh-kill-folder-suppress-prompt-hooks): Rename - from mh-kill-folder-suppress-prompt-hook since it is an abnormal + * mh-customize.el (mh-kill-folder-suppress-prompt-hooks): + Rename from mh-kill-folder-suppress-prompt-hook since it is an abnormal hook. Use "Hook run by `function'..." instead of "Invoked...". Sync docstrings with manual. (mh-ins-buf-prefix, mh-yank-behavior): Mention that @@ -2824,13 +2828,13 @@ * mh-customize.el (mh-speed-flists-interval): Rename to mh-speed-update-interval. - (mh-speed-run-flists-flag): Delete. Setting - mh-speed-flists-interval to 0 accomplishes the same thing. + (mh-speed-run-flists-flag): Delete. + Setting mh-speed-flists-interval to 0 accomplishes the same thing. - * mh-speed.el (mh-folder-speedbar-buttons, mh-speed-flists): Use - mh-speed-update-interval instead of mh-speed-run-flists-flag. - (mh-speed-toggle, mh-speed-view, mh-speed-refresh): Sync - docstrings with manual. + * mh-speed.el (mh-folder-speedbar-buttons, mh-speed-flists): + Use mh-speed-update-interval instead of mh-speed-run-flists-flag. + (mh-speed-toggle, mh-speed-view, mh-speed-refresh): + Sync docstrings with manual. 2005-12-09 Bill Wohler @@ -2847,8 +2851,8 @@ (mh-invisible-header-fields-internal): Add X-Bugzilla-* and X-Virus-Scanned. - * mh-customize.el (mh-insert-signature-hook): Rename - mh-letter-insert-signature-hook to mh-insert-signature-hook. + * mh-customize.el (mh-insert-signature-hook): + Rename mh-letter-insert-signature-hook to mh-insert-signature-hook. * mh-comp.el (mh-insert-signature): Ditto. @@ -2950,10 +2954,10 @@ (mh-next-undeleted-msg, mh-previous-undeleted-msg): Rename arg to count. Sync docstrings with manual. (mh-refile-or-write-again): Use output from mh-write-msg-to-file - so that message doesn't change when using this command. Sync - docstrings with manual. - (mh-page-msg, mh-previous-page): Rename arg to lines. Sync - docstrings with manual. + so that message doesn't change when using this command. + Sync docstrings with manual. + (mh-page-msg, mh-previous-page): Rename arg to lines. + Sync docstrings with manual. (mh-write-msg-to-file): Rename msg to message. Rename no-headers to no-header. Sync docstrings with manual. (mh-ps-print-map): Delete keybindings for deleted commands @@ -2977,8 +2981,8 @@ Sync docstrings with manual. (mh-toggle-mh-decode-mime-flag): Use English in message, not Lisp. Sync docstrings with manual. - (mh-mm-display-part, mh-mm-inline-message): Use - mh-highlight-citation-style instead of mh-highlight-citation-p. + (mh-mm-display-part, mh-mm-inline-message): + Use mh-highlight-citation-style instead of mh-highlight-citation-p. (mh-press-button): Sync docstrings with manual. (mh-display-with-external-viewer): Fix default output in minibuffer. Sync docstrings with manual. @@ -3069,8 +3073,8 @@ (mh-smail, mh-extract-rejected-mail, mh-forward, mh-redistribute) (mh-reply, mh-send, mh-send-other-window) (mh-fill-paragraph-function): Sync docstrings with manual. - (mh-edit-again, mh-extract-rejected-mail, mh-redistribute): Rename - msg argument to message (to make for a better docstring). + (mh-edit-again, mh-extract-rejected-mail, mh-redistribute): + Rename msg argument to message (to make for a better docstring). * mh-customize.el (mh-redist-full-contents-flag): Convert defvar to defcustom. Rename by adding -flag. @@ -3095,8 +3099,8 @@ * mh-customize.el (mh-compose-space-does-completion-flag) (mh-signature-separator-flag, mh-interpret-number-as-range-flag) (mh-adaptive-cmd-note-flag): Use "Non-nil means" instead of "On - means" to remain checkdoc clean and consistent with Emacs. I - raised this issue with the Emacs developers and Stallman agrees + means" to remain checkdoc clean and consistent with Emacs. + I raised this issue with the Emacs developers and Stallman agrees that "On means" should be allowed in custom docstrings but that this change requires thought and should wait until after the Emacs 22 release. @@ -3108,14 +3112,14 @@ * mh-customize.el (mh-interpret-number-as-range-flag): Add * to docstring. - (mh-adaptive-cmd-note-flag-check, mh-scan-format-file-check): New - functions to check input for mh-adaptive-cmd-note-flag and + (mh-adaptive-cmd-note-flag-check, mh-scan-format-file-check): + New functions to check input for mh-adaptive-cmd-note-flag and mh-scan-format-file respectively. (mh-adaptive-cmd-note-flag, mh-scan-format-file): Docstring fixes, add :set. - * mh-e.el (mh-scan-field-destination-offset): New variable. The - destination is the -, t, b, c, or n character for Replied, To, cc, + * mh-e.el (mh-scan-field-destination-offset): New variable. + The destination is the -, t, b, c, or n character for Replied, To, cc, Bcc, or Newsgroups respectively. (mh-make-folder, mh-regenerate-headers, mh-generate-new-cmd-note): Call new function mh-msg-num-width-to-column to make leap between @@ -3235,10 +3239,10 @@ 2005-10-23 Bill Wohler - * mh-comp.el (mh-letter-menu): Rename - mh-mhn-compose-external-compressed-tar to - mh-mh-compose-external-compressed-tar. Rename - mh-mhn-compose-anon-ftp to mh-mh-compose-anon-ftp. Rename + * mh-comp.el (mh-letter-menu): + Rename mh-mhn-compose-external-compressed-tar to + mh-mh-compose-external-compressed-tar. + Rename mh-mhn-compose-anon-ftp to mh-mh-compose-anon-ftp. Rename mh-edit-mhn to mh-mh-to-mime. Rename mh-mhn-directive-present-p to mh-mh-directive-present-p. Rename mh-revert-mhn-edit to mh-mh-to-mime-undo. Rename mh-gnus-pgp-support-flag to @@ -3248,21 +3252,21 @@ mh-mh-directive-present-p. (mh-send-letter): Rename mh-mhn-directive-present-p to mh-mh-directive-present-p. Rename mh-edit-mhn to mh-mh-to-mime. - (mh-letter-mode-map): Rename mh-edit-mhn to mh-mh-to-mime. Rename - mh-mhn-compose-anon-ftp to mh-mh-compose-anon-ftp. Rename - mh-mhn-compose-external-compressed-tar to + (mh-letter-mode-map): Rename mh-edit-mhn to mh-mh-to-mime. + Rename mh-mhn-compose-anon-ftp to mh-mh-compose-anon-ftp. + Rename mh-mhn-compose-external-compressed-tar to mh-mh-compose-external-compressed-tar. Rename mh-revert-mhn-edit to mh-mh-to-mime-undo. Rename mh-mhn-compose-external-type to mh-mh-compose-external-type. Rename mh-mhn-compose-anon-ftp to - mh-mh-compose-anon-ftp. Rename - mh-mhn-compose-external-compressed-tar to + mh-mh-compose-anon-ftp. + Rename mh-mhn-compose-external-compressed-tar to mh-mh-compose-external-compressed-tar. Rename mh-revert-mhn-edit to mh-mh-to-mime-undo. Rename mh-mhn-compose-external-type to mh-mh-compose-external-type. (mh-send-letter, mh-letter-mode-map): Rename mh-edit-mhn to mh-mh-to-mime, mh-revert-mhn-edit to mh-mh-to-mime-undo. - (mh-reply, mh-yank-cur-msg, mh-insert-prefix-string): Rename - mh-yank-from-start-of-msg to mh-yank-behavior. + (mh-reply, mh-yank-cur-msg, mh-insert-prefix-string): + Rename mh-yank-from-start-of-msg to mh-yank-behavior. (mh-letter-mode, mh-to-field, mh-to-fcc, mh-insert-signature) (mh-check-whom, mh-insert-auto-fields, mh-send-letter) (mh-insert-letter, mh-yank-cur-msg, mh-insert-prefix-string) @@ -3305,8 +3309,8 @@ (mh-mhn-compose-anon-ftp): Rename to mh-mh-compose-anon-ftp. Rename mh-mhn-compose-external-type to mh-mh-compose-external-type. (mh-mhn-compose-external-compressed-tar): Rename to - mh-mh-compose-external-compressed-tar. Rename - mh-mhn-compose-external-type to mh-mh-compose-external-type. + mh-mh-compose-external-compressed-tar. + Rename mh-mhn-compose-external-type to mh-mh-compose-external-type. (mh-mhn-compose-external-type): Rename to mh-mh-compose-external-type. (mh-edit-mhn): Rename to mh-mh-to-mime. Rename mh-mhn-args to mh-mh-to-mime-args. Rename mh-edit-mhn-hook to mh-mh-to-mime-hook. @@ -3323,8 +3327,8 @@ (mh-mh-compose-external-type): Rename extra-param argument to parameters. (mh-mml-to-mime, mh-secure-message, mh-mml-unsecure-message) - (mh-mime-display-part, mh-mime-display-single): Rename - mh-gnus-pgp-support-flag to mh-pgp-support-flag. + (mh-mime-display-part, mh-mime-display-single): + Rename mh-gnus-pgp-support-flag to mh-pgp-support-flag. (mh-compose-insertion): Rename mh-mhn-compose-insertion to mh-mh-attach-file. (mh-compose-forward): Rename mh-mhn-compose-forw to @@ -3389,8 +3393,8 @@ * mh-init.el (mh-image-load-path-called-flag): New variable which is used by mh-image-load-path so that it runs only once. - (mh-image-load-path): Modify so that it gets run only once. Also - flatten out heavily nested if statements to make it clearer. + (mh-image-load-path): Modify so that it gets run only once. + Also flatten out heavily nested if statements to make it clearer. * mh-e.el (mh-folder-mode): Call mh-image-load-path to allow Emacs to find images used in the toolbar. @@ -3414,11 +3418,11 @@ need to be indented. * mh-e.el: mh-folder-tick-face had been renamed to mh-folder-tick - but the code that invoked the face had not been updated. Tick - highlighting working again. + but the code that invoked the face had not been updated. + Tick highlighting working again. - * mh-seq.el (mh-non-seq-mode-line-annotation): Move - make-variable-buffer-local call to top level to avoid warnings in + * mh-seq.el (mh-non-seq-mode-line-annotation): + Move make-variable-buffer-local call to top level to avoid warnings in CVS Emacs. * mh-comp.el (mh-insert-letter): Replace deprecated read-input === modified file 'lisp/mh-e/mh-utils.el' --- lisp/mh-e/mh-utils.el 2012-01-19 07:21:25 +0000 +++ lisp/mh-e/mh-utils.el 2012-04-25 18:57:09 +0000 @@ -732,8 +732,7 @@ ;; Shush compiler. (mh-do-in-xemacs - (defvar completion-root-regexp) - (defvar minibuffer-completing-file-name)) + (defvar completion-root-regexp)) (defun mh-folder-completing-read (prompt default allow-root-folder-flag) "Read folder name with PROMPT and default result DEFAULT. === modified file 'lisp/minibuffer.el' --- lisp/minibuffer.el 2012-04-20 19:56:59 +0000 +++ lisp/minibuffer.el 2012-04-25 18:57:09 +0000 @@ -45,17 +45,6 @@ ;; corresponding to the displayed completions because we only ;; provide the start info but not the end info in ;; completion-base-position. -;; - quoting is problematic. E.g. the double-dollar quoting used in -;; substitute-in-file-name (and hence read-file-name-internal) bumps -;; into various bugs: -;; - choose-completion doesn't know how to quote the text it inserts. -;; E.g. it fails to double the dollars in file-name completion, or -;; to backslash-escape spaces and other chars in comint completion. -;; - when completing ~/tmp/fo$$o, the highlighting in *Completions* -;; is off by one position. -;; - all code like PCM which relies on all-completions to match -;; its argument gets confused because all-completions returns unquoted -;; texts (as desired for *Completions* output). ;; - C-x C-f ~/*/sr ? should not list "~/./src". ;; - minibuffer-force-complete completes ~/src/emacs/t/lisp/minibuffer.el ;; to ~/src/emacs/trunk/ and throws away lisp/minibuffer.el. @@ -66,12 +55,9 @@ ;; - Make things like icomplete-mode or lightning-completion work with ;; completion-in-region-mode. ;; - extend `metadata': -;; - quoting/unquoting (so we can complete files names with envvars -;; and backslashes, and all-completion can list names without -;; quoting backslashes and dollars). ;; - indicate how to turn all-completion's output into ;; try-completion's output: e.g. completion-ignored-extensions. -;; maybe that could be merged with the "quote" operation above. +;; maybe that could be merged with the "quote" operation. ;; - indicate that `all-completions' doesn't do prefix-completion ;; but just returns some list that relates in some other way to ;; the provided string (as is the case in filecache.el), in which @@ -224,6 +210,42 @@ (let ((completion-ignore-case (not dont-fold))) (complete-with-action action table string pred)))) +(defun completion-table-subvert (table s1 s2) + "Completion table that replaces the prefix S1 with S2 in STRING. +The result is a completion table which completes strings of the +form (concat S1 S) in the same way as TABLE completes strings of +the form (concat S2 S)." + (lambda (string pred action) + (let* ((str (if (eq t (compare-strings string 0 (length s1) s1 nil nil + completion-ignore-case)) + (concat s2 (substring string (length s1))))) + (res (if str (complete-with-action action table str pred)))) + (when res + (cond + ((eq (car-safe action) 'boundaries) + (let ((beg (or (and (eq (car-safe res) 'boundaries) (cadr res)) 0))) + (list* 'boundaries + (max (length s1) + (+ beg (- (length s1) (length s2)))) + (and (eq (car-safe res) 'boundaries) (cddr res))))) + ((stringp res) + (if (eq t (compare-strings res 0 (length s2) s2 nil nil + completion-ignore-case)) + (concat s1 (substring res (length s2))))) + ((eq action t) + (let ((bounds (completion-boundaries str table pred ""))) + (if (>= (car bounds) (length s2)) + res + (let ((re (concat "\\`" + (regexp-quote (substring s2 (car bounds)))))) + (delq nil + (mapcar (lambda (c) + (if (string-match re c) + (substring c (match-end 0)))) + res)))))) + ;; E.g. action=nil and it's the only completion. + (res)))))) + (defun completion-table-with-context (prefix table string pred action) ;; TODO: add `suffix' maybe? (let ((pred @@ -347,6 +369,186 @@ (complete-with-action action table string pred)) tables))) +(defun completion-table-with-quoting (table unquote requote) + ;; A difficult part of completion-with-quoting is to map positions in the + ;; quoted string to equivalent positions in the unquoted string and + ;; vice-versa. There is no efficient and reliable algorithm that works for + ;; arbitrary quote and unquote functions. + ;; So to map from quoted positions to unquoted positions, we simply assume + ;; that `concat' and `unquote' commute (which tends to be the case). + ;; And we ask `requote' to do the work of mapping from unquoted positions + ;; back to quoted positions. + "Return a new completion table operating on quoted text. +TABLE operates on the unquoted text. +UNQUOTE is a function that takes a string and returns a new unquoted string. +REQUOTE is a function of 2 args (UPOS QSTR) where + QSTR is a string entered by the user (and hence indicating + the user's preferred form of quoting); and + UPOS is a position within the unquoted form of QSTR. +REQUOTE should return a pair (QPOS . QFUN) such that QPOS is the +position corresponding to UPOS but in QSTR, and QFUN is a function +of one argument (a string) which returns that argument appropriately quoted +for use at QPOS." + ;; FIXME: One problem with the current setup is that `qfun' doesn't know if + ;; its argument is "the end of the completion", so if the quoting used double + ;; quotes (for example), we end up completing "fo" to "foobar and throwing + ;; away the closing double quote. + (lambda (string pred action) + (cond + ((eq action 'metadata) + (append (completion-metadata string table pred) + '((completion--unquote-requote . t)))) + + ((eq action 'lambda) ;;test-completion + (let ((ustring (funcall unquote string))) + (test-completion ustring table pred))) + + ((eq (car-safe action) 'boundaries) + (let* ((ustring (funcall unquote string)) + (qsuffix (cdr action)) + (ufull (if (zerop (length qsuffix)) ustring + (funcall unquote (concat string qsuffix)))) + (_ (assert (string-prefix-p ustring ufull))) + (usuffix (substring ufull (length ustring))) + (boundaries (completion-boundaries ustring table pred usuffix)) + (qlboundary (car (funcall requote (car boundaries) string))) + (qrboundary (if (zerop (cdr boundaries)) 0 ;Common case. + (let* ((urfullboundary + (+ (cdr boundaries) (length ustring)))) + (- (car (funcall requote urfullboundary + (concat string qsuffix))) + (length string)))))) + (list* 'boundaries qlboundary qrboundary))) + + ((eq action nil) ;;try-completion + (let* ((ustring (funcall unquote string)) + (completion (try-completion ustring table pred))) + ;; Most forms of quoting allow several ways to quote the same string. + ;; So here we could simply requote `completion' in a kind of + ;; "canonical" quoted form without paying attention to the way + ;; `string' was quoted. But since we have to solve the more complex + ;; problems of "pay attention to the original quoting" for + ;; all-completions, we may as well use it here, since it provides + ;; a nicer behavior. + (if (not (stringp completion)) completion + (car (completion--twq-try + string ustring completion 0 unquote requote))))) + + ((eq action t) ;;all-completions + ;; When all-completions is used for completion-try/all-completions + ;; (e.g. for `pcm' style), we can't do the job properly here because + ;; the caller will match our output against some pattern derived from + ;; the user's (quoted) input, and we don't have access to that + ;; pattern, so we can't know how to requote our output so that it + ;; matches the quoting used in the pattern. It is to fix this + ;; fundamental problem that we have to introduce the new + ;; unquote-requote method so that completion-try/all-completions can + ;; pass the unquoted string to the style functions. + (pcase-let* + ((ustring (funcall unquote string)) + (completions (all-completions ustring table pred)) + (boundary (car (completion-boundaries ustring table pred "")))) + (completion--twq-all + string ustring completions boundary unquote requote))) + + ((eq action 'completion--unquote) + (let ((ustring (funcall unquote string)) + (uprefix (funcall unquote (substring string 0 pred)))) + ;; We presume (more or less) that `concat' and `unquote' commute. + (assert (string-prefix-p uprefix ustring)) + (list ustring table (length uprefix) + (lambda (unquoted-result op) + (pcase op + (`1 ;;try + (if (not (stringp (car-safe unquoted-result))) + unquoted-result + (completion--twq-try + string ustring + (car unquoted-result) (cdr unquoted-result) + unquote requote))) + (`2 ;;all + (let* ((last (last unquoted-result)) + (base (or (cdr last) 0))) + (when last + (setcdr last nil) + (completion--twq-all string ustring + unquoted-result base + unquote requote)))))))))))) + +(defun completion--twq-try (string ustring completion point + unquote requote) + ;; Basically two case: either the new result is + ;; - commonprefix1 morecommonprefix suffix + ;; - commonprefix newprefix suffix + (pcase-let* + ((prefix (fill-common-string-prefix ustring completion)) + (suffix (substring completion (max point (length prefix)))) + (`(,qpos . ,qfun) (funcall requote (length prefix) string)) + (qstr1 (if (> point (length prefix)) + (funcall qfun (substring completion (length prefix) point)))) + (qsuffix (funcall qfun suffix)) + (qstring (concat (substring string 0 qpos) qstr1 qsuffix)) + (qpoint + (cond + ((zerop point) 0) + ((> point (length prefix)) (+ qpos (length qstr1))) + (t (car (funcall requote point string)))))) + ;; Make sure `requote' worked. + (assert (equal (funcall unquote qstring) completion)) + (cons qstring qpoint))) + +(defun completion--twq-all (string ustring completions boundary + unquote requote) + (when completions + (pcase-let* + ((prefix + (let ((completion-regexp-list nil)) + (try-completion "" (cons (substring ustring boundary) + completions)))) + (`(,qfullpos . ,qfun) + (funcall requote (+ boundary (length prefix)) string)) + (qfullprefix (substring string 0 qfullpos)) + (_ (assert (let ((uboundarystr (substring ustring 0 boundary))) + (equal (funcall unquote qfullprefix) + (concat uboundarystr prefix))))) + (qboundary (car (funcall requote boundary string))) + (_ (assert (<= qboundary qfullpos))) + ;; FIXME: this split/quote/concat business messes up the carefully + ;; placed completions-common-part and completions-first-difference + ;; faces. We could try within the mapcar loop to search for the + ;; boundaries of those faces, pass them to `requote' to find their + ;; equivalent positions in the quoted output and re-add the faces: + ;; this might actually lead to correct results but would be + ;; pretty expensive. + ;; The better solution is to not quote the *Completions* display, + ;; which nicely circumvents the problem. The solution I used here + ;; instead is to hope that `qfun' preserves the text-properties and + ;; presume that the `first-difference' is not within the `prefix'; + ;; this presumption is not always true, but at least in practice it is + ;; true in most cases. + (qprefix (propertize (substring qfullprefix qboundary) + 'face 'completions-common-part))) + + ;; Here we choose to quote all elements returned, but a better option + ;; would be to return unquoted elements together with a function to + ;; requote them, so that *Completions* can show nicer unquoted values + ;; which only get quoted when needed by choose-completion. + (nconc + (mapcar (lambda (completion) + (assert (string-prefix-p prefix completion)) + (let* ((new (substring completion (length prefix))) + (qnew (funcall qfun new)) + (qcompletion (concat qprefix qnew))) + (assert + (equal (funcall unquote + (concat (substring string 0 qboundary) + qcompletion)) + (concat (substring ustring 0 boundary) + completion))) + qcompletion)) + completions) + qboundary)))) + ;; (defmacro complete-in-turn (a b) `(completion-table-in-turn ,a ,b)) ;; (defmacro dynamic-completion-table (fun) `(completion-table-dynamic ,fun)) (define-obsolete-function-alias @@ -535,21 +737,47 @@ (delete-dups (append (cdr over) (copy-sequence completion-styles))) completion-styles))) +(defun completion--nth-completion (n string table pred point metadata) + "Call the Nth method of completion styles." + (unless metadata + (setq metadata + (completion-metadata (substring string 0 point) table pred))) + ;; We provide special support for quoting/unquoting here because it cannot + ;; reliably be done within the normal completion-table routines: Completion + ;; styles such as `substring' or `partial-completion' need to match the + ;; output of all-completions with the user's input, and since most/all + ;; quoting mechanisms allow several equivalent quoted forms, the + ;; completion-style can't do this matching (e.g. `substring' doesn't know + ;; that "\a\b\e" is a valid (quoted) substring of "label"). + ;; The quote/unquote function needs to come from the completion table (rather + ;; than from completion-extra-properties) because it may apply only to some + ;; part of the string (e.g. substitute-in-file-name). + (let ((requote + (when (completion-metadata-get metadata 'completion--unquote-requote) + (let ((new (funcall table string point 'completion--unquote))) + (setq string (pop new)) + (setq table (pop new)) + (setq point (pop new)) + (pop new)))) + (result + (completion--some (lambda (style) + (funcall (nth n (assq style + completion-styles-alist)) + string table pred point)) + (completion--styles metadata)))) + (if requote + (funcall requote result n) + result))) + (defun completion-try-completion (string table pred point &optional metadata) "Try to complete STRING using completion table TABLE. Only the elements of table that satisfy predicate PRED are considered. POINT is the position of point within STRING. The return value can be either nil to indicate that there is no completion, t to indicate that STRING is the only possible completion, -or a pair (STRING . NEWPOINT) of the completed result string together with +or a pair (NEWSTRING . NEWPOINT) of the completed result string together with a new position for point." - (completion--some (lambda (style) - (funcall (nth 1 (assq style completion-styles-alist)) - string table pred point)) - (completion--styles (or metadata - (completion-metadata - (substring string 0 point) - table pred))))) + (completion--nth-completion 1 string table pred point metadata)) (defun completion-all-completions (string table pred point &optional metadata) "List the possible completions of STRING in completion table TABLE. @@ -559,13 +787,7 @@ in the last `cdr'." ;; FIXME: We need to additionally return the info needed for the ;; second part of completion-base-position. - (completion--some (lambda (style) - (funcall (nth 2 (assq style completion-styles-alist)) - string table pred point)) - (completion--styles (or metadata - (completion-metadata - (substring string 0 point) - table pred))))) + (completion--nth-completion 2 string table pred point metadata)) (defun minibuffer--bitset (modified completions exact) (logior (if modified 4 0) @@ -1754,7 +1976,10 @@ ;;; Completion tables. (defun minibuffer--double-dollars (str) - (replace-regexp-in-string "\\$" "$$" str)) + ;; Reuse the actual "$" from the string to preserve any text-property it + ;; might have, such as `face'. + (replace-regexp-in-string "\\$" (lambda (dollar) (concat dollar dollar)) + str)) (defun completion--make-envvar-table () (mapcar (lambda (enventry) @@ -1880,58 +2105,40 @@ (make-obsolete-variable 'read-file-name-predicate "use the regular PRED argument" "23.2") -(defun completion--file-name-table (string pred action) +(defun completion--sifn-requote (upos qstr) + (let ((qpos 0)) + (while (and (> upos 0) + (string-match "\\$\\(\\$\\|\\([[:alnum:]_]+\\|{[^}]*}\\)\\)?" + qstr qpos)) + (cond + ((>= (- (match-beginning 0) qpos) upos) ; UPOS is before current match. + (setq qpos (+ qpos upos)) + (setq upos 0)) + ((not (match-end 1)) ;A sole $: probably an error. + (setq upos (- upos (- (match-end 0) qpos))) + (setq qpos (match-end 0))) + (t + (setq upos (- upos (- (match-beginning 0) qpos))) + (setq qpos (match-end 0)) + (setq upos (- upos (length (substitute-in-file-name + (match-string 0 qstr)))))))) + ;; If `upos' is negative, it's because it's within the expansion of an + ;; envvar, i.e. there is no exactly matching qpos, so we just use the next + ;; available qpos right after the envvar. + (cons (if (>= upos 0) (+ qpos upos) qpos) + #'minibuffer--double-dollars))) + +(defalias 'completion--file-name-table + (completion-table-with-quoting #'completion-file-name-table + #'substitute-in-file-name + #'completion--sifn-requote) "Internal subroutine for `read-file-name'. Do not call this. This is a completion table for file names, like `completion-file-name-table' -except that it passes the file name through `substitute-in-file-name'." - (cond - ((eq (car-safe action) 'boundaries) - ;; For the boundaries, we can't really delegate to - ;; substitute-in-file-name+completion-file-name-table and then fix - ;; them up (as we do for the other actions), because it would - ;; require us to track the relationship between `str' and - ;; `string', which is difficult. And in any case, if - ;; substitute-in-file-name turns "fo-$TO-ba" into "fo-o/b-ba", - ;; there's no way for us to return proper boundaries info, because - ;; the boundary is not (yet) in `string'. - ;; - ;; FIXME: Actually there is a way to return correct boundaries - ;; info, at the condition of modifying the all-completions - ;; return accordingly. But for now, let's not bother. - (completion-file-name-table string pred action)) - - (t - (let* ((default-directory - (if (stringp pred) - ;; It used to be that `pred' was abused to pass `dir' - ;; as an argument. - (prog1 (file-name-as-directory (expand-file-name pred)) - (setq pred nil)) - default-directory)) - (str (condition-case nil - (substitute-in-file-name string) - (error string))) - (comp (completion-file-name-table - str - (with-no-warnings (or pred read-file-name-predicate)) - action))) - - (cond - ((stringp comp) - ;; Requote the $s before returning the completion. - (minibuffer--double-dollars comp)) - ((and (null action) comp - ;; Requote the $s before checking for changes. - (setq str (minibuffer--double-dollars str)) - (not (string-equal string str))) - ;; If there's no real completion, but substitute-in-file-name - ;; changed the string, then return the new string. - str) - (t comp)))))) +except that it passes the file name through `substitute-in-file-name'.") (defalias 'read-file-name-internal - (completion-table-in-turn 'completion--embedded-envvar-table - 'completion--file-name-table) + (completion-table-in-turn #'completion--embedded-envvar-table + #'completion--file-name-table) "Internal subroutine for `read-file-name'. Do not call this.") (defvar read-file-name-function 'read-file-name-default @@ -2073,7 +2280,7 @@ ;; use (eq minibuffer-completion-table #'read-file-name-internal), which is ;; probably even worse. Maybe We should add some read-file-name-setup-hook ;; instead, but for now, let's keep this non-obsolete. -;;(make-obsolete-variable 'minibuffer-completing-file-name nil "24.1" 'get) +;;(make-obsolete-variable 'minibuffer-completing-file-name nil "future" 'get) (defun read-file-name-default (prompt &optional dir default-filename mustmatch initial predicate) "Default method for reading file names. === modified file 'lisp/pcmpl-unix.el' --- lisp/pcmpl-unix.el 2012-01-27 21:14:16 +0000 +++ lisp/pcmpl-unix.el 2012-04-25 18:53:57 +0000 @@ -205,8 +205,8 @@ ;; Avoid connecting to the remote host when we're ;; only completing the host name. (list string) - (comint--table-subvert (pcomplete-all-entries) - "" "/ssh:"))) + (completion-table-subvert (pcomplete-all-entries) + "" "/ssh:"))) ((string-match "/" string) ; Local file name. (pcomplete-all-entries)) (t ;Host name or local file name. === modified file 'lisp/pcomplete.el' --- lisp/pcomplete.el 2012-04-04 16:06:59 +0000 +++ lisp/pcomplete.el 2012-04-25 18:53:57 +0000 @@ -165,22 +165,8 @@ :type 'boolean :group 'pcomplete) -(defcustom pcomplete-arg-quote-list nil - "List of characters to quote when completing an argument." - :type '(choice (repeat character) - (const :tag "Don't quote" nil)) - :group 'pcomplete) - -(defcustom pcomplete-quote-arg-hook nil - "A hook which is run to quote a character within a filename. -Each function is passed both the filename to be quoted, and the index -to be considered. If the function wishes to provide an alternate -quoted form, it need only return the replacement string. If no -function provides a replacement, quoting shall proceed as normal, -using a backslash to quote any character which is a member of -`pcomplete-arg-quote-list'." - :type 'hook - :group 'pcomplete) +(define-obsolete-variable-alias + 'pcomplete-arg-quote-list 'comint-file-name-quote-list "24.2") (defcustom pcomplete-man-function 'man "A function to that will be called to display a manual page. @@ -370,48 +356,28 @@ ;; it pretty much impossible to have completion other than ;; prefix-completion. ;; -;; pcomplete--common-quoted-suffix and comint--table-subvert try to -;; work around this difficulty with heuristics, but it's -;; really a hack. - -(defvar pcomplete-unquote-argument-function nil) - -(defun pcomplete-unquote-argument (s) - (cond - (pcomplete-unquote-argument-function - (funcall pcomplete-unquote-argument-function s)) - ((null pcomplete-arg-quote-list) s) - (t - (replace-regexp-in-string "\\\\\\(.\\)" "\\1" s t)))) - -(defun pcomplete--common-quoted-suffix (s1 s2) - ;; FIXME: Copied in comint.el. - "Find the common suffix between S1 and S2 where S1 is the expanded S2. -S1 is expected to be the unquoted and expanded version of S2. -Returns (PS1 . PS2), i.e. the shortest prefixes of S1 and S2, such that -S1 = (concat PS1 SS1) and S2 = (concat PS2 SS2) and -SS1 = (unquote SS2)." - (let* ((cs (comint--common-suffix s1 s2)) - (ss1 (substring s1 (- (length s1) cs))) - (qss1 (pcomplete-quote-argument ss1)) - qc s2b) - (if (and (not (equal ss1 qss1)) - (setq qc (pcomplete-quote-argument (substring ss1 0 1))) - (setq s2b (- (length s2) cs (length qc) -1)) - (>= s2b 0) ;bug#11158. - (eq t (compare-strings s2 s2b (- (length s2) cs -1) - qc nil nil))) - ;; The difference found is just that one char is quoted in S2 - ;; but not in S1, keep looking before this difference. - (pcomplete--common-quoted-suffix - (substring s1 0 (- (length s1) cs)) - (substring s2 0 s2b)) - (cons (substring s1 0 (- (length s1) cs)) - (substring s2 0 (- (length s2) cs)))))) - -;; I don't think such commands are usable before first setting up buffer-local -;; variables to parse args, so there's no point autoloading it. -;; ;;;###autoload +;; pcomplete--common-suffix and completion-table-subvert try to work around +;; this difficulty with heuristics, but it's really a hack. + +(defvar pcomplete-unquote-argument-function #'comint--unquote-argument) + +(defsubst pcomplete-unquote-argument (s) + (funcall pcomplete-unquote-argument-function s)) + +(defvar pcomplete-requote-argument-function #'comint--requote-argument) + +(defun pcomplete--common-suffix (s1 s2) + ;; Since S2 is expected to be the "unquoted/expanded" version of S1, + ;; there shouldn't be any case difference, even if the completion is + ;; case-insensitive. + (let ((case-fold-search nil)) + (string-match + ;; \x3FFF7F is just an arbitrary char among the ones Emacs accepts + ;; that hopefully will never appear in normal text. + "\\(?:.\\|\n\\)*?\\(\\(?:.\\|\n\\)*\\)\x3FFF7F\\(?:.\\|\n\\)*\\1\\'" + (concat s1 "\x3FFF7F" s2)) + (- (match-end 1) (match-beginning 1)))) + (defun pcomplete-completions-at-point () "Provide standard completion using pcomplete's completion tables. Same as `pcomplete' but using the standard completion UI." @@ -442,34 +408,31 @@ ;; pcomplete-stub and works from the buffer's text instead, ;; we need to trick minibuffer-complete, into using ;; pcomplete-stub without its knowledge. To that end, we - ;; use comint--table-subvert to construct a completion + ;; use completion-table-subvert to construct a completion ;; table which expects strings using a prefix from the ;; buffer's text but internally uses the corresponding ;; prefix from pcomplete-stub. (beg (max (- (point) (length pcomplete-stub)) (pcomplete-begin))) - (buftext (buffer-substring beg (point)))) + (buftext (pcomplete-unquote-argument + (buffer-substring beg (point))))) (when completions (let ((table - (cond - ((not (equal pcomplete-stub buftext)) - ;; This isn't always strictly right (e.g. if - ;; FOO="toto/$FOO", then completion of /$FOO/bar may - ;; result in something incorrect), but given the lack of - ;; any other info, it's about as good as it gets, and in - ;; practice it should work just fine (fingers crossed). - (let ((prefixes (pcomplete--common-quoted-suffix + (completion-table-with-quoting + (if (equal pcomplete-stub buftext) + completions + ;; This may not always be strictly right, but given the lack + ;; of any other info, it's about as good as it gets, and in + ;; practice it should work just fine (fingers crossed). + (let ((suf-len (pcomplete--common-suffix pcomplete-stub buftext))) - (comint--table-subvert - completions (cdr prefixes) (car prefixes) - #'pcomplete-quote-argument #'pcomplete-unquote-argument))) - (t - (lambda (string pred action) - (let ((res (complete-with-action - action completions string pred))) - (if (stringp res) - (pcomplete-quote-argument res) - res)))))) + (completion-table-subvert + completions + (substring buftext 0 (- (length buftext) suf-len)) + (substring pcomplete-stub 0 + (- (length pcomplete-stub) suf-len))))) + pcomplete-unquote-argument-function + pcomplete-requote-argument-function)) (pred ;; Pare it down, if applicable. (when (and pcomplete-use-paring pcomplete-seen) @@ -828,22 +791,8 @@ (throw 'pcompleted t) pcomplete-args)))))) -(defun pcomplete-quote-argument (filename) - "Return FILENAME with magic characters quoted. -Magic characters are those in `pcomplete-arg-quote-list'." - (if (null pcomplete-arg-quote-list) - filename - (let ((index 0)) - (mapconcat (lambda (c) - (prog1 - (or (run-hook-with-args-until-success - 'pcomplete-quote-arg-hook filename index) - (when (memq c pcomplete-arg-quote-list) - (string ?\\ c)) - (char-to-string c)) - (setq index (1+ index)))) - filename - "")))) +(define-obsolete-function-alias + 'pcomplete-quote-argument #'comint-quote-filename "24.2") ;; file-system completion lists @@ -1179,14 +1128,14 @@ (if (not pcomplete-ignore-case) (insert-and-inherit (if raw-p (substring entry (length stub)) - (pcomplete-quote-argument + (comint-quote-filename (substring entry (length stub))))) ;; the stub is not quoted at this time, so to determine the ;; length of what should be in the buffer, we must quote it ;; FIXME: Here we presume that quoting `stub' gives us the exact ;; text in the buffer before point, which is not guaranteed; ;; e.g. it is not the case in eshell when completing ${FOO}tm[TAB]. - (delete-char (- (length (pcomplete-quote-argument stub)))) + (delete-char (- (length (comint-quote-filename stub)))) ;; if there is already a backslash present to handle the first ;; character, don't bother quoting it (when (eq (char-before) ?\\) @@ -1194,7 +1143,7 @@ (setq entry (substring entry 1))) (insert-and-inherit (if raw-p entry - (pcomplete-quote-argument entry)))) + (comint-quote-filename entry)))) (let (space-added) (when (and (not (memq (char-before) pcomplete-suffix-list)) addsuffix) @@ -1204,7 +1153,7 @@ pcomplete-last-completion-stub stub) space-added))) -;; selection of completions +;; Selection of completions. (defun pcomplete-do-complete (stub completions) "Dynamically complete at point using STUB and COMPLETIONS. ------------------------------------------------------------ revno: 108033 committer: Leo Liu branch nick: trunk timestamp: Thu 2012-04-26 00:46:01 +0800 message: * lisp/progmodes/python.el (python-pdbtrack-get-source-buffer): Use compilation-message if available to find real filename. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-04-25 15:23:19 +0000 +++ lisp/ChangeLog 2012-04-25 16:46:01 +0000 @@ -1,3 +1,8 @@ +2012-04-25 Leo Liu + + * progmodes/python.el (python-pdbtrack-get-source-buffer): Use + compilation-message if available to find real filename. + 2012-04-25 Chong Yidong * vc/diff-mode.el (diff-setup-whitespace): New function. === modified file 'lisp/progmodes/python.el' --- lisp/progmodes/python.el 2012-04-25 15:23:19 +0000 +++ lisp/progmodes/python.el 2012-04-25 16:46:01 +0000 @@ -2606,9 +2606,17 @@ (let* ((filename (match-string 1 block)) (lineno (string-to-number (match-string 2 block))) (funcname (match-string 3 block)) + (msg (get-text-property 0 'compilation-message filename)) + (loc (and msg (compilation--message->loc msg))) funcbuffer) - (cond ((file-exists-p filename) + (cond ((and loc (markerp (compilation--loc->marker loc))) + (setq funcbuffer (marker-buffer (compilation--loc->marker loc))) + (list (with-current-buffer funcbuffer + (line-number-at-pos (compilation--loc->marker loc))) + funcbuffer)) + + ((file-exists-p filename) (list lineno (find-file-noselect filename))) ((setq funcbuffer (python-pdbtrack-grub-for-buffer funcname lineno)) @@ -2626,15 +2634,12 @@ (buffer-substring (point-min) (point-max))) ))))))) - (list lineno funcbuffer)) + (list lineno funcbuffer)) ((= (elt filename 0) ?\<) (format "(Non-file source: '%s')" filename)) - (t (format "Not found: %s(), %s" funcname filename))) - ) - ) - ) + (t (format "Not found: %s(), %s" funcname filename)))))) (defun python-pdbtrack-grub-for-buffer (funcname _lineno) "Find recent Python mode buffer named, or having function named FUNCNAME." ------------------------------------------------------------ revno: 108032 committer: Leo Liu branch nick: trunk timestamp: Wed 2012-04-25 23:23:19 +0800 message: * progmodes/python.el (python-send-region): Add suffix .py diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-04-25 15:06:51 +0000 +++ lisp/ChangeLog 2012-04-25 15:23:19 +0000 @@ -9,6 +9,9 @@ 2012-04-25 Leo Liu + * progmodes/python.el (python-send-region): Add suffix .py to the + temp file. + * files.el (auto-mode-alist): Use javascript-mode instead. 2012-04-25 Alex Harsanyi === modified file 'lisp/progmodes/python.el' --- lisp/progmodes/python.el 2012-04-24 14:58:29 +0000 +++ lisp/progmodes/python.el 2012-04-25 15:23:19 +0000 @@ -1601,7 +1601,7 @@ ;; Fixme: Write a `coding' header to the temp file if the region is ;; non-ASCII. (interactive "r") - (let* ((f (make-temp-file "py")) + (let* ((f (make-temp-file "py" nil ".py")) (command ;; IPython puts the FakeModule module into __main__ so ;; emacs.eexecfile becomes useless. ------------------------------------------------------------ revno: 108031 fixes bug(s): http://debbugs.gnu.org/8612 committer: Chong Yidong branch nick: trunk timestamp: Wed 2012-04-25 23:06:51 +0800 message: Fix whitespace highlighting of context diffs. * lisp/vc/diff-mode.el (diff-setup-whitespace): New function. (diff-mode): Use it. * lisp/vc/diff.el (diff-sentinel): * lisp/vc/vc.el (vc-diff-finish): Call diff-setup-whitespace to assign Whitespace mode variables based on diff style. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-04-25 14:47:33 +0000 +++ lisp/ChangeLog 2012-04-25 15:06:51 +0000 @@ -1,3 +1,12 @@ +2012-04-25 Chong Yidong + + * vc/diff-mode.el (diff-setup-whitespace): New function. + (diff-mode): Use it. + + * vc/diff.el (diff-sentinel): + * vc/vc.el (vc-diff-finish): Call diff-setup-whitespace to assign + Whitespace mode variables based on diff style (Bug#8612). + 2012-04-25 Leo Liu * files.el (auto-mode-alist): Use javascript-mode instead. === modified file 'lisp/vc/diff-mode.el' --- lisp/vc/diff-mode.el 2012-04-14 06:28:57 +0000 +++ lisp/vc/diff-mode.el 2012-04-25 15:06:51 +0000 @@ -1283,11 +1283,7 @@ (set (make-local-variable 'end-of-defun-function) 'diff-end-of-file) - ;; Set up `whitespace-mode' so that turning it on will show trailing - ;; whitespace problems on the modified lines of the diff. - (set (make-local-variable 'whitespace-style) '(face trailing)) - (set (make-local-variable 'whitespace-trailing-regexp) - "^[-\+!<>].*?\\([\t ]+\\)$") + (diff-setup-whitespace) (setq buffer-read-only diff-default-read-only) ;; setup change hooks @@ -1332,6 +1328,22 @@ ;;; Handy hook functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun diff-setup-whitespace () + "Set up Whitespace mode variables for the current Diff mode buffer. +This sets `whitespace-style' and `whitespace-trailing-regexp' so +that Whitespace mode shows trailing whitespace problems on the +modified lines of the diff." + (set (make-local-variable 'whitespace-style) '(face trailing)) + (let ((style (save-excursion + (goto-char (point-min)) + (when (re-search-forward diff-hunk-header-re nil t) + (goto-char (match-beginning 0)) + (diff-hunk-style))))) + (set (make-local-variable 'whitespace-trailing-regexp) + (if (eq style 'context) + "^[-\+!] .*?\\([\t ]+\\)$" + "^[-\+!<>].*?\\([\t ]+\\)$")))) + (defun diff-delete-if-empty () ;; An empty diff file means there's no more diffs to integrate, so we ;; can just remove the file altogether. Very handy for .rej files if we === modified file 'lisp/vc/diff.el' --- lisp/vc/diff.el 2012-01-19 07:21:25 +0000 +++ lisp/vc/diff.el 2012-04-25 15:06:51 +0000 @@ -30,6 +30,8 @@ ;;; Code: +(declare-function diff-setup-whitespace "diff-mode" ()) + (eval-when-compile (require 'cl)) (defgroup diff nil @@ -64,6 +66,7 @@ delete the temporary files so named." (if old-temp-file (delete-file old-temp-file)) (if new-temp-file (delete-file new-temp-file)) + (diff-setup-whitespace) (save-excursion (goto-char (point-max)) (let ((inhibit-read-only t)) === modified file 'lisp/vc/vc.el' --- lisp/vc/vc.el 2012-04-22 13:58:00 +0000 +++ lisp/vc/vc.el 2012-04-25 15:06:51 +0000 @@ -655,6 +655,8 @@ (require 'vc-dispatcher) (require 'ediff) +(declare-function diff-setup-whitespace "diff-mode" ()) + (eval-when-compile (require 'cl) (require 'dired)) @@ -1524,17 +1526,18 @@ ;; possibility of an empty output is for an async process. (when (buffer-live-p buffer) (let ((window (get-buffer-window buffer t)) - (emptyp (zerop (buffer-size buffer)))) + (emptyp (zerop (buffer-size buffer)))) (with-current-buffer buffer - (and messages emptyp - (let ((inhibit-read-only t)) - (insert (cdr messages) ".\n") - (message "%s" (cdr messages)))) - (goto-char (point-min)) - (when window - (shrink-window-if-larger-than-buffer window))) + (and messages emptyp + (let ((inhibit-read-only t)) + (insert (cdr messages) ".\n") + (message "%s" (cdr messages)))) + (diff-setup-whitespace) + (goto-char (point-min)) + (when window + (shrink-window-if-larger-than-buffer window))) (when (and messages (not emptyp)) - (message "%sdone" (car messages)))))) + (message "%sdone" (car messages)))))) (defvar vc-diff-added-files nil "If non-nil, diff added files by comparing them to /dev/null.") ------------------------------------------------------------ revno: 108030 committer: Leo Liu branch nick: trunk timestamp: Wed 2012-04-25 22:47:33 +0800 message: * lisp/files.el (auto-mode-alist): Use javascript-mode instead. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-04-25 10:28:29 +0000 +++ lisp/ChangeLog 2012-04-25 14:47:33 +0000 @@ -1,3 +1,7 @@ +2012-04-25 Leo Liu + + * files.el (auto-mode-alist): Use javascript-mode instead. + 2012-04-25 Alex Harsanyi Sync with soap-client repository. Support SOAP simpleType. (Bug#10331) === modified file 'lisp/files.el' --- lisp/files.el 2012-04-18 06:24:13 +0000 +++ lisp/files.el 2012-04-25 14:47:33 +0000 @@ -2340,8 +2340,8 @@ ("\\.dbk\\'" . xml-mode) ("\\.dtd\\'" . sgml-mode) ("\\.ds\\(ss\\)?l\\'" . dsssl-mode) - ("\\.js\\'" . js-mode) ; javascript-mode would be better - ("\\.json\\'" . js-mode) + ("\\.js\\'" . javascript-mode) + ("\\.json\\'" . javascript-mode) ("\\.[ds]?vh?\\'" . verilog-mode) ;; .emacs or .gnus or .viper following a directory delimiter in ;; Unix, MSDOG or VMS syntax. ------------------------------------------------------------ revno: 108029 author: Alex Harsanyi committer: Michael Albinus branch nick: trunk timestamp: Wed 2012-04-25 12:28:29 +0200 message: Sync with soap-client repository. Support SOAP simpleType. (Bug#10331) * soap-client.el (soap-resolve-references-for-sequence-type) (soap-resolve-references-for-array-type): hack to prevent self references, see Bug#9. (soap-parse-envelope): report the contents of the 'detail' node when receiving a fault reply. (soap-parse-envelope): report the contents of the entire 'detail' node. * soap-inspect.el (soap-sample-value-for-simple-type) (soap-inspect-simple-type): new function * soap-client.el (soap-simple-type): new struct (soap-default-xsd-types, soap-default-soapenc-types) (soap-decode-basic-type, soap-encode-basic-type): support unsignedInt and double basic types (soap-resolve-references-for-simple-type) (soap-parse-simple-type, soap-encode-simple-type): new function (soap-parse-schema): parse xsd:simpleType declarations * soap-client.el (soap-default-xsd-types) (soap-default-soapenc-types): add integer, byte and anyURI types (soap-parse-complex-type-complex-content): use `soap-wk2l' to find the local name of "soapenc:Array" (soap-decode-basic-type, soap-encode-basic-type): support encoding decoding integer, byte and anyURI xsd types. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-04-25 08:38:11 +0000 +++ lisp/ChangeLog 2012-04-25 10:28:29 +0000 @@ -1,3 +1,33 @@ +2012-04-25 Alex Harsanyi + + Sync with soap-client repository. Support SOAP simpleType. (Bug#10331) + + * soap-client.el (soap-resolve-references-for-sequence-type) + (soap-resolve-references-for-array-type): hack to prevent self + references, see Bug#9. + (soap-parse-envelope): report the contents of the 'detail' node + when receiving a fault reply. + (soap-parse-envelope): report the contents of the entire 'detail' + node. + + * soap-inspect.el (soap-sample-value-for-simple-type) + (soap-inspect-simple-type): new function + + * soap-client.el (soap-simple-type): new struct + (soap-default-xsd-types, soap-default-soapenc-types) + (soap-decode-basic-type, soap-encode-basic-type): support + unsignedInt and double basic types + (soap-resolve-references-for-simple-type) + (soap-parse-simple-type, soap-encode-simple-type): new function + (soap-parse-schema): parse xsd:simpleType declarations + + * soap-client.el (soap-default-xsd-types) + (soap-default-soapenc-types): add integer, byte and anyURI types + (soap-parse-complex-type-complex-content): use `soap-wk2l' to find + the local name of "soapenc:Array" + (soap-decode-basic-type, soap-encode-basic-type): support encoding + decoding integer, byte and anyURI xsd types. + 2012-04-25 Chong Yidong * cus-edit.el (custom-buffer-create-internal): Update header text. === modified file 'lisp/net/soap-client.el' --- lisp/net/soap-client.el 2012-02-11 22:13:29 +0000 +++ lisp/net/soap-client.el 2012-04-25 10:28:29 +0000 @@ -369,6 +369,9 @@ kind ; a symbol of: string, dateTime, long, int ) +(defstruct (soap-simple-type (:include soap-basic-type)) + enumeration) + (defstruct soap-sequence-element name type nillable? multiple?) @@ -415,8 +418,9 @@ (defun soap-default-xsd-types () "Return a namespace containing some of the XMLSchema types." (let ((ns (make-soap-namespace :name "http://www.w3.org/2001/XMLSchema"))) - (dolist (type '("string" "dateTime" "boolean" "long" "int" "float" - "base64Binary" "anyType" "Array" "byte[]")) + (dolist (type '("string" "dateTime" "boolean" + "long" "int" "integer" "unsignedInt" "byte" "float" "double" + "base64Binary" "anyType" "anyURI" "Array" "byte[]")) (soap-namespace-put (make-soap-basic-type :name type :kind (intern type)) ns)) @@ -425,9 +429,10 @@ (defun soap-default-soapenc-types () "Return a namespace containing some of the SOAPEnc types." (let ((ns (make-soap-namespace - :name "http://schemas.xmlsoap.org/soap/encoding/"))) - (dolist (type '("string" "dateTime" "boolean" "long" "int" "float" - "base64Binary" "anyType" "Array" "byte[]")) + :name "http://schemas.xmlsoap.org/soap/encoding/"))) + (dolist (type '("string" "dateTime" "boolean" + "long" "int" "integer" "unsignedInt" "byte" "float" "double" + "base64Binary" "anyType" "anyURI" "Array" "byte[]")) (soap-namespace-put (make-soap-basic-type :name type :kind (intern type)) ns)) @@ -555,6 +560,15 @@ (when resolver (funcall resolver element wsdl)))) +(defun soap-resolve-references-for-simple-type (type wsdl) + "Resolve the base type for the simple TYPE using the WSDL + document." + (let ((kind (soap-basic-type-kind type))) + (unless (symbolp kind) + (let ((basic-type (soap-wsdl-get kind wsdl 'soap-basic-type-p))) + (setf (soap-basic-type-kind type) + (soap-basic-type-kind basic-type)))))) + (defun soap-resolve-references-for-sequence-type (type wsdl) "Resolve references for a sequence TYPE using WSDL document. See also `soap-resolve-references-for-element' and @@ -562,12 +576,18 @@ (let ((parent (soap-sequence-type-parent type))) (when (or (consp parent) (stringp parent)) (setf (soap-sequence-type-parent type) - (soap-wsdl-get parent wsdl 'soap-type-p)))) + (soap-wsdl-get + parent wsdl + ;; Prevent self references, see Bug#9 + (lambda (e) (and (not (eq e type)) (soap-type-p e))))))) (dolist (element (soap-sequence-type-elements type)) (let ((element-type (soap-sequence-element-type element))) (cond ((or (consp element-type) (stringp element-type)) (setf (soap-sequence-element-type element) - (soap-wsdl-get element-type wsdl 'soap-type-p))) + (soap-wsdl-get + element-type wsdl + ;; Prevent self references, see Bug#9 + (lambda (e) (and (not (eq e type)) (soap-type-p e)))))) ((soap-element-p element-type) ;; since the element already has a child element, it ;; could be an inline structure. we must resolve @@ -582,7 +602,10 @@ (let ((element-type (soap-array-type-element-type type))) (when (or (consp element-type) (stringp element-type)) (setf (soap-array-type-element-type type) - (soap-wsdl-get element-type wsdl 'soap-type-p))))) + (soap-wsdl-get + element-type wsdl + ;; Prevent self references, see Bug#9 + (lambda (e) (and (not (eq e type)) (soap-type-p e)))))))) (defun soap-resolve-references-for-message (message wsdl) "Resolve references for a MESSAGE type using the WSDL document. @@ -679,6 +702,8 @@ ;; Install resolvers for our types (progn + (put (aref (make-soap-simple-type) 0) 'soap-resolve-references + 'soap-resolve-references-for-simple-type) (put (aref (make-soap-sequence-type) 0) 'soap-resolve-references 'soap-resolve-references-for-sequence-type) (put (aref (make-soap-array-type) 0) 'soap-resolve-references @@ -854,6 +879,9 @@ (let ((ns (make-soap-namespace :name (soap-get-target-namespace node)))) ;; NOTE: we only extract the complexTypes from the schema, we wouldn't ;; know how to handle basic types beyond the built in ones anyway. + (dolist (node (soap-xml-get-children1 node 'xsd:simpleType)) + (soap-namespace-put (soap-parse-simple-type node) ns)) + (dolist (node (soap-xml-get-children1 node 'xsd:complexType)) (soap-namespace-put (soap-parse-complex-type node) ns)) @@ -862,6 +890,26 @@ ns))) +(defun soap-parse-simple-type (node) + "Parse NODE and construct a simple type from it." + (assert (eq (soap-l2wk (xml-node-name node)) 'xsd:simpleType) + nil + "soap-parse-complex-type: expecting xsd:simpleType node, got %s" + (soap-l2wk (xml-node-name node))) + (let ((name (xml-get-attribute-or-nil node 'name)) + type + enumeration + (restriction (car-safe + (soap-xml-get-children1 node 'xsd:restriction)))) + (unless restriction + (error "simpleType %s has no base type" name)) + + (setq type (xml-get-attribute-or-nil restriction 'base)) + (dolist (e (soap-xml-get-children1 restriction 'xsd:enumeration)) + (push (xml-get-attribute e 'value) enumeration)) + + (make-soap-simple-type :name name :kind type :enumeration enumeration))) + (defun soap-parse-schema-element (node) "Parse NODE and construct a schema element from it." (assert (eq (soap-l2wk (xml-node-name node)) 'xsd:element) @@ -975,7 +1023,7 @@ extension 'xsd:sequence))))) (restriction (let ((base (xml-get-attribute-or-nil restriction 'base))) - (assert (equal base "soapenc:Array") + (assert (equal base (soap-wk2l "soapenc:Array")) nil "restrictions supported only for soapenc:Array types, this is a %s" base)) @@ -1245,9 +1293,9 @@ (if (null contents) nil (ecase type-kind - (string (car contents)) + ((string anyURI) (car contents)) (dateTime (car contents)) ; TODO: convert to a date time - ((long int float) (string-to-number (car contents))) + ((long int integer unsignedInt byte float double) (string-to-number (car contents))) (boolean (string= (downcase (car contents)) "true")) (base64Binary (base64-decode-string (car contents))) (anyType (soap-decode-any-type node)) @@ -1293,6 +1341,10 @@ (progn (put (aref (make-soap-basic-type) 0) 'soap-decoder 'soap-decode-basic-type) + ;; just use the basic type decoder for the simple type -- we accept any + ;; value and don't do any validation on it. + (put (aref (make-soap-simple-type) 0) + 'soap-decoder 'soap-decode-basic-type) (put (aref (make-soap-sequence-type) 0) 'soap-decoder 'soap-decode-sequence-type) (put (aref (make-soap-array-type) 0) @@ -1322,10 +1374,11 @@ fault 'faultcode)))) (car-safe (xml-node-children n)))) (fault-string (let ((n (car (xml-get-children - fault 'faultstring)))) - (car-safe (xml-node-children n))))) + fault 'faultstring)))) + (car-safe (xml-node-children n)))) + (detail (xml-get-children fault 'detail))) (while t - (signal 'soap-error (list fault-code fault-string)))))) + (signal 'soap-error (list fault-code fault-string detail)))))) ;; First (non string) element of the body is the root node of he ;; response @@ -1457,7 +1510,7 @@ (progn (insert ">") (case basic-type - (string + ((string anyURI) (unless (stringp value) (error "Soap-encode-basic-type(%s, %s, %s): not a string value" xml-tag value xsi-type)) @@ -1484,10 +1537,19 @@ xml-tag value xsi-type)) (insert (if value "true" "false"))) - ((long int) + ((long int integer byte unsignedInt) (unless (integerp value) (error "Soap-encode-basic-type(%s, %s, %s): not an integer value" xml-tag value xsi-type)) + (when (and (eq basic-type 'unsignedInt) (< value 0)) + (error "Soap-encode-basic-type(%s, %s, %s): not a positive integer" + xml-tag value xsi-type)) + (insert (number-to-string value))) + + ((float double) + (unless (numberp value) + (error "Soap-encode-basic-type(%s, %s, %s): not a number" + xml-tag value xsi-type)) (insert (number-to-string value))) (base64Binary @@ -1504,6 +1566,20 @@ (insert " xsi:nil=\"true\">")) (insert "\n"))) +(defun soap-encode-simple-type (xml-tag value type) + "Encode inside XML-TAG the LISP VALUE according to TYPE." + + ;; Validate VALUE agains the simple type's enumeration, than just encode it + ;; using `soap-encode-basic-type' + + (let ((enumeration (soap-simple-type-enumeration type))) + (unless (and (> (length enumeration) 1) + (member value enumeration)) + (error "soap-encode-simple-type(%s, %s, %s): bad value, should be one of %s" + xml-tag value (soap-element-fq-name type) enumeration))) + + (soap-encode-basic-type xml-tag value type)) + (defun soap-encode-sequence-type (xml-tag value type) "Encode inside XML-TAG the LISP VALUE according to TYPE. Do not call this function directly, use `soap-encode-value' @@ -1564,6 +1640,8 @@ (progn (put (aref (make-soap-basic-type) 0) 'soap-encoder 'soap-encode-basic-type) + (put (aref (make-soap-simple-type) 0) + 'soap-encoder 'soap-encode-simple-type) (put (aref (make-soap-sequence-type) 0) 'soap-encoder 'soap-encode-sequence-type) (put (aref (make-soap-array-type) 0) === modified file 'lisp/net/soap-inspect.el' --- lisp/net/soap-inspect.el 2012-01-05 09:46:05 +0000 +++ lisp/net/soap-inspect.el 2012-04-25 10:28:29 +0000 @@ -66,6 +66,15 @@ ;; TODO: we need better sample values for more types. (t (format "%s" (soap-basic-type-kind type))))) +(defun soap-sample-value-for-simple-type (type) + "Provive a sample value for TYPE which is a simple type. +This is a specific function which should not be called directly, +use `soap-sample-value' instead." + (let ((enumeration (soap-simple-type-enumeration type))) + (if (> (length enumeration) 1) + (elt enumeration (random (length enumeration))) + (soap-sample-value-for-basic-type type)))) + (defun soap-sample-value-for-seqence-type (type) "Provide a sample value for TYPE which is a sequence type. Values for sequence types are ALISTS of (slot-name . VALUE) for @@ -115,6 +124,9 @@ (put (aref (make-soap-basic-type) 0) 'soap-sample-value 'soap-sample-value-for-basic-type) + (put (aref (make-soap-simple-type) 0) 'soap-sample-value + 'soap-sample-value-for-simple-type) + (put (aref (make-soap-sequence-type) 0) 'soap-sample-value 'soap-sample-value-for-seqence-type) @@ -204,6 +216,16 @@ (insert "\nSample value\n") (pp (soap-sample-value basic-type) (current-buffer))) +(defun soap-inspect-simple-type (simple-type) + "Insert information about SIMPLE-TYPE into the current buffer" + (insert "Simple type: " (soap-element-fq-name simple-type) "\n") + (insert "Base: " (symbol-name (soap-basic-type-kind simple-type)) "\n") + (let ((enumeration (soap-simple-type-enumeration simple-type))) + (when (> (length enumeration) 1) + (insert "Valid values: ") + (dolist (e enumeration) + (insert "\"" e "\" "))))) + (defun soap-inspect-sequence-type (sequence) "Insert information about SEQUENCE into the current buffer." (insert "Sequence type: " (soap-element-fq-name sequence) "\n") @@ -331,6 +353,9 @@ (put (aref (make-soap-basic-type) 0) 'soap-inspect 'soap-inspect-basic-type) + (put (aref (make-soap-simple-type) 0) 'soap-inspect + 'soap-inspect-simple-type) + (put (aref (make-soap-sequence-type) 0) 'soap-inspect 'soap-inspect-sequence-type) ------------------------------------------------------------ revno: 108028 committer: Chong Yidong branch nick: trunk timestamp: Wed 2012-04-25 16:38:11 +0800 message: * cus-edit.el (custom-buffer-create-internal): Update header text. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-04-25 08:07:57 +0000 +++ lisp/ChangeLog 2012-04-25 08:38:11 +0000 @@ -1,3 +1,7 @@ +2012-04-25 Chong Yidong + + * cus-edit.el (custom-buffer-create-internal): Update header text. + 2012-04-25 Eli Zaretskii * progmodes/gdb-mi.el (gdb-init-1): Condition Windows-specific === modified file 'lisp/cus-edit.el' --- lisp/cus-edit.el 2012-04-23 12:37:55 +0000 +++ lisp/cus-edit.el 2012-04-25 08:38:11 +0000 @@ -1591,13 +1591,12 @@ (let ((init-file (or custom-file user-init-file))) ;; Insert verbose help at the top of the custom buffer. (when custom-buffer-verbose-help - (widget-insert (if init-file - "To apply changes, use the Save or Set buttons." - "Custom settings cannot be saved; maybe you started Emacs with `-q'.") - "\nFor details, see ") + (unless init-file + (widget-insert "Custom settings cannot be saved; maybe you started Emacs with `-q'.\n")) + (widget-insert "For help using this buffer, see ") (widget-create 'custom-manual - :tag "Saving Customizations" - "(emacs)Saving Customizations") + :tag "Easy Customization" + "(emacs)Easy Customization") (widget-insert " in the ") (widget-create 'custom-manual :tag "Emacs manual" ------------------------------------------------------------ revno: 108027 committer: Eli Zaretskii branch nick: trunk timestamp: Wed 2012-04-25 11:07:57 +0300 message: Force interactive-mode in GDB on MS-Windows. lisp/progmodes/gdb-mi.el (gdb-init-1): Condition Windows-specific settings on 'system-type', not on 'window-system'. On MS-Windows, set interactive-mode on in GDB. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-04-24 21:47:24 +0000 +++ lisp/ChangeLog 2012-04-25 08:07:57 +0000 @@ -1,3 +1,9 @@ +2012-04-25 Eli Zaretskii + + * progmodes/gdb-mi.el (gdb-init-1): Condition Windows-specific + settings on 'system-type', not on 'window-system'. On MS-Windows, + set interactive-mode on in GDB. + 2012-04-24 Stefan Monnier * progmodes/ruby-mode.el: Simplify last change, and cleanup code. === modified file 'lisp/progmodes/gdb-mi.el' --- lisp/progmodes/gdb-mi.el 2012-04-20 08:48:50 +0000 +++ lisp/progmodes/gdb-mi.el 2012-04-25 08:07:57 +0000 @@ -862,8 +862,13 @@ (gdb-clear-inferior-io) (gdb-inferior-io--init-proc (get-process "gdb-inferior")) - (if (eq window-system 'w32) - (gdb-input "-gdb-set new-console off" 'ignore)) + (when (eq system-type 'windows-nt) + ;; Don't create a separate console window for the debuggee. + (gdb-input "-gdb-set new-console off" 'ignore) + ;; Force GDB to behave as if its input and output stream were + ;; connected to a TTY device (since on Windows we use pipes for + ;; communicating with GDB). + (gdb-input "-gdb-set interactive-mode on" 'ignore)) (gdb-input "-gdb-set height 0" 'ignore) (when gdb-non-stop ------------------------------------------------------------ revno: 108026 committer: Michael Albinus branch nick: trunk timestamp: Tue 2012-04-24 23:52:37 +0200 message: Add `notifications-get-capabilities' of notifications.el. diff: === modified file 'etc/NEWS' --- etc/NEWS 2012-04-24 07:09:27 +0000 +++ etc/NEWS 2012-04-24 21:52:37 +0000 @@ -137,6 +137,11 @@ +++ *** There is a new function `dbus-setenv'. ++++ +** notifications.el supports now version 1.2 of the Notifications API. +The function `notifications-get-capabilities' returns the supported +server properties. + ** Obsolete packages: *** mailpost.el ------------------------------------------------------------ Use --include-merges or -n0 to see merged revisions.