diff options
Diffstat (limited to 'lisp')
43 files changed, 875 insertions, 601 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 2402ea0cd1f..81bcb1d033c 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,237 @@ +2013-07-12 Dmitry Gutov <dgutov@yandex.ru> + + * progmodes/ruby-mode.el (ruby-percent-literals-beg-re): + (ruby-syntax-expansion-allowed-p): Support array of symbols, for + Ruby 2.0. + (ruby-font-lock-keywords): Distinguish calls to functions with + module-like names from module references. Highlight character + literals. + +2013-07-12 Sergio Durigan Junior <sergiodj@riseup.net> (tiny change) + + * progmodes/gdb-mi.el (gdb-strip-string-backslash): New function. + (gdb-send): Handle continued commands. (Bug#14847) + +2013-07-12 Juanma Barranquero <lekktu@gmail.com> + + * desktop.el (desktop--v2s): Remove unused local variable. + (desktop-save-buffer): Make defvar-local; adjust docstring. + (desktop-auto-save-timeout, desktop-owner): Use ignore-errors. + (desktop-clear, desktop-save-buffer-p): Use string-match-p. + +2013-07-12 Andreas Schwab <schwab@linux-m68k.org> + + * emacs-lisp/map-ynp.el (map-y-or-n-p): Fix last change. + +2013-07-12 Eli Zaretskii <eliz@gnu.org> + + * simple.el (next-line, previous-line): Document TRY-VSCROLL and ARG. + (Bug#14842) + +2013-07-12 Glenn Morris <rgm@gnu.org> + + * doc-view.el: Require cl-lib at runtime too. + (doc-view-remove-if): Remove. + (doc-view-search-next-match, doc-view-search-previous-match): + Use cl-remove-if. + + * edmacro.el: Require cl-lib at runtime too. + (edmacro-format-keys, edmacro-parse-keys): Use cl-mismatch, cl-subseq. + (edmacro-mismatch, edmacro-subseq): Remove. + + * shadowfile.el: Require cl-lib. + (shadow-remove-if): Remove. + (shadow-set-cluster, shadow-shadows-of-1, shadow-remove-from-todo): + Use cl-remove-if. + + * wid-edit.el: Require cl-lib. + (widget-choose): Use cl-remove-if. + (widget-remove-if): Remove. + + * progmodes/ebrowse.el: Require cl-lib at runtime too. + (ebrowse-delete-if-not): Remove. + (ebrowse-browser-buffer-list, ebrowse-member-buffer-list) + (ebrowse-tree-buffer-list, ebrowse-same-tree-member-buffer-list): + Use cl-delete-if-not. + +2013-07-12 Juanma Barranquero <lekktu@gmail.com> + + * emacs-lisp/cl-macs.el (cl-multiple-value-bind, cl-multiple-value-setq) + (cl-the, cl-declare, cl-defstruct): Fix typos in docstrings. + +2013-07-12 Leo Liu <sdl.web@gmail.com> + + * ido.el (dired-do-copy, dired): Set 'ido property. (Bug#11954) + +2013-07-11 Glenn Morris <rgm@gnu.org> + + * emacs-lisp/edebug.el: Require cl-lib at run-time too. + (edebug-gensym-index, edebug-gensym): + Remove reimplementation of cl-gensym. + (edebug-make-enter-wrapper, edebug-make-form-wrapper): Use cl-gensym. + + * thumbs.el: Require cl-lib at run-time too. + (thumbs-gensym-counter, thumbs-gensym): + Remove reimplementation of cl-gensym. + (thumbs-temp-file): Use cl-gensym. + + * emacs-lisp/ert.el: Require cl-lib at runtime too. + (ert--cl-do-remf, ert--remprop, ert--remove-if-not) + (ert--intersection, ert--set-difference, ert--set-difference-eq) + (ert--union, ert--gensym-counter, ert--gensym-counter) + (ert--coerce-to-vector, ert--remove*, ert--string-position) + (ert--mismatch, ert--subseq): Remove reimplementations of cl funcs. + (ert-make-test-unbound, ert--expand-should-1) + (ert--expand-should, ert--should-error-handle-error) + (should-error, ert--explain-equal-rec) + (ert--plist-difference-explanation, ert-select-tests) + (ert--make-stats, ert--remove-from-list, ert--string-first-line): + Use cl-lib functions rather than reimplementations. + +2013-07-11 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-methods): Extend docstring. + (tramp-connection-timeout): New defcustom. + (tramp-error-with-buffer): Reset timestamp only when appropriate. + (with-tramp-progress-reporter): Simplify. + (tramp-process-actions): Improve messages. + + * net/tramp-gvfs.el (tramp-gvfs-maybe-open-connection): + * net/tramp-sh.el (tramp-maybe-open-connection): + Use `tramp-connection-timeout'. + (tramp-methods) [su, sudo, ksu]: Add method specific timeouts. + (Bug#14808) + +2013-07-11 Leo Liu <sdl.web@gmail.com> + + * ido.el (ido-read-file-name): Conform to the requirements of + read-file-name. (Bug#11861) + (ido-read-directory-name): Conform to the requirements of + read-directory-name. + +2013-07-11 Juanma Barranquero <lekktu@gmail.com> + + * subr.el (delay-warning): New function. + +2013-07-10 Eli Zaretskii <eliz@gnu.org> + + * simple.el (default-line-height): New function. + (line-move-partial, line-move): Use it instead of computing the + line height inline. + (line-move-partial): Always compute ROWH. If the last line is + partially-visible, but its text is completely visible, allow + cursor to enter such a partially-visible line. + +2013-07-10 Michael Albinus <michael.albinus@gmx.de> + + Improve error messages. (Bug#14808) + + * net/tramp.el (tramp-current-connection): New defvar, moved from + tramp-sh.el. + (tramp-message-show-progress-reporter-message): Removed, not + needed anymore. + (tramp-error-with-buffer): Show message in minibuffer. Discard + input before waiting. Reset connection timestamp. + (with-tramp-progress-reporter): Improve messages. + (tramp-process-actions): Use progress reporter. Delete process in + case of error. Improve messages. + + * net/tramp-sh.el (tramp-barf-if-no-shell-prompt): Use + condition-case. Call `tramp-error-with-buffer' with vector and buffer. + (tramp-current-connection): Removed. + (tramp-maybe-open-connection): The car of + `tramp-current-connection' are the first 3 slots of the vector. + +2013-07-10 Teodor Zlatanov <tzz@lifelogs.com> + + * progmodes/cfengine.el (cfengine3-indent-line): Do not indent + inside continued strings. + +2013-07-10 Paul Eggert <eggert@cs.ucla.edu> + + Timestamp fixes for undo (Bug#14824). + * files.el (clear-visited-file-modtime): Move here from fileio.c. + +2013-07-10 Leo Liu <sdl.web@gmail.com> + + * files.el (require-final-newline): Allow safe local value. + (Bug#14834) + +2013-07-09 Leo Liu <sdl.web@gmail.com> + + * ido.el (ido-read-directory-name): Handle fallback. + (ido-read-file-name): Update DIR to ido-current-directory. + (Bug#1516) + (ido-add-virtual-buffers-to-list): Robustify. (Bug#14552) + +2013-07-09 Dmitry Gutov <dgutov@yandex.ru> + + * progmodes/ruby-mode.el (ruby-font-lock-keywords): Remove extra + "autoload". Remove "warn lower camel case" section, previously + commented out. Highlight negation char. Do not highlight the + target in singleton method definitions. + +2013-07-08 Stefan Monnier <monnier@iro.umontreal.ca> + + * faces.el (tty-setup-hook): Declare the hook. + + * emacs-lisp/pcase.el (pcase--split-pred): Add `vars' argument to try + and detect when a guard/pred depends on local vars (bug#14773). + (pcase--u1): Adjust caller. + +2013-07-08 Eli Zaretskii <eliz@gnu.org> + + * simple.el (line-move-partial, line-move): Account for + line-spacing. + (line-move-partial): Avoid setting vscroll when the last + partially-visible line in window is of default height. + +2013-07-08 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/shr.el (shr-map): Reinstate the `u' key binding, since it's + been used a while. + +2013-07-07 Juanma Barranquero <lekktu@gmail.com> + + * subr.el (read-quoted-char): Remove unused local variable `char'. + +2013-07-07 Michael Kifer <kifer@cs.stonybrook.edu> + + * ediff.el (ediff-version): Version update. + (ediff-files-command, ediff3-files-command, ediff-merge-command) + (ediff-merge-with-ancestor-command, ediff-directories-command) + (ediff-directories3-command, ediff-merge-directories-command) + (ediff-merge-directories-with-ancestor-command): New functions. + All are command-line interfaces to ediff: to facilitate calling + Emacs with the appropriate ediff functions invoked. + + * viper-cmd.el (viper-del-forward-char-in-insert): New function. + (viper-save-kill-buffer): Check if buffer is modified. + + * viper.el (viper-version): Version update. + (viper-emacs-state-mode-list): Add egg-status-buffer-mode. + +2013-07-07 Stefan Monnier <monnier@iro.umontreal.ca> + + * faces.el (tty-run-terminal-initialization): Run new tty-setup-hook. + * viper-cmd.el (viper-envelop-ESC-key): Remove function. + (viper-intercept-ESC-key): Simplify. + * viper-keym.el (viper-ESC-key): Make it a constant, don't use kbd. + * viper.el (viper--tty-ESC-filter, viper--lookup-key) + (viper-catch-tty-ESC, viper-uncatch-tty-ESC) + (viper-setup-ESC-to-escape): New functions. + (viper-go-away, viper-set-hooks): Call viper-setup-ESC-to-escape. + (viper-set-hooks): Do not modify flyspell-mode-hook. (Bug#13793) + +2013-07-07 Eli Zaretskii <eliz@gnu.org> + + * simple.el (default-font-height, window-screen-lines): + New functions. + (line-move, line-move-partial): Use them instead of + frame-char-height and window-text-height. This makes scrolling + text smoother when the buffer's default face uses a font that is + different from the frame's default font. + 2013-07-06 Jan Djärv <jan.h.d@swipnet.se> * files.el (write-file): Do not display confirm dialog for NS, @@ -532,7 +766,7 @@ * emacs-lock.el (emacs-lock-mode, emacs-lock--old-mode) (emacs-lock--try-unlocking): Make defvar-local. -2013-06-22 Glenn Morris <rgm@fencepost.gnu.org> +2013-06-22 Glenn Morris <rgm@gnu.org> * play/cookie1.el (cookie-apropos): Minor simplification. @@ -998,7 +1232,7 @@ * net/shr.el (shr-map): Bind [down-mouse-1] to browse URLs. -2013-06-19 Glenn Morris <rgm@fencepost.gnu.org> +2013-06-19 Glenn Morris <rgm@gnu.org> * emacs-lisp/eieio.el (defclass): Make it eval-and-compile once more. diff --git a/lisp/cedet/ChangeLog b/lisp/cedet/ChangeLog index 7a2c5755cc0..705277c97a0 100644 --- a/lisp/cedet/ChangeLog +++ b/lisp/cedet/ChangeLog @@ -2,7 +2,7 @@ * data-debug.el, cedet-idutils.el: Neuter the "Version:" header. -2013-06-19 Glenn Morris <rgm@fencepost.gnu.org> +2013-06-19 Glenn Morris <rgm@gnu.org> * semantic/idle.el (define-semantic-idle-service): No need to use eval-and-compile, progn will do. diff --git a/lisp/desktop.el b/lisp/desktop.el index 2f4c2a8589c..322b95715a2 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -196,9 +196,7 @@ Zero or nil means disable timer-based auto-saving." (integer :tag "Seconds")) :set (lambda (symbol value) (set-default symbol value) - (condition-case nil - (desktop-auto-save-set-timer) - (error nil))) + (ignore-errors (desktop-auto-save-set-timer))) :group 'desktop :version "24.4") @@ -416,9 +414,8 @@ See `desktop-restore-eager'." :version "22.1") ;;;###autoload -(defvar desktop-save-buffer nil +(defvar-local desktop-save-buffer nil "When non-nil, save buffer status in desktop file. -This variable becomes buffer local when set. If the value is a function, it is called by `desktop-save' with argument DESKTOP-DIRNAME to obtain auxiliary information to save in the desktop @@ -430,7 +427,6 @@ When file names are returned, they should be formatted using the call Later, when `desktop-read' evaluates the desktop file, auxiliary information is passed as the argument DESKTOP-BUFFER-MISC to functions in `desktop-buffer-mode-handlers'.") -(make-variable-buffer-local 'desktop-save-buffer) (make-obsolete-variable 'desktop-buffer-modes-to-save 'desktop-save-buffer "22.1") (make-obsolete-variable 'desktop-buffer-misc-functions @@ -582,15 +578,15 @@ Used to detect desktop file conflicts.") "Return the PID of the Emacs process that owns the desktop file in DIRNAME. Return nil if no desktop file found or no Emacs process is using it. DIRNAME omitted or nil means use `desktop-dirname'." - (let (owner) - (and (file-exists-p (desktop-full-lock-name dirname)) - (condition-case nil - (with-temp-buffer - (insert-file-contents-literally (desktop-full-lock-name dirname)) - (goto-char (point-min)) - (setq owner (read (current-buffer))) - (integerp owner)) - (error nil)) + (let (owner + (file (desktop-full-lock-name dirname))) + (and (file-exists-p file) + (ignore-errors + (with-temp-buffer + (insert-file-contents-literally file) + (goto-char (point-min)) + (setq owner (read (current-buffer))) + (integerp owner))) owner))) (defun desktop-claim-lock (&optional dirname) @@ -636,7 +632,7 @@ Furthermore, it clears the variables listed in `desktop-globals-to-clear'." (let ((bufname (buffer-name (car buffers)))) (or (null bufname) - (string-match preserve-regexp bufname) + (string-match-p preserve-regexp bufname) ;; Don't kill buffers made for internal purposes. (and (not (equal bufname "")) (eq (aref bufname 0) ?\s)) (kill-buffer (car buffers)))) @@ -758,8 +754,7 @@ QUOTE may be `may' (value may be quoted), ((consp value) (let ((p value) newlist - use-list* - anynil) + use-list*) (while (consp p) (let ((q.sexp (desktop--v2s (car p)))) (push q.sexp newlist)) @@ -841,17 +836,17 @@ MODE is the major mode. dired-skip) (and (not (and (stringp desktop-buffers-not-to-save) (not filename) - (string-match desktop-buffers-not-to-save bufname))) + (string-match-p desktop-buffers-not-to-save bufname))) (not (memq mode desktop-modes-not-to-save)) ;; FIXME this is broken if desktop-files-not-to-save is nil. (or (and filename (stringp desktop-files-not-to-save) - (not (string-match desktop-files-not-to-save filename))) + (not (string-match-p desktop-files-not-to-save filename))) (and (memq mode '(dired-mode vc-dir-mode)) (with-current-buffer bufname (not (setq dired-skip - (string-match desktop-files-not-to-save - default-directory))))) + (string-match-p desktop-files-not-to-save + default-directory))))) (and (null filename) (null dired-skip) ; bug#5755 (with-current-buffer bufname desktop-save-buffer)))))) diff --git a/lisp/doc-view.el b/lisp/doc-view.el index e4434c3a0d8..10968f7f8dd 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -136,7 +136,7 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) +(require 'cl-lib) (require 'dired) (require 'image-mode) (require 'jka-compr) @@ -698,14 +698,6 @@ It's a subdirectory of `doc-view-cache-directory'." (md5 (current-buffer))))) doc-view-cache-directory))))) -(defun doc-view-remove-if (predicate list) - "Return LIST with all items removed that satisfy PREDICATE." - (let (new-list) - (dolist (item list) - (when (not (funcall predicate item)) - (setq new-list (cons item new-list)))) - (nreverse new-list))) - ;;;###autoload (defun doc-view-mode-p (type) "Return non-nil if document type TYPE is available for `doc-view'. @@ -1488,7 +1480,7 @@ If BACKWARD is non-nil, jump to the previous match." (defun doc-view-search-next-match (arg) "Go to the ARGth next matching page." (interactive "p") - (let* ((next-pages (doc-view-remove-if + (let* ((next-pages (cl-remove-if (lambda (i) (<= (car i) (doc-view-current-page))) doc-view--current-search-matches)) (page (car (nth (1- arg) next-pages)))) @@ -1502,7 +1494,7 @@ If BACKWARD is non-nil, jump to the previous match." (defun doc-view-search-previous-match (arg) "Go to the ARGth previous matching page." (interactive "p") - (let* ((prev-pages (doc-view-remove-if + (let* ((prev-pages (cl-remove-if (lambda (i) (>= (car i) (doc-view-current-page))) doc-view--current-search-matches)) (page (car (nth (1- arg) (nreverse prev-pages))))) diff --git a/lisp/edmacro.el b/lisp/edmacro.el index 6ef2e29dc83..67992d16527 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el @@ -62,9 +62,8 @@ ;; macro in a more concise way that omits the comments. ;;; Code: - -(eval-when-compile (require 'cl-lib)) +(require 'cl-lib) (require 'kmacro) ;;; The user-level commands for editing macros. @@ -444,14 +443,14 @@ doubt, use whitespace." (let* ((prefix (or (and (integerp (aref rest-mac 0)) (memq (aref rest-mac 0) mdigs) - (memq (key-binding (edmacro-subseq rest-mac 0 1)) + (memq (key-binding (cl-subseq rest-mac 0 1)) '(digit-argument negative-argument)) (let ((i 1)) (while (memq (aref rest-mac i) (cdr mdigs)) (cl-incf i)) (and (not (memq (aref rest-mac i) pkeys)) - (prog1 (vconcat "M-" (edmacro-subseq rest-mac 0 i) " ") - (cl-callf edmacro-subseq rest-mac i))))) + (prog1 (vconcat "M-" (cl-subseq rest-mac 0 i) " ") + (cl-callf cl-subseq rest-mac i))))) (and (eq (aref rest-mac 0) ?\C-u) (eq (key-binding [?\C-u]) 'universal-argument) (let ((i 1)) @@ -459,7 +458,7 @@ doubt, use whitespace." (cl-incf i)) (and (not (memq (aref rest-mac i) pkeys)) (prog1 (cl-loop repeat i concat "C-u ") - (cl-callf edmacro-subseq rest-mac i))))) + (cl-callf cl-subseq rest-mac i))))) (and (eq (aref rest-mac 0) ?\C-u) (eq (key-binding [?\C-u]) 'universal-argument) (let ((i 1)) @@ -469,18 +468,18 @@ doubt, use whitespace." '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)) (cl-incf i)) (and (not (memq (aref rest-mac i) pkeys)) - (prog1 (vconcat "C-u " (edmacro-subseq rest-mac 1 i) " ") - (cl-callf edmacro-subseq rest-mac i))))))) + (prog1 (vconcat "C-u " (cl-subseq rest-mac 1 i) " ") + (cl-callf cl-subseq rest-mac i))))))) (bind-len (apply 'max 1 (cl-loop for map in maps for b = (lookup-key map rest-mac) when b collect b))) - (key (edmacro-subseq rest-mac 0 bind-len)) + (key (cl-subseq rest-mac 0 bind-len)) (fkey nil) tlen tkey (bind (or (cl-loop for map in maps for b = (lookup-key map key) thereis (and (not (integerp b)) b)) (and (setq fkey (lookup-key local-function-key-map rest-mac)) - (setq tlen fkey tkey (edmacro-subseq rest-mac 0 tlen) + (setq tlen fkey tkey (cl-subseq rest-mac 0 tlen) fkey (lookup-key local-function-key-map tkey)) (cl-loop for map in maps for b = (lookup-key map fkey) @@ -507,7 +506,7 @@ doubt, use whitespace." (> first 32) (<= first maxkey) (/= first 92) (progn (if (> text 30) (setq text 30)) - (setq desc (concat (edmacro-subseq rest-mac 0 text))) + (setq desc (concat (cl-subseq rest-mac 0 text))) (when (string-match "^[ACHMsS]-." desc) (setq text 2) (cl-callf substring desc 0 2)) @@ -524,7 +523,7 @@ doubt, use whitespace." (> text bind-len) (memq (aref rest-mac text) '(return 13)) (progn - (setq desc (concat (edmacro-subseq rest-mac bind-len text))) + (setq desc (concat (cl-subseq rest-mac bind-len text))) (commandp (intern-soft desc)))) (if (commandp (intern-soft desc)) (setq bind desc)) (setq desc (format "<<%s>>" desc)) @@ -562,14 +561,14 @@ doubt, use whitespace." (setq desc (concat (edmacro-sanitize-for-string prefix) desc))) (unless (string-match " " desc) (let ((times 1) (pos bind-len)) - (while (not (edmacro-mismatch rest-mac rest-mac + (while (not (cl-mismatch rest-mac rest-mac 0 bind-len pos (+ bind-len pos))) (cl-incf times) (cl-incf pos bind-len)) (when (> times 1) (setq desc (format "%d*%s" times desc)) (setq bind-len (* bind-len times))))) - (setq rest-mac (edmacro-subseq rest-mac bind-len)) + (setq rest-mac (cl-subseq rest-mac bind-len)) (if verbose (progn (unless (equal res "") (cl-callf concat res "\n")) @@ -590,50 +589,6 @@ doubt, use whitespace." (cl-incf len (length desc))))) res)) -(defun edmacro-mismatch (cl-seq1 cl-seq2 cl-start1 cl-end1 cl-start2 cl-end2) - "Compare SEQ1 with SEQ2, return index of first mismatching element. -Return nil if the sequences match. If one sequence is a prefix of the -other, the return value indicates the end of the shorted sequence. -\n(fn SEQ1 SEQ2 START1 END1 START2 END2)" - (or cl-end1 (setq cl-end1 (length cl-seq1))) - (or cl-end2 (setq cl-end2 (length cl-seq2))) - (let ((cl-p1 (and (listp cl-seq1) (nthcdr cl-start1 cl-seq1))) - (cl-p2 (and (listp cl-seq2) (nthcdr cl-start2 cl-seq2)))) - (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2) - (eql (if cl-p1 (car cl-p1) - (aref cl-seq1 cl-start1)) - (if cl-p2 (car cl-p2) - (aref cl-seq2 cl-start2)))) - (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2) - cl-start1 (1+ cl-start1) cl-start2 (1+ cl-start2))) - (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2)) - cl-start1))) - -(defun edmacro-subseq (seq start &optional end) - "Return the subsequence of SEQ from START to END. -If END is omitted, it defaults to the length of the sequence. -If START or END is negative, it counts from the end." - (if (stringp seq) (substring seq start end) - (let (len) - (and end (< end 0) (setq end (+ end (setq len (length seq))))) - (if (< start 0) (setq start (+ start (or len (setq len (length seq)))))) - (cond ((listp seq) - (if (> start 0) (setq seq (nthcdr start seq))) - (if end - (let ((res nil)) - (while (>= (setq end (1- end)) start) - (push (pop seq) res)) - (nreverse res)) - (copy-sequence seq))) - (t - (or end (setq end (or len (length seq)))) - (let ((res (make-vector (max (- end start) 0) nil)) - (i 0)) - (while (< start end) - (aset res i (aref seq start)) - (setq i (1+ i) start (1+ start))) - res)))))) - (defun edmacro-sanitize-for-string (seq) "Convert a key sequence vector SEQ into a string. The string represents the same events; Meta is indicated by bit 7. @@ -760,7 +715,7 @@ This function assumes that the events can be stored in a string." (eq (aref res 1) ?\() (eq (aref res (- (length res) 2)) ?\C-x) (eq (aref res (- (length res) 1)) ?\))) - (setq res (edmacro-subseq res 2 -2))) + (setq res (cl-subseq res 2 -2))) (if (and (not need-vector) (cl-loop for ch across res always (and (characterp ch) diff --git a/lisp/emacs-lisp/.gitignore b/lisp/emacs-lisp/.gitignore deleted file mode 100644 index 133e79e817a..00000000000 --- a/lisp/emacs-lisp/.gitignore +++ /dev/null @@ -1,2 +0,0 @@ -!*-loaddefs.el - diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 3cf744f1245..c47c9b61030 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -1957,7 +1957,7 @@ by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...). "Collect multiple return values. FORM must return a list; the BODY is then executed with the first N elements of this list bound (`let'-style) to each of the symbols SYM in turn. This -is analogous to the Common Lisp `cl-multiple-value-bind' macro, using lists to +is analogous to the Common Lisp `multiple-value-bind' macro, using lists to simulate true multiple return values. For compatibility, (cl-values A B C) is a synonym for (list A B C). @@ -1975,7 +1975,7 @@ a synonym for (list A B C). "Collect multiple return values. FORM must return a list; the first N elements of this list are stored in each of the symbols SYM in turn. This is analogous to the Common Lisp -`cl-multiple-value-setq' macro, using lists to simulate true multiple return +`multiple-value-setq' macro, using lists to simulate true multiple return values. For compatibility, (cl-values A B C) is a synonym for (list A B C). \(fn (SYM...) FORM)" @@ -2002,7 +2002,7 @@ values. For compatibility, (cl-values A B C) is a synonym for (list A B C). (cons 'progn body)) ;;;###autoload (defmacro cl-the (_type form) - "At present this ignores _TYPE and is simply equivalent to FORM." + "At present this ignores TYPE and is simply equivalent to FORM." (declare (indent 1) (debug (cl-type-spec form))) form) @@ -2059,7 +2059,7 @@ values. For compatibility, (cl-values A B C) is a synonym for (list A B C). "Declare SPECS about the current function while compiling. For instance - \(cl-declare (warn 0)) + (cl-declare (warn 0)) will turn off byte-compile warnings in the function. See Info node `(cl)Declarations' for details." @@ -2279,8 +2279,8 @@ KEYWORD can be one of :conc-name, :constructor, :copier, :predicate, Each SLOT may instead take the form (SNAME SDEFAULT SOPTIONS...), where SDEFAULT is the default value of that slot and SOPTIONS are keyword-value pairs for that slot. -Currently, only one keyword is supported, `:read-only'. If this has a non-nil -value, that slot cannot be set via `setf'. +Currently, only one keyword is supported, `:read-only'. If this has a +non-nil value, that slot cannot be set via `setf'. \(fn NAME SLOTS...)" (declare (doc-string 2) (indent 1) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 319af588eac..36c72f3a3bd 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -53,7 +53,7 @@ ;;; Code: (require 'macroexp) -(eval-when-compile (require 'cl-lib)) +(require 'cl-lib) (eval-when-compile (require 'pcase)) ;;; Options @@ -263,26 +263,6 @@ An extant spec symbol is a symbol that is not a function and has a ;;; Utilities -;; Define edebug-gensym - from old cl.el -(defvar edebug-gensym-index 0 - "Integer used by `edebug-gensym' to produce new names.") - -(defun edebug-gensym (&optional prefix) - "Generate a fresh uninterned symbol. -There is an optional argument, PREFIX. PREFIX is the string -that begins the new name. Most people take just the default, -except when debugging needs suggest otherwise." - (if (null prefix) - (setq prefix "G")) - (let ((newsymbol nil) - (newname "")) - (while (not newsymbol) - (setq newname (concat prefix (int-to-string edebug-gensym-index))) - (setq edebug-gensym-index (+ edebug-gensym-index 1)) - (if (not (intern-soft newname)) - (setq newsymbol (make-symbol newname)))) - newsymbol)) - (defun edebug-lambda-list-keywordp (object) "Return t if OBJECT is a lambda list keyword. A lambda list keyword is a symbol that starts with `&'." @@ -1186,7 +1166,7 @@ Maybe clear the markers and delete the symbol's edebug property?" ;; Uses the dynamically bound vars edebug-def-name and edebug-def-args. ;; Do this after parsing since that may find a name. (setq edebug-def-name - (or edebug-def-name edebug-old-def-name (edebug-gensym "edebug-anon"))) + (or edebug-def-name edebug-old-def-name (cl-gensym "edebug-anon"))) `(edebug-enter (quote ,edebug-def-name) ,(if edebug-inside-func @@ -1299,7 +1279,7 @@ expressions; a `progn' form will be returned enclosing these forms." ;; Set the name here if it was not set by edebug-make-enter-wrapper. (setq edebug-def-name - (or edebug-def-name edebug-old-def-name (edebug-gensym "edebug-anon"))) + (or edebug-def-name edebug-old-def-name (cl-gensym "edebug-anon"))) ;; Add this def as a dependent of containing def. Buggy. '(if (and edebug-containing-def-name diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 656cb0a6a14..1f5edefea08 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -54,7 +54,7 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) +(require 'cl-lib) (require 'button) (require 'debug) (require 'easymenu) @@ -87,127 +87,6 @@ ;;; Copies/reimplementations of cl functions. -(defun ert--cl-do-remf (plist tag) - "Copy of `cl-do-remf'. Modify PLIST by removing TAG." - (let ((p (cdr plist))) - (while (and (cdr p) (not (eq (car (cdr p)) tag))) (setq p (cdr (cdr p)))) - (and (cdr p) (progn (setcdr p (cdr (cdr (cdr p)))) t)))) - -(defun ert--remprop (sym tag) - "Copy of `cl-remprop'. Modify SYM's plist by removing TAG." - (let ((plist (symbol-plist sym))) - (if (and plist (eq tag (car plist))) - (progn (setplist sym (cdr (cdr plist))) t) - (ert--cl-do-remf plist tag)))) - -(defun ert--remove-if-not (ert-pred ert-list) - "A reimplementation of `remove-if-not'. - -ERT-PRED is a predicate, ERT-LIST is the input list." - (cl-loop for ert-x in ert-list - if (funcall ert-pred ert-x) - collect ert-x)) - -(defun ert--intersection (a b) - "A reimplementation of `intersection'. Intersect the sets A and B. - -Elements are compared using `eql'." - (cl-loop for x in a - if (memql x b) - collect x)) - -(defun ert--set-difference (a b) - "A reimplementation of `set-difference'. Subtract the set B from the set A. - -Elements are compared using `eql'." - (cl-loop for x in a - unless (memql x b) - collect x)) - -(defun ert--set-difference-eq (a b) - "A reimplementation of `set-difference'. Subtract the set B from the set A. - -Elements are compared using `eq'." - (cl-loop for x in a - unless (memq x b) - collect x)) - -(defun ert--union (a b) - "A reimplementation of `union'. Compute the union of the sets A and B. - -Elements are compared using `eql'." - (append a (ert--set-difference b a))) - -(eval-and-compile - (defvar ert--gensym-counter 0)) - -(eval-and-compile - (defun ert--gensym (&optional prefix) - "Only allows string PREFIX, not compatible with CL." - (unless prefix (setq prefix "G")) - (make-symbol (format "%s%s" - prefix - (prog1 ert--gensym-counter - (cl-incf ert--gensym-counter)))))) - -(defun ert--coerce-to-vector (x) - "Coerce X to a vector." - (when (char-table-p x) (error "Not supported")) - (if (vectorp x) - x - (vconcat x))) - -(cl-defun ert--remove* (x list &key key test) - "Does not support all the keywords of remove*." - (unless key (setq key #'identity)) - (unless test (setq test #'eql)) - (cl-loop for y in list - unless (funcall test x (funcall key y)) - collect y)) - -(defun ert--string-position (c s) - "Return the position of the first occurrence of C in S, or nil if none." - (cl-loop for i from 0 - for x across s - when (eql x c) return i)) - -(defun ert--mismatch (a b) - "Return index of first element that differs between A and B. - -Like `mismatch'. Uses `equal' for comparison." - (cond ((or (listp a) (listp b)) - (ert--mismatch (ert--coerce-to-vector a) - (ert--coerce-to-vector b))) - ((> (length a) (length b)) - (ert--mismatch b a)) - (t - (let ((la (length a)) - (lb (length b))) - (cl-assert (arrayp a) t) - (cl-assert (arrayp b) t) - (cl-assert (<= la lb) t) - (cl-loop for i below la - when (not (equal (aref a i) (aref b i))) return i - finally (cl-return (if (/= la lb) - la - (cl-assert (equal a b) t) - nil))))))) - -(defun ert--subseq (seq start &optional end) - "Return a subsequence of SEQ from START to END." - (when (char-table-p seq) (error "Not supported")) - (let ((vector (substring (ert--coerce-to-vector seq) start end))) - (cl-etypecase seq - (vector vector) - (string (concat vector)) - (list (append vector nil)) - (bool-vector (cl-loop with result - = (make-bool-vector (length vector) nil) - for i below (length vector) do - (setf (aref result i) (aref vector i)) - finally (cl-return result))) - (char-table (cl-assert nil))))) - (defun ert-equal-including-properties (a b) "Return t if A and B have similar structure and contents. @@ -258,7 +137,7 @@ Emacs bug 6581 at URL `http://debbugs.gnu.org/cgi/bugreport.cgi?bug=6581'." (defun ert-make-test-unbound (symbol) "Make SYMBOL name no test. Return SYMBOL." - (ert--remprop symbol 'ert--test) + (cl-remprop symbol 'ert--test) symbol) (defun ert--parse-keys-and-body (keys-and-body) @@ -396,8 +275,8 @@ DATA is displayed to the user and should state the reason of the failure." cl-macro-environment))))) (cond ((or (atom form) (ert--special-operator-p (car form))) - (let ((value (ert--gensym "value-"))) - `(let ((,value (ert--gensym "ert-form-evaluation-aborted-"))) + (let ((value (cl-gensym "value-"))) + `(let ((,value (cl-gensym "ert-form-evaluation-aborted-"))) ,(funcall inner-expander `(setq ,value ,form) `(list ',whole :form ',form :value ,value) @@ -410,10 +289,10 @@ DATA is displayed to the user and should state the reason of the failure." (and (consp fn-name) (eql (car fn-name) 'lambda) (listp (cdr fn-name))))) - (let ((fn (ert--gensym "fn-")) - (args (ert--gensym "args-")) - (value (ert--gensym "value-")) - (default-value (ert--gensym "ert-form-evaluation-aborted-"))) + (let ((fn (cl-gensym "fn-")) + (args (cl-gensym "args-")) + (value (cl-gensym "value-")) + (default-value (cl-gensym "ert-form-evaluation-aborted-"))) `(let ((,fn (function ,fn-name)) (,args (list ,@arg-forms))) (let ((,value ',default-value)) @@ -450,7 +329,7 @@ FORM-DESCRIPTION-FORM before it has called INNER-FORM." (ert--expand-should-1 whole form (lambda (inner-form form-description-form value-var) - (let ((form-description (ert--gensym "form-description-"))) + (let ((form-description (cl-gensym "form-description-"))) `(let (,form-description) ,(funcall inner-expander `(unwind-protect @@ -491,7 +370,7 @@ and aborts the current test as failed if it doesn't." (list type) (symbol (list type))))) (cl-assert signaled-conditions) - (unless (ert--intersection signaled-conditions handled-conditions) + (unless (cl-intersection signaled-conditions handled-conditions) (ert-fail (append (funcall form-description-fn) (list @@ -528,8 +407,8 @@ failed." `(should-error ,form ,@keys) form (lambda (inner-form form-description-form value-var) - (let ((errorp (ert--gensym "errorp")) - (form-description-fn (ert--gensym "form-description-fn-"))) + (let ((errorp (cl-gensym "errorp")) + (form-description-fn (cl-gensym "form-description-fn-"))) `(let ((,errorp nil) (,form-description-fn (lambda () ,form-description-form))) (condition-case -condition- @@ -591,7 +470,7 @@ Returns nil if they are." `(proper-lists-of-different-length ,(length a) ,(length b) ,a ,b first-mismatch-at - ,(ert--mismatch a b)) + ,(cl-mismatch a b :test 'equal)) (cl-loop for i from 0 for ai in a for bi in b @@ -611,7 +490,7 @@ Returns nil if they are." ,a ,b ,@(unless (char-table-p a) `(first-mismatch-at - ,(ert--mismatch a b)))) + ,(cl-mismatch a b :test 'equal)))) (cl-loop for i from 0 for ai across a for bi across b @@ -656,8 +535,8 @@ key/value pairs in each list does not matter." ;; work, so let's punt on it for now. (let* ((keys-a (ert--significant-plist-keys a)) (keys-b (ert--significant-plist-keys b)) - (keys-in-a-not-in-b (ert--set-difference-eq keys-a keys-b)) - (keys-in-b-not-in-a (ert--set-difference-eq keys-b keys-a))) + (keys-in-a-not-in-b (cl-set-difference keys-a keys-b :test 'eq)) + (keys-in-b-not-in-a (cl-set-difference keys-b keys-a :test 'eq))) (cl-flet ((explain-with-key (key) (let ((value-a (plist-get a key)) (value-b (plist-get b key))) @@ -1090,7 +969,7 @@ contained in UNIVERSE." (cl-etypecase universe ((member t) (mapcar #'ert-get-test (apropos-internal selector #'ert-test-boundp))) - (list (ert--remove-if-not (lambda (test) + (list (cl-remove-if-not (lambda (test) (and (ert-test-name test) (string-match selector (ert-test-name test)))) @@ -1123,13 +1002,13 @@ contained in UNIVERSE." (not (cl-assert (eql (length operands) 1)) (let ((all-tests (ert-select-tests 't universe))) - (ert--set-difference all-tests + (cl-set-difference all-tests (ert-select-tests (car operands) all-tests)))) (or (cl-case (length operands) (0 (ert-select-tests 'nil universe)) - (t (ert--union (ert-select-tests (car operands) universe) + (t (cl-union (ert-select-tests (car operands) universe) (ert-select-tests `(or ,@(cdr operands)) universe))))) (tag @@ -1141,7 +1020,7 @@ contained in UNIVERSE." universe))) (satisfies (cl-assert (eql (length operands) 1)) - (ert--remove-if-not (car operands) + (cl-remove-if-not (car operands) (ert-select-tests 't universe)))))))) (defun ert--insert-human-readable-selector (selector) @@ -1285,7 +1164,7 @@ Also changes the counters in STATS to match." "Create a new `ert--stats' object for running TESTS. SELECTOR is the selector that was used to select TESTS." - (setq tests (ert--coerce-to-vector tests)) + (setq tests (cl-coerce tests 'vector)) (let ((map (make-hash-table :size (length tests)))) (cl-loop for i from 0 for test across tests @@ -1548,10 +1427,10 @@ This can be used as an inverse of `add-to-list'." (unless key (setq key #'identity)) (unless test (setq test #'equal)) (setf (symbol-value list-var) - (ert--remove* element - (symbol-value list-var) - :key key - :test test))) + (cl-remove element + (symbol-value list-var) + :key key + :test test))) ;;; Some basic interactive functions. @@ -1810,7 +1689,7 @@ BEGIN and END specify a region in the current buffer." "Return the first line of S, or S if it contains no newlines. The return value does not include the line terminator." - (substring s 0 (ert--string-position ?\n s))) + (substring s 0 (cl-position ?\n s))) (defun ert-face-for-test-result (expectedp) "Return a face that shows whether a test result was expected or unexpected. diff --git a/lisp/emacs-lisp/map-ynp.el b/lisp/emacs-lisp/map-ynp.el index 1919d47687b..56bfe04f9ce 100644 --- a/lisp/emacs-lisp/map-ynp.el +++ b/lisp/emacs-lisp/map-ynp.el @@ -131,8 +131,9 @@ Returns the number of actions taken." (unwind-protect (progn (if (stringp prompter) - (setq prompter (lambda (object) - (format prompter object)))) + (setq prompter (let ((prompter prompter)) + (lambda (object) + (format prompter object))))) (while (funcall next) (setq prompt (funcall prompter elt)) (cond ((stringp prompt) diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index e000c343721..511f1480099 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -482,12 +482,19 @@ MATCH is the pattern that needs to be matched, of the form: all)) '(:pcase--succeed . nil)))) -(defun pcase--split-pred (upat pat) - ;; FIXME: For predicates like (pred (> a)), two such predicates may - ;; actually refer to different variables `a'. +(defun pcase--split-pred (vars upat pat) (let (test) (cond - ((equal upat pat) '(:pcase--succeed . :pcase--fail)) + ((and (equal upat pat) + ;; For predicates like (pred (> a)), two such predicates may + ;; actually refer to different variables `a'. + (or (and (eq 'pred (car upat)) (symbolp (cadr upat))) + ;; FIXME: `vars' gives us the environment in which `upat' will + ;; run, but we don't have the environment in which `pat' will + ;; run, so we can't do a reliable verification. But let's try + ;; and catch at least the easy cases such as (bug#14773). + (not (pcase--fgrep (mapcar #'car vars) (cadr upat))))) + '(:pcase--succeed . :pcase--fail)) ((and (eq 'pred (car upat)) (eq 'pred (car-safe pat)) (or (member (cons (cadr upat) (cadr pat)) @@ -589,7 +596,7 @@ Otherwise, it defers to REST which is a list of branches of the form (if (eq (car upat) 'pred) (pcase--mark-used sym)) (let* ((splitrest (pcase--split-rest - sym (lambda (pat) (pcase--split-pred upat pat)) rest)) + sym (lambda (pat) (pcase--split-pred vars upat pat)) rest)) (then-rest (car splitrest)) (else-rest (cdr splitrest))) (pcase--if (if (and (eq (car upat) 'pred) (symbolp (cadr upat))) diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el index e7b371365e4..c39d896f3d3 100644 --- a/lisp/emulation/viper-cmd.el +++ b/lisp/emulation/viper-cmd.el @@ -996,93 +996,7 @@ as a Meta key and any number of multiple escapes are allowed." (suspend-emacs)) (viper-change-state-to-emacs))) - -;; Intercept ESC sequences on dumb terminals. -;; Based on the idea contributed by Marcelino Veiga Tuimil <mveiga@dit.upm.es> - -;; Check if last key was ESC and if so try to reread it as a function key. -;; But only if there are characters to read during a very short time. -;; Returns the last event, if any. -(defun viper-envelop-ESC-key () - (let ((event last-input-event) - (keyseq [nil]) - (inhibit-quit t)) - (if (viper-ESC-event-p event) - (progn - ;; Some versions of Emacs (eg., 22.50.8 (?)) have a bug, which makes - ;; even a single ESC into a fast keyseq. To guard against this, we - ;; added a check if there are other events as well. Keep the next - ;; line for the next time the bug reappears, so that will remember to - ;; report it. - ;;(if (and (viper-fast-keysequence-p) unread-command-events) - (if (viper-fast-keysequence-p) ;; for Emacsen without the above bug - (progn - (let (minor-mode-map-alist emulation-mode-map-alists) - (viper-set-unread-command-events event) - (setq keyseq (read-key-sequence nil 'continue-echo)) - ) ; let - ;; If keyseq translates into something that still has ESC - ;; at the beginning, separate ESC from the rest of the seq. - ;; In XEmacs we check for events that are keypress meta-key - ;; and convert them into [escape key] - ;; - ;; This is needed for the following reason: - ;; If ESC is the first symbol, we interpret it as if the - ;; user typed ESC and then quickly some other symbols. - ;; If ESC is not the first one, then the key sequence - ;; entered was apparently translated into a function key or - ;; something (e.g., one may have - ;; (define-key function-key-map "\e[192z" [f11]) - ;; which would translate the escape-sequence generated by - ;; f11 in an xterm window into the symbolic key f11. - ;; - ;; If `first-key' is not an ESC event, we make it into the - ;; last-command-event in order to pretend that this key was - ;; pressed. This is needed to allow arrow keys to be bound to - ;; macros. Otherwise, viper-exec-mapped-kbd-macro will think - ;; that the last event was ESC and so it'll execute whatever is - ;; bound to ESC. (Viper macros can't be bound to - ;; ESC-sequences). - (let* ((first-key (elt keyseq 0)) - (key-mod (event-modifiers first-key))) - (cond ((and (viper-ESC-event-p first-key) - (not (viper-translate-all-ESC-keysequences))) - ;; put keys following ESC on the unread list - ;; and return ESC as the key-sequence - (viper-set-unread-command-events (viper-subseq keyseq 1)) - (setq last-input-event event - keyseq (if (featurep 'emacs) - "\e" - (vector (character-to-event ?\e))))) - ((and (featurep 'xemacs) - (key-press-event-p first-key) - (equal '(meta) key-mod)) - (viper-set-unread-command-events - (vconcat (vector - (character-to-event (event-key first-key))) - (viper-subseq keyseq 1))) - (setq last-input-event event - keyseq (vector (character-to-event ?\e)))) - ((eventp first-key) - (setq last-command-event - (viper-copy-event first-key))) - )) - ) ; end progn - - ;; this is escape event with nothing after it - ;; put in unread-command-event and then re-read - (viper-set-unread-command-events event) - (setq keyseq (read-key-sequence nil)) - )) - ;; not an escape event - (setq keyseq (vector event))) - keyseq)) - - - ;; Listen to ESC key. -;; If a sequence of keys starting with ESC is issued with very short delays, -;; interpret these keys in Emacs mode, so ESC won't be interpreted as a Vi key. (defun viper-intercept-ESC-key () "Function that implements ESC key in Viper emulation of Vi." (interactive) @@ -1090,13 +1004,7 @@ as a Meta key and any number of multiple escapes are allowed." ;; minor-mode map(s) have been temporarily disabled so the ESC ;; binding to viper-intercept-ESC-key doesn't hide the binding we're ;; looking for (Bug#9146): - (let* ((event (viper-envelop-ESC-key)) - (cmd (cond ((equal event viper-ESC-key) - 'viper-intercept-ESC-key) - ((let ((emulation-mode-map-alists nil)) - (key-binding event))) - (t - (error "Viper bell"))))) + (let* ((cmd 'viper-intercept-ESC-key)) ;; call the actual function to execute ESC (if no other symbols followed) ;; or the key bound to the ESC sequence (if the sequence was issued @@ -4289,6 +4197,11 @@ cursor move past the beginning of line." (t (backward-char 1)))) +(defun viper-del-forward-char-in-insert () + "Delete 1 char forward if in insert or replace state." + (interactive) + ;; don't put on kill ring + (delete-char 1 nil)) ;; join lines. @@ -4947,7 +4860,7 @@ Please, specify your level now: ") (interactive) (if (< viper-expert-level 2) (save-buffers-kill-emacs) - (save-buffer) + (if (buffer-modified-p) (save-buffer)) (kill-buffer (current-buffer)))) diff --git a/lisp/emulation/viper-keym.el b/lisp/emulation/viper-keym.el index 0d9d300ab1a..d33b5f4ed58 100644 --- a/lisp/emulation/viper-keym.el +++ b/lisp/emulation/viper-keym.el @@ -192,7 +192,7 @@ Enter as a sexp. Examples: \"\\C-z\", [(control ?z)]." :type 'string :group 'viper) -(defvar viper-ESC-key (kbd "ESC") +(defconst viper-ESC-key [escape] "Key used to ESC.") diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el index 7f432cdc143..266af1abf2b 100644 --- a/lisp/emulation/viper.el +++ b/lisp/emulation/viper.el @@ -14,7 +14,7 @@ ;; filed in the Emacs bug reporting system against this file, a copy ;; of the bug report be sent to the maintainer's email address. -(defconst viper-version "3.14.1 of August 15, 2009" +(defconst viper-version "3.14.2 of July 4, 2013" "The current version of Viper") ;; This file is part of GNU Emacs. @@ -411,6 +411,7 @@ widget." dired-mode efs-mode tar-mode + egg-status-buffer-mode browse-kill-ring-mode recentf-mode @@ -660,7 +661,7 @@ user customization, unrelated to Viper. For instance, if the user advised undone. It also can't undo some Viper settings." (interactive) - + (viper-setup-ESC-to-escape nil) ;; restore non-viper vars (setq-default next-line-add-newlines @@ -825,6 +826,58 @@ It also can't undo some Viper settings." (add-hook 'viper-post-command-hooks 'set-viper-state-in-major-mode t)) +;;; Handling of tty's ESC event + +;; On a tty, an ESC event can either be the user hitting the escape key, or +;; some element of a byte sequence used to encode for example cursor keys. +;; So we try to recognize those events that correspond to the escape key and +;; turn them into `escape' events (same as used under GUIs). The heuristic we +;; use to distinguish the two cases is based, as usual, on a timeout, and on +;; the fact that the special ESC=>escape mapping only takes place if the whole +;; last key-sequence so far is just [?\e], i.e. either we're still in +;; read-key-sequence, or the last read-key-sequence only read [?\e], which +;; should ideally never happen because it should have been mapped to [escape]. + +(defun viper--tty-ESC-filter (map) + (if (and (equal (this-single-command-keys) [?\e]) + (sit-for (/ viper-fast-keyseq-timeout 1000))) + [escape] map)) + +(defun viper--lookup-key (map key) + "Kind of like `lookup-key'. +Two differences: +- KEY is a single key, not a sequence. +- the result is the \"raw\" binding, so it can be a `menu-item', rather than the + binding contained in that menu item." + (catch 'found + (map-keymap (lambda (k b) (if (equal key k) (throw 'found b))) map))) + +(defun viper-catch-tty-ESC () + "Setup key mappings of current terminal to turn a tty's ESC into `escape'." + (when (memq (terminal-live-p (frame-terminal)) '(t pc)) + (let ((esc-binding (viper-uncatch-tty-ESC))) + (define-key input-decode-map + [?\e] `(menu-item "" ,esc-binding :filter viper--tty-ESC-filter))))) + +(defun viper-uncatch-tty-ESC () + "Don't hack ESC into `escape' any more." + (let ((b (viper--lookup-key input-decode-map ?\e))) + (and (eq 'menu-item (car-safe b)) + (eq 'viper--tty-ESC-filter (nth 4 b)) + (define-key input-decode-map [?\e] (setq b (nth 2 b)))) + b)) + +(defun viper-setup-ESC-to-escape (enable) + (if enable + (add-hook 'tty-setup-hook 'viper-catch-tty-ESC) + (remove-hook 'tty-setup-hook 'viper-catch-tty-ESC)) + (let ((seen ())) + (dolist (frame (frame-list)) + (let ((terminal (frame-terminal frame))) + (unless (memq terminal seen) + (push terminal seen) + (with-selected-frame frame + (if enable (viper-catch-tty-ESC) (viper-uncatch-tty-ESC)))))))) ;; This sets major mode hooks to make them come up in vi-state. (defun viper-set-hooks () @@ -837,6 +890,8 @@ It also can't undo some Viper settings." (if (eq (default-value 'major-mode) 'fundamental-mode) (setq-default major-mode 'viper-mode)) + (viper-setup-ESC-to-escape t) + (add-hook 'change-major-mode-hook 'viper-major-mode-change-sentinel) (add-hook 'find-file-hooks 'set-viper-state-in-major-mode) @@ -847,13 +902,6 @@ It also can't undo some Viper settings." (defvar emerge-startup-hook) (add-hook 'emerge-startup-hook 'viper-change-state-to-emacs) - ;; Zap bad bindings in flyspell-mouse-map, which prevent ESC from working - ;; over misspelled words (due to the overlay keymaps) - (defvar flyspell-mode-hook) - (defvar flyspell-mouse-map) - (add-hook 'flyspell-mode-hook - (lambda () - (define-key flyspell-mouse-map viper-ESC-key nil))) ;; if viper is started from .emacs, it might be impossible to get certain ;; info about the display and windows until emacs initialization is complete ;; So do it via the window-setup-hook diff --git a/lisp/faces.el b/lisp/faces.el index 0a3f0551325..9a34aec2549 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -2097,6 +2097,10 @@ the above example." nil)))) type) +(defvar tty-setup-hook nil + "Hook run after running the initialization function of a new text terminal. +This can be used to fine tune the `input-decode-map', for example.") + (defun tty-run-terminal-initialization (frame &optional type) "Run the special initialization code for the terminal type of FRAME. The optional TYPE parameter may be used to override the autodetected @@ -2122,7 +2126,8 @@ terminal type to a different value." type) (when (fboundp term-init-func) (funcall term-init-func)) - (set-terminal-parameter frame 'terminal-initted term-init-func))))) + (set-terminal-parameter frame 'terminal-initted term-init-func) + (run-hooks 'tty-setup-hook))))) ;; Called from C function init_display to initialize faces of the ;; dumped terminal frame on startup. diff --git a/lisp/files.el b/lisp/files.el index 9b56dfa9693..ff4ccec2279 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -316,6 +316,7 @@ A value of nil means don't add newlines. Certain major modes set this locally to the value obtained from `mode-require-final-newline'." + :safe #'symbolp :type '(choice (const :tag "When visiting" visit) (const :tag "When saving" t) (const :tag "When visiting or saving" visit-save) @@ -4916,6 +4917,11 @@ change the additional actions you can take on files." (length autosaved-buffers) (mapconcat 'identity autosaved-buffers ", ")))))))) +(defun clear-visited-file-modtime () + "Clear out records of last mod time of visited file. +Next attempt to save will certainly not complain of a discrepancy." + (set-visited-file-modtime 0)) + (defun not-modified (&optional arg) "Mark current buffer as unmodified, not needing to be saved. With prefix ARG, mark buffer as modified, so \\[save-buffer] will save. diff --git a/lisp/filesets.el b/lisp/filesets.el index 978512bd3a4..fbf28dbecbc 100644 --- a/lisp/filesets.el +++ b/lisp/filesets.el @@ -149,7 +149,7 @@ is loaded before custom.el, set this variable to t.") (defun filesets-filter-list (lst cond-fn) "Remove all elements not conforming to COND-FN from list LST. COND-FN takes one argument: the current element." -; (remove* 'dummy lst :test (lambda (dummy elt) +; (cl-remove 'dummy lst :test (lambda (dummy elt) ; (not (funcall cond-fn elt))))) (let ((rv nil)) (dolist (elt lst rv) @@ -175,7 +175,7 @@ Like `some', return the first value of FSS-PRED that is non-nil." (let ((fss-rv (funcall fss-pred fss-this))) (when fss-rv (throw 'exit fss-rv)))))) -;(fset 'filesets-some 'some) ;; or use the cl function +;(fset 'filesets-some 'cl-some) ;; or use the cl function (defun filesets-member (fsm-item fsm-lst &rest fsm-keys) "Find the first occurrence of FSM-ITEM in FSM-LST. @@ -186,7 +186,7 @@ key is supported." (filesets-ormap (lambda (fsm-this) (funcall fsm-test fsm-item fsm-this)) fsm-lst))) -;(fset 'filesets-member 'member*) ;; or use the cl function +;(fset 'filesets-member 'cl-member) ;; or use the cl function (defun filesets-sublist (lst beg &optional end) "Get the sublist of LST from BEG to END - 1." diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 34eb28f0965..006b415b180 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,47 @@ +2013-07-10 David Engster <deng@randomsample.de> + + * gnus-start.el (gnus-clean-old-newsrc): Always remove 'unexist' marks + if `gnus-newsrc-file-version' does not match `gnus-version'. This + fixes a bug in Emacs trunk where the 'unexist' marks were always + removed at startup because "Gnus v5.13" was considered smaller than "Ma + Gnus v0.03". + +2013-07-10 Tassilo Horn <tsdh@gnu.org> + + * gnus.el (gnus-summary-line-format): Reference + `gnus-user-date-format-alist' for the &user-date; format, not + `gnus-summary-user-date-format-alist'. + +2013-07-08 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * nnml.el (nnml-request-compact-group): Don't bug out if we can't + delete files (bug#13481). + +2013-07-08 Tassilo Horn <tsdh@gnu.org> + + * gnus-registry.el (gnus-registry-remove-extra-data): New function. + +2013-07-06 Lars Ingebrigtsen <larsi@gnus.org> + + * gnus-art.el (gnus-block-private-groups): Allow `global' methods to + display images. + + * gnus.el (gnus-valid-select-methods): Mark nnrss as global. + + * message.el (message-cancel-news): According to + <mailman.216.1372942181.12400.help-gnu-emacs@gnu.org>, "cancel" is + preferred over "cmsg cancel" in the Subject. + + * nnir.el (nnir-engines): Note that the group specs are regexps + (bug#13238). + + * gnus-msg.el (gnus-copy-article-buffer): If the article buffer has + gotten read-only text properties, ensure that those aren't heeded when + copying stuff over (bug#13434). + + * mm-view.el (mm-inline-text-html): Don't bug out on multipart messages + (bug#13762). + 2013-07-05 David Kastrup <dak@gnu.org> * auth-source.el (auth-source-netrc-parse-one): Allow empty strings in diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 5840aacd7a3..b41ff9c0550 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -6947,7 +6947,8 @@ If given a prefix, show the hidden text instead." (set-buffer buf)))))) (defun gnus-block-private-groups (group) - (if (gnus-news-group-p group) + (if (or (gnus-news-group-p group) + (gnus-member-of-valid 'global group)) ;; Block nothing in news groups. nil ;; Block everything anywhere else. diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index fce9a3633c2..e3f18662af4 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -920,6 +920,7 @@ header line with the old Message-ID." (with-current-buffer article-buffer (let ((gnus-newsgroup-charset (or gnus-article-charset gnus-newsgroup-charset)) + (inhibit-read-only t) (gnus-newsgroup-ignored-charsets (or gnus-article-ignored-charsets gnus-newsgroup-ignored-charsets))) diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index 5a7dfd82d28..6f2fe78c3d8 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -1186,6 +1186,29 @@ data stored in the registry." (gnus-select-group-with-message-id group message-id) t) (throw 'found t)))))))) +(defun gnus-registry-remove-extra-data (extra) + "Remove tracked EXTRA data from the gnus registry. +EXTRA is a list of symbols. Valid symbols are those contained in +the docs of `gnus-registry-track-extra'. This command is useful +when you stop tracking some extra data and now want to purge it +from your existing entries." + (interactive (list (mapcar 'intern + (completing-read-multiple + "Extra data: " + '("subject" "sender" "recipient"))))) + (when extra + (let ((db gnus-registry-db)) + (registry-reindex db) + (loop for k being the hash-keys of (oref db :data) + using (hash-value v) + do (let ((newv (delq nil (mapcar #'(lambda (entry) + (unless (member (car entry) extra) + entry)) + v)))) + (registry-delete db (list k) nil) + (gnus-registry-insert db k newv))) + (registry-reindex db)))) + ;; TODO: a few things (provide 'gnus-registry) diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index 084af884930..94803800e0b 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -2314,8 +2314,9 @@ If FORCE is non-nil, the .newsrc file is read." (gnus-info-set-marks info (delete exist (gnus-info-marks info)))))) (when (or force - (< (gnus-continuum-version gnus-newsrc-file-version) - (gnus-continuum-version "Ma Gnus v0.03"))) + (not (string= gnus-newsrc-file-version gnus-version))) + (message (concat "Removing unexist marks because newsrc " + "version does not match Gnus version.")) ;; Remove old `exist' marks from old nnimap groups. (dolist (info (cdr gnus-newsrc-alist)) (let ((exist (assoc 'unexist (gnus-info-marks info)))) diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 9a927a1cfab..8741a03b54d 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -1628,7 +1628,7 @@ slower." ("nnfolder" mail respool address) ("nngateway" post-mail address prompt-address physical-address) ("nnweb" none) - ("nnrss" none) + ("nnrss" none global) ("nnagent" post-mail) ("nnimap" post-mail address prompt-address physical-address respool server-marks) @@ -3007,7 +3007,7 @@ with some simple extensions. summary just like information from any other summary specifier. &user-date; Age sensitive date format. Various date format is - defined in `gnus-summary-user-date-format-alist'. + defined in `gnus-user-date-format-alist'. The %U (status), %R (replied) and %z (zcore) specs have to be handled diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index c6f5d904677..b35eb9dca12 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -7145,7 +7145,7 @@ If ARG, allow editing of the cancellation message." (erase-buffer) (insert "Newsgroups: " newsgroups "\n" "From: " from "\n" - "Subject: cmsg cancel " message-id "\n" + "Subject: cancel " message-id "\n" "Control: cancel " message-id "\n" (if distribution (concat "Distribution: " distribution "\n") diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index b1cba27c335..9512a411d81 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -419,16 +419,18 @@ (buffer-string))))) (defun mm-inline-text-html (handle) - (let* ((func mm-text-html-renderer) - (entry (assq func mm-text-html-renderer-alist)) - (inhibit-read-only t)) - (if entry - (setq func (cdr entry))) - (cond - ((functionp func) - (funcall func handle)) - (t - (apply (car func) handle (cdr func)))))) + (if (stringp (car handle)) + (mapcar 'mm-inline-text-html (cdr handle)) + (let* ((func mm-text-html-renderer) + (entry (assq func mm-text-html-renderer-alist)) + (inhibit-read-only t)) + (if entry + (setq func (cdr entry))) + (cond + ((functionp func) + (funcall func handle)) + (t + (apply (car func) handle (cdr func))))))) (defun mm-inline-text-vcard (handle) (let ((inhibit-read-only t)) diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index 22dee30e8fa..4dd123bf2c7 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el @@ -548,15 +548,15 @@ that it is for notmuch, not Namazu." (gmane nnir-run-gmane ((gmane-author . "Gmane Author: "))) (swish++ nnir-run-swish++ - ((swish++-group . "Swish++ Group spec: "))) + ((swish++-group . "Swish++ Group spec (regexp): "))) (swish-e nnir-run-swish-e - ((swish-e-group . "Swish-e Group spec: "))) + ((swish-e-group . "Swish-e Group spec (regexp): "))) (namazu nnir-run-namazu ()) (notmuch nnir-run-notmuch ()) (hyrex nnir-run-hyrex - ((hyrex-group . "Hyrex Group spec: "))) + ((hyrex-group . "Hyrex Group spec (regexp): "))) (find-grep nnir-run-find-grep ((grep-options . "Grep options: ")))) "Alist of supported search engines. diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el index 64e1ee11977..05d0c902340 100644 --- a/lisp/gnus/nnml.el +++ b/lisp/gnus/nnml.el @@ -1094,7 +1094,10 @@ Use the nov database for the current group if available." (concat group ":" new-number-string))) ;; Save to the new file: (nnmail-write-region (point-min) (point-max) newfile)) - (funcall nnmail-delete-file-function oldfile)) + (condition-case () + (funcall nnmail-delete-file-function oldfile) + (file-error + (message "Couldn't delete %s" oldfile)))) ;; 2/ Update all marks for this article: ;; #### NOTE: it is possible that the new article number ;; #### already belongs to a range, whereas the corresponding diff --git a/lisp/ido.el b/lisp/ido.el index f695ec117f1..9c4e56544cb 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -3461,8 +3461,14 @@ This is to make them appear as if they were \"virtual buffers\"." (setq ido-virtual-buffers nil) (let (name) (dolist (head recentf-list) - (and (setq name (file-name-nondirectory head)) - (null (get-file-buffer head)) + (setq name (file-name-nondirectory head)) + ;; In case HEAD is a directory with trailing /. See bug#14552. + (when (equal name "") + (setq name (file-name-nondirectory (directory-file-name head)))) + (when (equal name "") + (setq name head)) + (and (not (equal name "")) + (null (get-file-buffer head)) (not (assoc name ido-virtual-buffers)) (not (member name ido-temp-list)) (not (ido-ignore-item-p name ido-ignore-buffers)) @@ -4721,9 +4727,12 @@ Modified from `icomplete-completions'." ;;; Helper functions for other programs -(put 'dired-do-rename 'ido 'ignore) (put 'ibuffer-find-file 'ido 'find-file) +(put 'dired 'ido 'dir) (put 'dired-other-window 'ido 'dir) +;; See http://debbugs.gnu.org/11954 for reasons. +(put 'dired-do-copy 'ido 'ignore) +(put 'dired-do-rename 'ido 'ignore) ;;;###autoload (defun ido-read-buffer (prompt &optional default require-match) @@ -4754,9 +4763,7 @@ See `read-file-name' for additional parameters." (eq (get this-command 'ido) 'dir) (memq this-command ido-read-file-name-as-directory-commands)) (setq filename - (ido-read-directory-name prompt dir default-filename mustmatch initial)) - (if (eq ido-exit 'fallback) - (setq filename 'fallback))) + (ido-read-directory-name prompt dir default-filename mustmatch initial))) ((and (not (eq (get this-command 'ido) 'ignore)) (not (memq this-command ido-read-file-name-non-ido)) (or (null predicate) (eq predicate 'file-exists-p))) @@ -4776,7 +4783,15 @@ See `read-file-name' for additional parameters." (ido-find-literal nil)) (setq ido-exit nil) (setq filename - (ido-read-internal 'file prompt 'ido-file-history default-filename mustmatch initial)) + (ido-read-internal 'file prompt 'ido-file-history + (cond ; Bug#11861. + ((stringp default-filename) default-filename) + ((consp default-filename) (car default-filename)) + ((and (not default-filename) initial) + (expand-file-name initial dir)) + (buffer-file-name buffer-file-name)) + mustmatch initial)) + (setq dir ido-current-directory) ; See bug#1516. (cond ((eq ido-exit 'fallback) (setq filename 'fallback)) @@ -4808,12 +4823,21 @@ See `read-directory-name' for additional parameters." (ido-directory-too-big-p ido-current-directory))) (ido-work-directory-index -1) (ido-work-file-index -1)) - (setq filename - (ido-read-internal 'dir prompt 'ido-file-history default-dirname mustmatch initial)) - (if filename - (if (and (stringp filename) (string-equal filename ".")) - ido-current-directory - (concat ido-current-directory filename))))) + (setq filename (ido-read-internal + 'dir prompt 'ido-file-history + (or default-dirname ; Bug#11861. + (if initial + (expand-file-name initial ido-current-directory) + ido-current-directory)) + mustmatch initial)) + (cond + ((eq ido-exit 'fallback) + (let ((read-file-name-function nil)) + (run-hook-with-args 'ido-before-fallback-functions 'read-directory-name) + (read-directory-name prompt ido-current-directory + default-dirname mustmatch initial))) + ((equal filename ".") ido-current-directory) + (t (concat ido-current-directory filename))))) ;;;###autoload (defun ido-completing-read (prompt choices &optional _predicate require-match diff --git a/lisp/net/shr.el b/lisp/net/shr.el index bdc30bc9292..4506ede8722 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -145,6 +145,7 @@ cid: URL as the argument.") (define-key map [follow-link] 'mouse-face) (define-key map "I" 'shr-insert-image) (define-key map "w" 'shr-copy-url) + (define-key map "u" 'shr-copy-url) (define-key map "v" 'shr-browse-url) (define-key map "o" 'shr-save-contents) (define-key map "\r" 'shr-browse-url) diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index 4c6141fe42b..f7f570590c8 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -38,9 +38,11 @@ ;; ;; - localname is a string. This are temporary properties, which are ;; related to the file localname is referring to. Examples: -;; "file-exists-p" is t or nile, depending on the file existence, or +;; "file-exists-p" is t or nil, depending on the file existence, or ;; "file-attributes" caches the result of the function -;; `file-attributes'. +;; `file-attributes'. These entries have a timestamp, and they +;; expire after `remote-file-name-inhibit-cache' seconds if this +;; variable is set. ;; ;; - The key is a process. This are temporary properties related to ;; an open connection. Examples: "scripts" keeps shell script diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 6ba055b8bb8..c2fdc0491b6 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1539,7 +1539,8 @@ connection if a previous connection has died for some reason." ;; indicated by the "mounted" signal, i.e. the "fuse-mountpoint" ;; file property. (with-timeout - (60 + ((or (tramp-get-method-parameter method 'tramp-connection-timeout) + tramp-connection-timeout) (if (zerop (length (tramp-file-name-user vec))) (tramp-error vec 'file-error diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index d7316b8d2ea..281f497692d 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -222,21 +222,24 @@ detected as prompt when being sent on echoing hosts, therefore.") (tramp-login-program "su") (tramp-login-args (("-") ("%u"))) (tramp-remote-shell "/bin/sh") - (tramp-remote-shell-args ("-c")))) + (tramp-remote-shell-args ("-c")) + (tramp-connection-timeout 10))) ;;;###tramp-autoload (add-to-list 'tramp-methods '("sudo" (tramp-login-program "sudo") (tramp-login-args (("-u" "%u") ("-s") ("-H") ("-p" "Password:"))) (tramp-remote-shell "/bin/sh") - (tramp-remote-shell-args ("-c")))) + (tramp-remote-shell-args ("-c")) + (tramp-connection-timeout 10))) ;;;###tramp-autoload (add-to-list 'tramp-methods '("ksu" (tramp-login-program "ksu") (tramp-login-args (("%u") ("-q"))) (tramp-remote-shell "/bin/sh") - (tramp-remote-shell-args ("-c")))) + (tramp-remote-shell-args ("-c")) + (tramp-connection-timeout 10))) ;;;###tramp-autoload (add-to-list 'tramp-methods '("krlogin" @@ -3752,12 +3755,16 @@ file exists and nonzero exit status otherwise." "Wait for shell prompt and barf if none appears. Looks at process PROC to see if a shell prompt appears in TIMEOUT seconds. If not, it produces an error message with the given ERROR-ARGS." - (unless - (tramp-wait-for-regexp - proc timeout - (format - "\\(%s\\|%s\\)\\'" shell-prompt-pattern tramp-shell-prompt-pattern)) - (apply 'tramp-error-with-buffer nil proc 'file-error error-args))) + (let ((vec (tramp-get-connection-property proc "vector" nil))) + (condition-case err + (tramp-wait-for-regexp + proc timeout + (format + "\\(%s\\|%s\\)\\'" shell-prompt-pattern tramp-shell-prompt-pattern)) + (error + (delete-process proc) + (apply 'tramp-error-with-buffer + (tramp-get-connection-buffer vec) vec 'file-error error-args))))) (defun tramp-open-connection-setup-interactive-shell (proc vec) "Set up an interactive shell. @@ -4332,9 +4339,6 @@ Gateway hops are already opened." ;; Result. target-alist)) -(defvar tramp-current-connection nil - "Last connection timestamp.") - (defun tramp-maybe-open-connection (vec) "Maybe open a connection VEC. Does not do anything if a connection is already open, but re-opens the @@ -4348,7 +4352,7 @@ connection if a previous connection has died for some reason." ;; If Tramp opens the same connection within a short time frame, ;; there is a problem. We shall signal this. (unless (or (and p (processp p) (memq (process-status p) '(run open))) - (not (equal (butlast (append vec nil)) + (not (equal (butlast (append vec nil) 2) (car tramp-current-connection))) (> (tramp-time-diff (current-time) (cdr tramp-current-connection)) @@ -4433,7 +4437,7 @@ connection if a previous connection has died for some reason." (set-process-sentinel p 'tramp-process-sentinel) (tramp-compat-set-process-query-on-exit-flag p nil) (setq tramp-current-connection - (cons (butlast (append vec nil)) (current-time)) + (cons (butlast (append vec nil) 2) (current-time)) tramp-current-host (system-name)) (tramp-message @@ -4441,8 +4445,8 @@ connection if a previous connection has died for some reason." ;; Check whether process is alive. (tramp-barf-if-no-shell-prompt - p 60 - "Couldn't find local shell prompt %s" tramp-encoding-shell) + p 10 + "Couldn't find local shell prompt for %s" tramp-encoding-shell) ;; Now do all the connections as specified. (while target-alist @@ -4460,6 +4464,9 @@ connection if a previous connection has died for some reason." (async-args (tramp-get-method-parameter l-method 'tramp-async-args)) + (connection-timeout + (tramp-get-method-parameter + l-method 'tramp-connection-timeout)) (gw-args (tramp-get-method-parameter l-method 'tramp-gw-args)) (gw (tramp-get-file-property hop "" "gateway" nil)) @@ -4542,7 +4549,8 @@ connection if a previous connection has died for some reason." (tramp-message vec 3 "Sending command `%s'" command) (tramp-send-command vec command t t) (tramp-process-actions - p vec pos tramp-actions-before-shell 60) + p vec pos tramp-actions-before-shell + (or connection-timeout tramp-connection-timeout)) (tramp-message vec 3 "Found remote shell prompt on `%s'" l-host)) ;; Next hop. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index f114c681fb7..3513701d20e 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -252,6 +252,11 @@ pair of the form (KEY VALUE). The following KEYs are defined: * `tramp-tmpdir' A directory on the remote host for temporary files. If not specified, \"/tmp\" is taken as default. + * `tramp-connection-timeout' + This is the maximum time to be spent for establishing a connection. + In general, the global default value shall be used, but for + some methods, like \"su\" or \"sudo\", a shorter timeout + might be desirable. What does all this mean? Well, you should specify `tramp-login-program' for all methods; this program is used to log in to the remote site. Then, @@ -1034,6 +1039,13 @@ opening a connection to a remote host." :group 'tramp :type '(choice (const nil) (const t) (const pty))) +(defcustom tramp-connection-timeout 60 + "Defines the max time to wait for establishing a connection (in seconds). +This can be overwritten for different connection types in `tramp-methods'." + :group 'tramp + :version "24.4" + :type 'integer) + (defcustom tramp-connection-min-time-diff 5 "Defines seconds between two consecutive connection attempts. This is necessary as self defense mechanism, in order to avoid @@ -1071,6 +1083,9 @@ means to use always cached values for the directory contents." (defvar tramp-current-host nil "Remote host for this *tramp* buffer.") +(defvar tramp-current-connection nil + "Last connection timestamp.") + ;;;###autoload (defconst tramp-completion-file-name-handler-alist '((file-name-all-completions . tramp-completion-handle-file-name-all-completions) @@ -1464,10 +1479,6 @@ ARGS to actually emit the message (if applicable)." This variable is used to disable messages from `tramp-error'. The messages are visible anyway, because an error is raised.") -(defvar tramp-message-show-progress-reporter-message t - "Show Tramp progress reporter message in the minibuffer. -This variable is used to disable recursive progress reporter messages.") - (defsubst tramp-message (vec-or-proc level fmt-string &rest args) "Emit a message depending on verbosity level. VEC-OR-PROC identifies the Tramp buffer to use. It can be either a @@ -1536,23 +1547,32 @@ signal identifier to be raised, remaining args passed to If BUFFER is nil, show the connection buffer. Wait for 30\", or until an input event arrives. The other arguments are passed to `tramp-error'." (save-window-excursion - (unwind-protect - (apply 'tramp-error vec-or-proc signal fmt-string args) - (when (and vec-or-proc - tramp-message-show-message - (not (zerop tramp-verbose)) - (not (tramp-completion-mode-p))) - (let ((enable-recursive-minibuffers t)) - (pop-to-buffer - (or (and (bufferp buffer) buffer) - (and (processp vec-or-proc) (process-buffer vec-or-proc)) - (tramp-get-connection-buffer vec-or-proc))) - (when (string-equal fmt-string "Process died") - (message - "%s\n %s" - "Tramp failed to connect. If this happens repeatedly, try" - "`M-x tramp-cleanup-this-connection'")) - (sit-for 30)))))) + (let* ((buf (or (and (bufferp buffer) buffer) + (and (processp vec-or-proc) (process-buffer vec-or-proc)) + (and (vectorp vec-or-proc) + (tramp-get-connection-buffer vec-or-proc)))) + (vec (or (and (vectorp vec-or-proc) vec-or-proc) + (and buf (with-current-buffer buf + (tramp-dissect-file-name default-directory)))))) + (unwind-protect + (apply 'tramp-error vec-or-proc signal fmt-string args) + ;; Save exit. + (when (and buf + tramp-message-show-message + (not (zerop tramp-verbose)) + (not (tramp-completion-mode-p))) + (let ((enable-recursive-minibuffers t)) + ;; `tramp-error' does not show messages. So we must do it + ;; ourselves. + (message fmt-string args) + ;; Show buffer. + (pop-to-buffer buf) + (discard-input) + (sit-for 30))) + ;; Reset timestamp. It would be wrong after waiting for a while. + (when (equal (butlast (append vec nil) 2) + (car tramp-current-connection)) + (setcdr tramp-current-connection (current-time))))))) (defmacro with-parsed-tramp-file-name (filename var &rest body) "Parse a Tramp filename and make components available in the body. @@ -1596,16 +1616,15 @@ If VAR is nil, then we bind `v' to the structure and `method', `user', (defmacro with-tramp-progress-reporter (vec level message &rest body) "Executes BODY, spinning a progress reporter with MESSAGE. -If LEVEL does not fit for visible messages, or if this is a -nested call of the macro, there are only traces without a visible -progress reporter." +If LEVEL does not fit for visible messages, there are only traces +without a visible progress reporter." (declare (indent 3) (debug t)) - `(let (pr tm) + `(let ((result "failed") + pr tm) (tramp-message ,vec ,level "%s..." ,message) ;; We start a pulsing progress reporter after 3 seconds. Feature ;; introduced in Emacs 24.1. - (when (and tramp-message-show-progress-reporter-message - tramp-message-show-message + (when (and tramp-message-show-message ;; Display only when there is a minimum level. (<= ,level (min tramp-verbose 3))) (ignore-errors @@ -1613,14 +1632,11 @@ progress reporter." tm (when pr (run-at-time 3 0.1 'tramp-progress-reporter-update pr))))) (unwind-protect - ;; Execute the body. Suppress concurrent progress reporter - ;; messages. - (let ((tramp-message-show-progress-reporter-message - (and tramp-message-show-progress-reporter-message (not tm)))) - ,@body) + ;; Execute the body. + (prog1 (progn ,@body) (setq result "done")) ;; Stop progress reporter. (if tm (tramp-compat-funcall 'cancel-timer tm)) - (tramp-message ,vec ,level "%s...done" ,message)))) + (tramp-message ,vec ,level "%s...%s" ,message result)))) (tramp-compat-font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-progress-reporter\\>")) @@ -3393,39 +3409,49 @@ The terminal type can be configured with `tramp-terminal-type'." PROC and VEC indicate the remote connection to be used. POS, if set, is the starting point of the region to be deleted in the connection buffer." - ;; Preserve message for `progress-reporter'. - (tramp-compat-with-temp-message "" - ;; Enable `auth-source' and `password-cache'. We must use - ;; tramp-current-* variables in case we have several hops. - (tramp-set-connection-property - (tramp-dissect-file-name - (tramp-make-tramp-file-name - tramp-current-method tramp-current-user tramp-current-host "")) - "first-password-request" t) - (save-restriction + ;; Enable `auth-source' and `password-cache'. We must use + ;; tramp-current-* variables in case we have several hops. + (tramp-set-connection-property + (tramp-dissect-file-name + (tramp-make-tramp-file-name + tramp-current-method tramp-current-user tramp-current-host "")) + "first-password-request" t) + (save-restriction + (with-tramp-progress-reporter + proc 3 "Waiting for prompts from remote shell" (let (exit) - (while (not exit) - (tramp-message proc 3 "Waiting for prompts from remote shell") - (setq exit - (catch 'tramp-action - (if timeout - (with-timeout (timeout) - (tramp-process-one-action proc vec actions)) + (if timeout + (with-timeout (timeout (setq exit 'timeout)) + (while (not exit) + (setq exit + (catch 'tramp-action + (tramp-process-one-action proc vec actions))))) + (while (not exit) + (setq exit + (catch 'tramp-action (tramp-process-one-action proc vec actions))))) (with-current-buffer (tramp-get-connection-buffer vec) (widen) (tramp-message vec 6 "\n%s" (buffer-string))) (unless (eq exit 'ok) (tramp-clear-passwd vec) + (delete-process proc) (tramp-error-with-buffer - nil vec 'file-error + (tramp-get-connection-buffer vec) vec 'file-error (cond ((eq exit 'permission-denied) "Permission denied") - ((eq exit 'process-died) "Process died") - (t "Login failed")))) - (when (numberp pos) - (with-current-buffer (tramp-get-connection-buffer vec) - (let (buffer-read-only) (delete-region pos (point))))))))) + ((eq exit 'process-died) + (concat + "Tramp failed to connect. If this happens repeatedly, try\n" + " `M-x tramp-cleanup-this-connection'")) + ((eq exit 'timeout) + (format + "Timeout reached, see buffer `%s' for details" + (tramp-get-connection-buffer vec))) + (t "Login failed"))))) + (when (numberp pos) + (with-current-buffer (tramp-get-connection-buffer vec) + (let (buffer-read-only) (delete-region pos (point)))))))) :;; Utility functions: diff --git a/lisp/progmodes/cfengine.el b/lisp/progmodes/cfengine.el index 55d5b8b0be7..85a9074760d 100644 --- a/lisp/progmodes/cfengine.el +++ b/lisp/progmodes/cfengine.el @@ -387,10 +387,10 @@ Intended as the value of `indent-line-function'." (skip-chars-forward " \t") (current-column))) (error nil))) - ;; Inside a string and it starts before this line. + ;; Inside a string and it starts before this line: do nothing. ((and (nth 3 parse) (< (nth 8 parse) (save-excursion (beginning-of-line) (point)))) - (indent-line-to 0)) + ) ;; Inside a defun, but not a nested list (depth is 1). This is ;; a promise, usually. diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el index 4957b58d469..6a71ab330a8 100644 --- a/lisp/progmodes/ebrowse.el +++ b/lisp/progmodes/ebrowse.el @@ -33,12 +33,12 @@ ;;; Code: +(require 'cl-lib) (require 'easymenu) (require 'view) (require 'ebuff-menu) (eval-when-compile - (require 'cl-lib) (require 'helper)) @@ -233,19 +233,6 @@ Compare items with `eq' or TEST if specified." found)) -(defun ebrowse-delete-if-not (predicate list) - "Remove elements not satisfying PREDICATE from LIST and return the result. -This is a destructive operation." - (let (result) - (while list - (let ((next (cdr list))) - (when (funcall predicate (car list)) - (setq result (nconc result list)) - (setf (cdr list) nil)) - (setq list next))) - result)) - - (defmacro ebrowse-output (&rest body) "Eval BODY with a writable current buffer. Preserve buffer's modified state." @@ -1310,17 +1297,17 @@ With PREFIX, insert that many filenames." (defun ebrowse-browser-buffer-list () "Return a list of all tree or member buffers." - (ebrowse-delete-if-not 'ebrowse-buffer-p (buffer-list))) + (cl-delete-if-not 'ebrowse-buffer-p (buffer-list))) (defun ebrowse-member-buffer-list () "Return a list of all member buffers." - (ebrowse-delete-if-not 'ebrowse-member-buffer-p (buffer-list))) + (cl-delete-if-not 'ebrowse-member-buffer-p (buffer-list))) (defun ebrowse-tree-buffer-list () "Return a list of all tree buffers." - (ebrowse-delete-if-not 'ebrowse-tree-buffer-p (buffer-list))) + (cl-delete-if-not 'ebrowse-tree-buffer-p (buffer-list))) (defun ebrowse-known-class-trees-buffer-list () @@ -1341,7 +1328,7 @@ one buffer. Prefer tree buffers over member buffers." (defun ebrowse-same-tree-member-buffer-list () "Return a list of members buffers with same tree as current buffer." - (ebrowse-delete-if-not + (cl-delete-if-not (lambda (buffer) (eq (buffer-local-value 'ebrowse--tree buffer) ebrowse--tree)) diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index 2c4d6a0e3d7..10472ec5815 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -1759,6 +1759,9 @@ static char *magick[] = { As long as GDB is in the recursive reading loop, it does not expect commands to be prefixed by \"-interpreter-exec console\".") +(defun gdb-strip-string-backslash (string) + (replace-regexp-in-string "\\\\$" "" string)) + (defun gdb-send (proc string) "A comint send filter for gdb." (with-current-buffer gud-comint-buffer @@ -1766,10 +1769,15 @@ commands to be prefixed by \"-interpreter-exec console\".") (remove-text-properties (point-min) (point-max) '(face)))) ;; mimic <RET> key to repeat previous command in GDB (if (not (string= "" string)) - (setq gdb-last-command string) - (if gdb-last-command (setq string gdb-last-command))) - (if (or (string-match "^-" string) - (> gdb-control-level 0)) + (if gdb-continuation + (setq gdb-last-command (concat gdb-continuation + (gdb-strip-string-backslash string) + " ")) + (setq gdb-last-command (gdb-strip-string-backslash string))) + (if gdb-last-command (setq string gdb-last-command)) + (setq gdb-continuation nil)) + (if (and (not gdb-continuation) (or (string-match "^-" string) + (> gdb-control-level 0))) ;; Either MI command or we are feeding GDB's recursive reading loop. (progn (setq gdb-first-done-or-error t) @@ -1779,10 +1787,13 @@ commands to be prefixed by \"-interpreter-exec console\".") (setq gdb-control-level (1- gdb-control-level)))) ;; CLI command (if (string-match "\\\\$" string) - (setq gdb-continuation (concat gdb-continuation string "\n")) + (setq gdb-continuation + (concat gdb-continuation (gdb-strip-string-backslash + string) + " ")) (setq gdb-first-done-or-error t) (let ((to-send (concat "-interpreter-exec console " - (gdb-mi-quote string) + (gdb-mi-quote (concat gdb-continuation string " ")) "\n"))) (if gdb-enable-debug (push (cons 'mi-send to-send) gdb-debug-log)) diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 5f92d197a66..06dffd80d88 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -1351,7 +1351,7 @@ If the result is do-end block, it will always be multiline." (progn (eval-and-compile (defconst ruby-percent-literal-beg-re - "\\(%\\)[qQrswWx]?\\([[:punct:]]\\)" + "\\(%\\)[qQrswWxIi]?\\([[:punct:]]\\)" "Regexp to match the beginning of percent literal.") (defconst ruby-syntax-methods-before-regexp @@ -1387,7 +1387,7 @@ It will be properly highlighted even when the call omits parens.") (funcall (syntax-propertize-rules ;; $' $" $` .... are variables. - ;; ?' ?" ?` are ascii codes. + ;; ?' ?" ?` are character literals (one-char strings in 1.9+). ("\\([?$]\\)[#\"'`]" (1 (unless (save-excursion ;; Not within a string. @@ -1518,7 +1518,7 @@ It will be properly highlighted even when the call omits parens.") (save-match-data (save-excursion (goto-char (nth 8 parse-state)) - (looking-at "%\\(?:[QWrx]\\|\\W\\)"))))))) + (looking-at "%\\(?:[QWrxI]\\|\\W\\)"))))))) (defun ruby-syntax-propertize-expansions (start end) (save-excursion @@ -1721,7 +1721,7 @@ See `font-lock-syntax-table'.") (defconst ruby-font-lock-keywords (list ;; functions - '("^\\s *def\\s +\\([^( \t\n]+\\)" + '("^\\s *def\\s +\\(?:[^( \t\n.]*\\.\\)?\\([^( \t\n]+\\)" 1 font-lock-function-name-face) (list (concat "\\(^\\|[^.@$]\\|\\.\\.\\)\\(" @@ -1809,7 +1809,6 @@ See `font-lock-syntax-table'.") "warn" ;; keyword-like private methods on Module "alias_method" - "autoload" "attr" "attr_accessor" "attr_reader" @@ -1850,14 +1849,17 @@ See `font-lock-syntax-table'.") 0 font-lock-variable-name-face) ;; constants '("\\(?:\\_<\\|::\\)\\([A-Z]+\\(\\w\\|_\\)*\\)" - 1 font-lock-type-face) + 1 (unless (eq ?\( (char-after)) font-lock-type-face)) '("\\(^\\s *\\|[\[\{\(,]\\s *\\|\\sw\\s +\\)\\(\\(\\sw\\|_\\)+\\):[^:]" 2 font-lock-constant-face) ;; expression expansion '(ruby-match-expression-expansion 2 font-lock-variable-name-face t) - ;; warn lower camel case - ;'("\\<[a-z]+[a-z0-9]*[A-Z][A-Za-z0-9]*\\([!?]?\\|\\>\\)" - ; 0 font-lock-warning-face) + ;; negation char + '("[^[:alnum:]_]\\(!\\)[^=]" + 1 font-lock-negation-char-face) + ;; character literals + ;; FIXME: Support longer escape sequences. + '("\\?\\\\?\\S " 0 font-lock-string-face) ) "Additional expressions to highlight in Ruby mode.") diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el index ec6e6e7ff10..3e7789069f9 100644 --- a/lisp/shadowfile.el +++ b/lisp/shadowfile.el @@ -74,6 +74,7 @@ ;;; Code: +(require 'cl-lib) (require 'ange-ftp) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -180,15 +181,6 @@ created by `shadow-define-regexp-group'.") (setq list (cdr list))) (car list)) -(defun shadow-remove-if (func list) - "Remove elements satisfying FUNC from LIST. -Nondestructive; actually returns a copy of the list with the elements removed." - (if list - (if (funcall func (car list)) - (shadow-remove-if func (cdr list)) - (cons (car list) (shadow-remove-if func (cdr list)))) - nil)) - (defun shadow-regexp-superquote (string) "Like `regexp-quote', but includes the ^ and $. This makes sure regexp matches nothing but STRING." @@ -238,9 +230,8 @@ instead." Replace old definition, if any. PRIMARY and REGEXP are the information defining the cluster. For interactive use, call `shadow-define-cluster' instead." - (let ((rest (shadow-remove-if - (function (lambda (x) (equal name (car x)))) - shadow-clusters))) + (let ((rest (cl-remove-if (lambda (x) (equal name (car x))) + shadow-clusters))) (setq shadow-clusters (cons (shadow-make-cluster name primary regexp) rest)))) @@ -602,9 +593,8 @@ and to are absolute file names." Consider them as regular expressions if third arg REGEXP is true." (if groups (let ((nonmatching - (shadow-remove-if - (function (lambda (x) (shadow-file-match x file regexp))) - (car groups)))) + (cl-remove-if (lambda (x) (shadow-file-match x file regexp)) + (car groups)))) (append (cond ((equal nonmatching (car groups)) nil) (regexp (let ((realname (nth 2 (shadow-parse-fullname file)))) @@ -635,8 +625,7 @@ Consider them as regular expressions if third arg REGEXP is true." "Remove PAIR from `shadow-files-to-copy'. PAIR must be `eq' to one of the elements of that list." (setq shadow-files-to-copy - (shadow-remove-if (function (lambda (s) (eq s pair))) - shadow-files-to-copy))) + (cl-remove-if (lambda (s) (eq s pair)) shadow-files-to-copy))) (defun shadow-read-files () "Visit and load `shadow-info-file' and `shadow-todo-file'. diff --git a/lisp/simple.el b/lisp/simple.el index b4b8ddfabed..9158452fd64 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -4602,6 +4602,12 @@ for it.") (defun next-line (&optional arg try-vscroll) "Move cursor vertically down ARG lines. Interactively, vscroll tall lines if `auto-window-vscroll' is enabled. +Non-interactively, use TRY-VSCROLL to control whether to vscroll tall +lines: if either `auto-window-vscroll' or TRY-VSCROLL is nil, this +function will not vscroll. + +ARG defaults to 1. + If there is no character in the target line exactly under the current column, the cursor is positioned after the character in that line which spans this column, or at the end of the line if it is not long enough. @@ -4646,6 +4652,12 @@ and more reliable (no dependence on goal column, etc.)." (defun previous-line (&optional arg try-vscroll) "Move cursor vertically up ARG lines. Interactively, vscroll tall lines if `auto-window-vscroll' is enabled. +Non-interactively, use TRY-VSCROLL to control whether to vscroll tall +lines: if either `auto-window-vscroll' or TRY-VSCROLL is nil, this +function will not vscroll. + +ARG defaults to 1. + If there is no character in the target line exactly over the current column, the cursor is positioned after the character in that line which spans this column, or at the end of the line if it is not long enough. @@ -4725,33 +4737,76 @@ lines." :group 'editing-basics :version "23.1") +(defun default-font-height () + "Return the height in pixels of the current buffer's default face font." + (cond + ((display-multi-font-p) + (aref (font-info (face-font 'default)) 3)) + (t (frame-char-height)))) + +(defun default-line-height () + "Return the pixel height of current buffer's default-face text line. + +The value includes `line-spacing', if any, defined for the buffer +or the frame." + (let ((dfh (default-font-height)) + (lsp (if (display-graphic-p) + (or line-spacing + (default-value 'line-spacing) + (frame-parameter nil 'line-spacing) + 0) + 0))) + (if (floatp lsp) + (setq lsp (* dfh lsp))) + (+ dfh lsp))) + +(defun window-screen-lines () + "Return the number of screen lines in the text area of the selected window. + +This is different from `window-text-height' in that this function counts +lines in units of the height of the font used by the default face displayed +in the window, not in units of the frame's default font, and also accounts +for `line-spacing', if any, defined for the window's buffer or frame. + +The value is a floating-point number." + (let ((canonical (window-text-height)) + (fch (frame-char-height)) + (dlh (default-line-height))) + (/ (* (float canonical) fch) dlh))) + ;; Returns non-nil if partial move was done. (defun line-move-partial (arg noerror to-end) (if (< arg 0) ;; Move backward (up). ;; If already vscrolled, reduce vscroll - (let ((vs (window-vscroll nil t))) - (when (> vs (frame-char-height)) - (set-window-vscroll nil (- vs (frame-char-height)) t))) + (let ((vs (window-vscroll nil t)) + (dlh (default-line-height))) + (when (> vs dlh) + (set-window-vscroll nil (- vs dlh) t))) ;; Move forward (down). (let* ((lh (window-line-height -1)) + (rowh (car lh)) (vpos (nth 1 lh)) (ypos (nth 2 lh)) (rbot (nth 3 lh)) (this-lh (window-line-height)) - (this-height (nth 0 this-lh)) + (this-height (car this-lh)) (this-ypos (nth 2 this-lh)) - (fch (frame-char-height)) - py vs) + (dlh (default-line-height)) + (wslines (window-screen-lines)) + py vs last-line) + (if (> (mod wslines 1.0) 0.0) + (setq wslines (round (+ wslines 0.5)))) (when (or (null lh) - (>= rbot fch) - (<= ypos (- fch)) + (>= rbot dlh) + (<= ypos (- dlh)) (null this-lh) - (<= this-ypos (- fch))) + (<= this-ypos (- dlh))) (unless lh (let ((wend (pos-visible-in-window-p t nil t))) (setq rbot (nth 3 wend) + rowh (nth 4 wend) vpos (nth 5 wend)))) (unless this-lh (let ((wstart (pos-visible-in-window-p nil nil t))) @@ -4765,35 +4820,57 @@ lines." (if col-row (- (cdr col-row) (window-vscroll)) (cdr (posn-col-row ppos)))))) + ;; VPOS > 0 means the last line is only partially visible. + ;; But if the part that is visible is at least as tall as the + ;; default font, that means the line is actually fully + ;; readable, and something like line-spacing is hidden. So in + ;; that case we accept the last line in the window as still + ;; visible, and consider the margin as starting one line + ;; later. + (if (and vpos (> vpos 0)) + (if (and rowh + (>= rowh (default-font-height)) + (< rowh dlh)) + (setq last-line (min (- wslines scroll-margin) vpos)) + (setq last-line (min (- wslines scroll-margin 1) (1- vpos))))) (cond ;; If last line of window is fully visible, and vscrolling ;; more would make this line invisible, move forward. - ((and (or (< (setq vs (window-vscroll nil t)) fch) + ((and (or (< (setq vs (window-vscroll nil t)) dlh) (null this-height) - (<= this-height fch)) + (<= this-height dlh)) (or (null rbot) (= rbot 0))) nil) ;; If cursor is not in the bottom scroll margin, and the ;; current line is is not too tall, move forward. - ((and (or (null this-height) (<= this-height fch)) + ((and (or (null this-height) (<= this-height dlh)) vpos (> vpos 0) - (< py - (min (- (window-text-height) scroll-margin 1) (1- vpos)))) + (< py last-line)) nil) ;; When already vscrolled, we vscroll some more if we can, ;; or clear vscroll and move forward at end of tall image. ((> vs 0) (when (or (and rbot (> rbot 0)) - (and this-height (> this-height fch))) - (set-window-vscroll nil (+ vs fch) t))) + (and this-height (> this-height dlh))) + (set-window-vscroll nil (+ vs dlh) t))) ;; If cursor just entered the bottom scroll margin, move forward, - ;; but also vscroll one line so redisplay won't recenter. + ;; but also optionally vscroll one line so redisplay won't recenter. ((and vpos (> vpos 0) - (= py (min (- (window-text-height) scroll-margin 1) - (1- vpos)))) - (set-window-vscroll nil (frame-char-height) t) + (= py last-line)) + ;; Don't vscroll if the partially-visible line at window + ;; bottom has the default height (a.k.a. "just one more text + ;; line"): in that case, we do want redisplay to behave + ;; normally, i.e. recenter or whatever. + ;; + ;; Note: ROWH + RBOT from the value returned by + ;; pos-visible-in-window-p give the total height of the + ;; partially-visible glyph row at the end of the window. As + ;; we are dealing with floats, we disregard sub-pixel + ;; discrepancies between that and DLH. + (if (and rowh rbot (>= (- (+ rowh rbot) dlh) 1)) + (set-window-vscroll nil dlh t)) (line-move-1 arg noerror to-end) t) ;; If there are lines above the last line, scroll-up one line. @@ -4802,7 +4879,7 @@ lines." t) ;; Finally, start vscroll. (t - (set-window-vscroll nil (frame-char-height) t))))))) + (set-window-vscroll nil dlh t))))))) ;; This is like line-move-1 except that it also performs @@ -4835,11 +4912,14 @@ lines." (prog1 (line-move-visual arg noerror) ;; If we moved into a tall line, set vscroll to make ;; scrolling through tall images more smooth. - (let ((lh (line-pixel-height))) + (let ((lh (line-pixel-height)) + (dlh (default-line-height))) (if (and (< arg 0) (< (point) (window-start)) - (> lh (frame-char-height))) - (set-window-vscroll nil (- lh (frame-char-height)) t)))) + (> lh dlh)) + (set-window-vscroll + nil + (- lh dlh) t)))) (line-move-1 arg noerror to-end))))) ;; Display-based alternative to line-move-1. diff --git a/lisp/subr.el b/lisp/subr.el index b2918baf247..a2afe0768c4 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1980,7 +1980,7 @@ any other terminator is used itself as input. The optional argument PROMPT specifies a string to use to prompt the user. The variable `read-quoted-char-radix' controls which radix to use for numeric input." - (let ((message-log-max nil) done (first t) (code 0) char translated) + (let ((message-log-max nil) done (first t) (code 0) translated) (while (not done) (let ((inhibit-quit first) ;; Don't let C-h get the help message--only help function keys. @@ -3853,6 +3853,7 @@ FILE should be the name of a library, with no directory name." (declare (obsolete eval-after-load "23.2")) (eval-after-load file (read))) + (defun display-delayed-warnings () "Display delayed warnings from `delayed-warnings-list'. Used from `delayed-warnings-hook' (which see)." @@ -3886,6 +3887,12 @@ By default, this hook contains functions to consolidate the warnings listed in `delayed-warnings-list', display them, and set `delayed-warnings-list' back to nil.") +(defun delay-warning (type message &optional level buffer-name) + "Display a delayed warning. +Aside from going through `delayed-warnings-list', this is equivalent +to `display-warning'." + (push (list type message level buffer-name) delayed-warnings-list)) + ;;;; invisibility specs diff --git a/lisp/thumbs.el b/lisp/thumbs.el index 3d591303414..8032de85b01 100644 --- a/lisp/thumbs.el +++ b/lisp/thumbs.el @@ -57,6 +57,7 @@ ;;; Code: (require 'dired) +(require 'cl-lib) ; for cl-gensym ;; CUSTOMIZATIONS @@ -179,21 +180,6 @@ this value can let another user see some of your images." (make-variable-buffer-local 'thumbs-marked-list) (put 'thumbs-marked-list 'permanent-local t) -(defalias 'thumbs-gensym - (if (fboundp 'gensym) - 'gensym - ;; Copied from cl-macs.el - (defvar thumbs-gensym-counter 0) - (lambda (&optional prefix) - "Generate a new uninterned symbol. -The name is made by appending a number to PREFIX, default \"G\"." - (let ((pfix (if (stringp prefix) prefix "G")) - (num (if (integerp prefix) prefix - (prog1 thumbs-gensym-counter - (setq thumbs-gensym-counter - (1+ thumbs-gensym-counter)))))) - (make-symbol (format "%s%d" pfix num)))))) - (defsubst thumbs-temp-dir () (file-name-as-directory (expand-file-name thumbs-temp-dir))) @@ -202,7 +188,7 @@ The name is made by appending a number to PREFIX, default \"G\"." (format "%s%s-%s.jpg" (thumbs-temp-dir) thumbs-temp-prefix - (thumbs-gensym "T"))) + (cl-gensym "T"))) (defun thumbs-thumbsdir () "Return the current thumbnails directory (from `thumbs-thumbsdir'). diff --git a/lisp/vc/ediff.el b/lisp/vc/ediff.el index 7a8f399a6ce..e9a6a97409c 100644 --- a/lisp/vc/ediff.el +++ b/lisp/vc/ediff.el @@ -12,8 +12,8 @@ ;; filed in the Emacs bug reporting system against this file, a copy ;; of the bug report be sent to the maintainer's email address. -(defconst ediff-version "2.81.4" "The current version of Ediff") -(defconst ediff-date "December 7, 2009" "Date of last update") +(defconst ediff-version "2.81.5" "The current version of Ediff") +(defconst ediff-date "July 4, 2013" "Date of last update") ;; This file is part of GNU Emacs. @@ -1560,6 +1560,75 @@ With optional NODE, goes to that node." (add-to-list 'debug-ignored-errors mess)) + +;;; Command line interface + +;;;###autoload +(defun ediff-files-command () + (let ((file-a (nth 0 command-line-args-left)) + (file-b (nth 1 command-line-args-left))) + (setq command-line-args-left (nthcdr 2 command-line-args-left)) + (ediff file-a file-b))) + +;;;###autoload +(defun ediff3-files-command () + (let ((file-a (nth 0 command-line-args-left)) + (file-b (nth 1 command-line-args-left)) + (file-c (nth 2 command-line-args-left))) + (setq command-line-args-left (nthcdr 3 command-line-args-left)) + (ediff3 file-a file-b file-c))) + +;;;###autoload +(defun ediff-merge-command () + (let ((file-a (nth 0 command-line-args-left)) + (file-b (nth 1 command-line-args-left))) + (setq command-line-args-left (nthcdr 2 command-line-args-left)) + (ediff-merge-files file-a file-b))) + +;;;###autoload +(defun ediff-merge-with-ancestor-command () + (let ((file-a (nth 0 command-line-args-left)) + (file-b (nth 1 command-line-args-left)) + (ancestor (nth 2 command-line-args-left))) + (setq command-line-args-left (nthcdr 3 command-line-args-left)) + (ediff-merge-files-with-ancestor file-a file-b ancestor))) + +;;;###autoload +(defun ediff-directories-command () + (let ((file-a (nth 0 command-line-args-left)) + (file-b (nth 1 command-line-args-left)) + (regexp (nth 2 command-line-args-left))) + (setq command-line-args-left (nthcdr 3 command-line-args-left)) + (ediff-directories file-a file-b regexp))) + +;;;###autoload +(defun ediff-directories3-command () + (let ((file-a (nth 0 command-line-args-left)) + (file-b (nth 1 command-line-args-left)) + (file-c (nth 2 command-line-args-left)) + (regexp (nth 3 command-line-args-left))) + (setq command-line-args-left (nthcdr 4 command-line-args-left)) + (ediff-directories3 file-a file-b file-c regexp))) + +;;;###autoload +(defun ediff-merge-directories-command () + (let ((file-a (nth 0 command-line-args-left)) + (file-b (nth 1 command-line-args-left)) + (regexp (nth 2 command-line-args-left))) + (setq command-line-args-left (nthcdr 3 command-line-args-left)) + (ediff-merge-directories file-a file-b regexp))) + +;;;###autoload +(defun ediff-merge-directories-with-ancestor-command () + (let ((file-a (nth 0 command-line-args-left)) + (file-b (nth 1 command-line-args-left)) + (ancestor (nth 2 command-line-args-left)) + (regexp (nth 3 command-line-args-left))) + (setq command-line-args-left (nthcdr 4 command-line-args-left)) + (ediff-merge-directories-with-ancestor file-a file-b ancestor regexp))) + + + (require 'ediff-util) (run-hooks 'ediff-load-hook) diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 2dc1e502171..b351d896911 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -55,6 +55,7 @@ ;; See `widget.el'. ;;; Code: +(require 'cl-lib) ;;; Compatibility. @@ -221,7 +222,7 @@ minibuffer." ((or widget-menu-minibuffer-flag (> (length items) widget-menu-max-shortcuts)) ;; Read the choice of name from the minibuffer. - (setq items (widget-remove-if 'stringp items)) + (setq items (cl-remove-if 'stringp items)) (let ((val (completing-read (concat title ": ") items nil t))) (if (stringp val) (let ((try (try-completion val items))) @@ -295,14 +296,6 @@ minibuffer." (error "Canceled")) value)))) -(defun widget-remove-if (predicate list) - (let (result (tail list)) - (while tail - (or (funcall predicate (car tail)) - (setq result (cons (car tail) result))) - (setq tail (cdr tail))) - (nreverse result))) - ;;; Widget text specifications. ;; ;; These functions are for specifying text properties. |