diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/ChangeLog | 97 | ||||
| -rw-r--r-- | lisp/calendar/cal-tex.el | 162 | ||||
| -rw-r--r-- | lisp/descr-text.el | 2 | ||||
| -rw-r--r-- | lisp/font-lock.el | 16 | ||||
| -rw-r--r-- | lisp/mail/rmail.el | 1 | ||||
| -rw-r--r-- | lisp/mail/rmailout.el | 80 | ||||
| -rw-r--r-- | lisp/mouse.el | 14 | ||||
| -rw-r--r-- | lisp/net/tramp-sh.el | 75 | ||||
| -rw-r--r-- | lisp/progmodes/subword.el | 28 | ||||
| -rw-r--r-- | lisp/simple.el | 47 | ||||
| -rw-r--r-- | lisp/subr.el | 133 | ||||
| -rw-r--r-- | lisp/vc/vc-mtn.el | 35 | ||||
| -rw-r--r-- | lisp/vc/vc.el | 5 | ||||
| -rw-r--r-- | lisp/window.el | 162 | ||||
| -rw-r--r-- | lisp/xml.el | 26 |
15 files changed, 618 insertions, 265 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index cf8e3ee2181..d748214959d 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,100 @@ +2012-08-20 Chong Yidong <cyd@gnu.org> + + * descr-text.el (describe-text-properties-1): Use overlays-in to + report on empty overlays (Bug#3322). + +2012-08-20 Glenn Morris <rgm@gnu.org> + + * mail/rmailout.el (rmail-output-read-file-name): + Trap and report errors in rmail-output-file-alist elements. + + * font-lock.el (font-lock-add-keywords): Doc fix (quote face names + since most non-font-lock faces are not also variables). + +2012-08-20 Edward Reingold <reingold@iit.edu> + + * calendar/cal-tex.el (cal-tex-cursor-week-at-a-glance): + New function. (Bug12160) + +2012-08-19 Glenn Morris <rgm@gnu.org> + + * mail/rmailout.el (rmail-output-read-file-name): + Fix previous change (when the alist is nil or does not match). + +2012-08-19 Chong Yidong <cyd@gnu.org> + + * xml.el (xml-escape-string): Don't refer to xml-entity-alist + (Bug#12228). + +2012-08-18 Chong Yidong <cyd@gnu.org> + + * simple.el (yank-handled-properties): New defcustom. + (yank-excluded-properties): Add font-lock-face and category. + (yank): Doc fix. + + * subr.el (remove-yank-excluded-properties): Obey + yank-handled-properties. The special handling of font-lock-face + and category is now done this way, instead of being hard-coded. + (insert-for-yank-1): Remove font-lock-face handling. + (yank-handle-font-lock-face-property) + (yank-handle-category-property): New function. + +2012-08-17 Glenn Morris <rgm@gnu.org> + + * mail/rmailout.el (rmail-output-read-file-name): + Check rmail-output-file-alist against the full message body + in the correct rmail buffer. (Bug#12214) + +2012-08-17 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp-sh.el (tramp-sh-handle-start-file-process): Eliminate + superfluous prompt. (Bug#12203) + +2012-08-17 Chong Yidong <cyd@gnu.org> + + * mouse.el (mouse-appearance-menu): If x-select-font returns a + font spec, set the font directly (Bug#3228). + +2012-08-17 Martin Rudalics <rudalics@gmx.at> + + * window.el (delete-window): Fix last fix. + +2012-08-16 Martin Rudalics <rudalics@gmx.at> + + * window.el (window-valid-p): Move to window.c. + (window-child, window-child-count, window-last-child) + (window-normalize-window, window-combined-p) + (window-combinations, window-atom-root, window-min-size) + (window-sizable, window-sizable-p, window-size-fixed-p) + (window-min-delta, window-max-delta, window--resizable) + (window--resizable-p, window-resizable, window-total-size) + (window-full-height-p, window-full-width-p, window-body-size) + (window-at-side-p, adjust-window-trailing-edge, maximize-window) + (minimize-window, window-deletable-p, delete-window) + (delete-other-windows, set-window-buffer-start-and-point) + (next-buffer, previous-buffer, split-window, balance-windows-2) + (set-window-text-height, window-buffer-height) + (fit-window-to-buffer, shrink-window-if-larger-than-buffer) + (truncated-partial-width-window-p): Minor code adjustments. In + doc-strings state whether the argument window has to denote a + live, valid or any window. + +2012-08-16 Phil Sainty <psainty@orcon.net.nz> (tiny change) + + * progmodes/subword.el (subword-forward-function) + (subword-backward-function, subword-forward-regexp) + (subword-backward-regexp): New variables. + (subword-forward, subword-forward-internal, subword-backward-internal): + Use new variables, eg so that different "word" definitions + can be easily used. (Bug#11411) + +2012-08-15 Stefan Monnier <monnier@iro.umontreal.ca> + + * vc/vc-mtn.el (vc-mtn-revision-completion-table): Handle completion + for composite selectors. + * vc/vc.el (vc-diff-build-argument-list-internal): Don't prevent + operation just because we can't find a previous revision. + 2012-08-15 Chong Yidong <cyd@gnu.org> * frame.el (set-frame-font): Accept font objects. diff --git a/lisp/calendar/cal-tex.el b/lisp/calendar/cal-tex.el index a40c05f45ca..c8c80370dfa 100644 --- a/lisp/calendar/cal-tex.el +++ b/lisp/calendar/cal-tex.el @@ -1009,6 +1009,168 @@ shown are hard-coded to 8-12, 13-17." (cal-tex-e-framebox) (cal-tex-hspace "1cm"))) +(defun cal-tex-cursor-week-at-a-glance (&optional n event) + "One-week-at-a-glance full page calendar for week indicated by cursor. +Optional prefix argument N specifies number of weeks (default 1), +starting on Mondays. The calendar shows holiday and diary entries +if `cal-tex-holidays' and `cal-tex-diary', respectively, are non-nil. +It does not show hours of the day. Optional EVENT indicates a buffer +position to use instead of point." + (interactive (list (prefix-numeric-value current-prefix-arg) + last-nonmenu-event)) + (or n (setq n 1)) + (let* ((date (calendar-gregorian-from-absolute + (calendar-dayname-on-or-before + 1 + (calendar-absolute-from-gregorian + (calendar-cursor-to-date t event))))) + (month (calendar-extract-month date)) + (year (calendar-extract-year date)) + (day (calendar-extract-day date)) + (d1 (calendar-absolute-from-gregorian date)) + (d2 (+ (* 7 n) d1)) + (holidays (if cal-tex-holidays + (holiday-in-range d1 d2))) + (diary-list (if cal-tex-diary + (cal-tex-list-diary-entries d1 d2)))) + (cal-tex-preamble "twoside,12pt") + (cal-tex-cmd "\\usepackage{color}") + (cal-tex-cmd "\\textwidth 7in") + (cal-tex-cmd "\\textheight 10.5in") + (cal-tex-cmd "\\oddsidemargin 0in") + (cal-tex-cmd "\\evensidemargin 0in") + (cal-tex-cmd "\\topmargin 0pt") + (cal-tex-cmd "\\headheight -0.875in") + (cal-tex-cmd "\\headsep 0.125in") + (cal-tex-cmd "\\footskip .125in") + (insert "\\def\\righthead#1{\\hfill {\\normalsize \\bf #1}\\\\[-6pt]} +\\long\\def\\rightday#1#2#3#4#5{% + \\rule{\\textwidth}{0.3pt}\\\\% + \\hbox to \\textwidth{% + \\vbox to 2.75in{% + \\vspace*{2pt}% + \\hbox to \\textwidth{\\small #5 \\hfill #1 {\\normalsize \\bf #2}}% + \\hbox to \\textwidth{\\vbox {\\raggedleft \\footnotesize \\em \\textcolor{red}{#4}}}% + \\hbox to \\textwidth{\\vbox to 0pt {\\noindent \\footnotesize \\textcolor{blue}{#3}}}}}\\\\} +\\long\\def\\weekend#1#2#3#4#5{% + \\rule{\\textwidth}{0.3pt}\\\\% + \\hbox to \\textwidth{% + \\vbox to 1.8in{% + \\vspace*{2pt}% + \\hbox to \\textwidth{\\small #5 \\hfill #1 {\\normalsize \\bf #2}}% + \\hbox to \\textwidth{\\vbox {\\raggedleft \\footnotesize \\em \\textcolor{red}{#4}}}% + \\hbox to \\textwidth{\\vbox to 0pt {\\noindent \\footnotesize \\textcolor{blue}{#3}}}}}\\\\} +\\def\\lefthead#1{\\noindent {\\normalsize \\bf #1}\\hfill\\\\[-6pt]} +\\long\\def\\leftday#1#2#3#4#5{% + \\rule{\\textwidth}{0.3pt}\\\\% + \\hbox to \\textwidth{% + \\vbox to 2.75in{% + \\vspace*{2pt}% + \\hbox to \\textwidth{\\noindent {\\normalsize \\bf #2} \\small #1 \\hfill #5}% + \\hbox to \\textwidth{\\vbox {\\noindent \\footnotesize \\em \\textcolor{red}{#4}}}% + \\hbox to \\textwidth{\\vbox to 0pt {\\noindent \\footnotesize \\textcolor{blue}{#3}}}}}\\\\} +") + (cal-tex-b-document) + (cal-tex-cmd "\\pagestyle{empty}\\ ") + (cal-tex-newpage) + (dotimes (i n) + (insert "\\lefthead") + (cal-tex-arg + (let ((d (cal-tex-incr-date date 2))) + (if (= (calendar-extract-month date) + (calendar-extract-month d)) + (format "%s %s" + (cal-tex-month-name (calendar-extract-month date)) + (calendar-extract-year date)) + (if (= (calendar-extract-year date) + (calendar-extract-year d)) + (format "%s---%s %s" + (cal-tex-month-name (calendar-extract-month date)) + (cal-tex-month-name (calendar-extract-month d)) + (calendar-extract-year date)) + (format "%s %s---%s %s" + (cal-tex-month-name (calendar-extract-month date)) + (calendar-extract-year date) + (cal-tex-month-name (calendar-extract-month d)) + (calendar-extract-year d)))))) + (insert "%\n") + (dotimes (_jdummy 3) + (insert "\\leftday") + (cal-tex-arg (cal-tex-LaTeXify-string (calendar-day-name date))) + (cal-tex-arg (number-to-string (calendar-extract-day date))) + (cal-tex-arg (cal-tex-latexify-list diary-list date)) + (cal-tex-arg (cal-tex-latexify-list holidays date)) + (cal-tex-arg (eval cal-tex-daily-string)) + (insert "%\n") + (setq date (cal-tex-incr-date date))) + (insert "\\noindent\\rule{\\textwidth}{0.3pt}\\\\%\n") + (cal-tex-nl) + (insert (cal-tex-mini-calendar + (calendar-extract-month (cal-tex-previous-month date)) + (calendar-extract-year (cal-tex-previous-month date)) + "lastmonth" "1.1in" "1in")) + (insert (cal-tex-mini-calendar + (calendar-extract-month date) + (calendar-extract-year date) + "thismonth" "1.1in" "1in")) + (insert (cal-tex-mini-calendar + (calendar-extract-month (cal-tex-next-month date)) + (calendar-extract-year (cal-tex-next-month date)) + "nextmonth" "1.1in" "1in")) + (insert "\\hbox to \\textwidth{") + (cal-tex-hfill) + (insert "\\lastmonth") + (cal-tex-hfill) + (insert "\\thismonth") + (cal-tex-hfill) + (insert "\\nextmonth") + (cal-tex-hfill) + (insert "}") + (cal-tex-newpage) + (insert "\\righthead") + (cal-tex-arg + (let ((d (cal-tex-incr-date date 3))) + (if (= (calendar-extract-month date) + (calendar-extract-month d)) + (format "%s %s" + (cal-tex-month-name (calendar-extract-month date)) + (calendar-extract-year date)) + (if (= (calendar-extract-year date) + (calendar-extract-year d)) + (format "%s---%s %s" + (cal-tex-month-name (calendar-extract-month date)) + (cal-tex-month-name (calendar-extract-month d)) + (calendar-extract-year date)) + (format "%s %s---%s %s" + (cal-tex-month-name (calendar-extract-month date)) + (calendar-extract-year date) + (cal-tex-month-name (calendar-extract-month d)) + (calendar-extract-year d)))))) + (insert "%\n") + (dotimes (_jdummy 2) + (insert "\\rightday") + (cal-tex-arg (cal-tex-LaTeXify-string (calendar-day-name date))) + (cal-tex-arg (number-to-string (calendar-extract-day date))) + (cal-tex-arg (cal-tex-latexify-list diary-list date)) + (cal-tex-arg (cal-tex-latexify-list holidays date)) + (cal-tex-arg (eval cal-tex-daily-string)) + (insert "%\n") + (setq date (cal-tex-incr-date date))) + (dotimes (_jdummy 2) + (insert "\\weekend") + (cal-tex-arg (cal-tex-LaTeXify-string (calendar-day-name date))) + (cal-tex-arg (number-to-string (calendar-extract-day date))) + (cal-tex-arg (cal-tex-latexify-list diary-list date)) + (cal-tex-arg (cal-tex-latexify-list holidays date)) + (cal-tex-arg (eval cal-tex-daily-string)) + (insert "%\n") + (setq date (cal-tex-incr-date date))) + (unless (= i (1- n)) + (run-hooks 'cal-tex-week-hook) + (cal-tex-newpage))) + (cal-tex-end-document) + (run-hooks 'cal-tex-hook))) + ;;;###cal-autoload (defun cal-tex-cursor-filofax-2week (&optional n event) "Two-weeks-at-a-glance Filofax style calendar for week cursor is in. diff --git a/lisp/descr-text.el b/lisp/descr-text.el index 34d61b80d66..0c7f82d516e 100644 --- a/lisp/descr-text.el +++ b/lisp/descr-text.el @@ -140,7 +140,7 @@ otherwise." (defun describe-text-properties-1 (pos output-buffer) (let* ((properties (text-properties-at pos)) - (overlays (overlays-at pos)) + (overlays (overlays-in pos (1+ pos))) (wid-field (get-char-property pos 'field)) (wid-button (get-char-property pos 'button)) (wid-doc (get-char-property pos 'widget-doc)) diff --git a/lisp/font-lock.el b/lisp/font-lock.el index f3e313e9c35..77c21d26535 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -146,8 +146,8 @@ ;; fontified automagically. In your ~/.emacs there could be: ;; ;; (defvar foo-font-lock-keywords -;; '(("\\<\\(one\\|two\\|three\\)\\>" . font-lock-keyword-face) -;; ("\\<\\(four\\|five\\|six\\)\\>" . font-lock-type-face)) +;; '(("\\<\\(one\\|two\\|three\\)\\>" . 'font-lock-keyword-face) +;; ("\\<\\(four\\|five\\|six\\)\\>" . 'font-lock-type-face)) ;; "Default expressions to highlight in Foo mode.") ;; ;; (add-hook 'foo-mode-hook @@ -167,8 +167,8 @@ ;; could be: ;; ;; (defvar bar-font-lock-keywords -;; '(("\\<\\(uno\\|due\\|tre\\)\\>" . font-lock-keyword-face) -;; ("\\<\\(quattro\\|cinque\\|sei\\)\\>" . font-lock-type-face)) +;; '(("\\<\\(uno\\|due\\|tre\\)\\>" . 'font-lock-keyword-face) +;; ("\\<\\(quattro\\|cinque\\|sei\\)\\>" . 'font-lock-type-face)) ;; "Default expressions to highlight in Bar mode.") ;; ;; and within `bar-mode' there could be: @@ -679,8 +679,8 @@ end of the current highlighting list. For example: (font-lock-add-keywords 'c-mode - '((\"\\\\\\=<\\\\(FIXME\\\\):\" 1 font-lock-warning-face prepend) - (\"\\\\\\=<\\\\(and\\\\|or\\\\|not\\\\)\\\\\\=>\" . font-lock-keyword-face))) + '((\"\\\\\\=<\\\\(FIXME\\\\):\" 1 'font-lock-warning-face prepend) + (\"\\\\\\=<\\\\(and\\\\|or\\\\|not\\\\)\\\\\\=>\" . 'font-lock-keyword-face))) adds two fontification patterns for C mode, to fontify `FIXME:' words, even in comments, and to fontify `and', `or' and `not' words as keywords. @@ -694,9 +694,9 @@ For example: (add-hook 'c-mode-hook (lambda () (font-lock-add-keywords nil - '((\"\\\\\\=<\\\\(FIXME\\\\):\" 1 font-lock-warning-face prepend) + '((\"\\\\\\=<\\\\(FIXME\\\\):\" 1 'font-lock-warning-face prepend) (\"\\\\\\=<\\\\(and\\\\|or\\\\|not\\\\)\\\\\\=>\" . - font-lock-keyword-face))))) + 'font-lock-keyword-face))))) The above procedure may fail to add keywords to derived modes if some involved major mode does not follow the standard conventions. diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 9fe8f28a59f..d88862b2d47 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -663,6 +663,7 @@ Element N specifies the summary line for message N+1.") (defvar rmail-last-regexp nil) (put 'rmail-last-regexp 'permanent-local t) +;; Note that rmail-output-read-file-name modifies this. (defcustom rmail-default-file "~/xmail" "Default file name for \\[rmail-output]." :type 'file diff --git a/lisp/mail/rmailout.el b/lisp/mail/rmailout.el index 9c5b99c5184..63cc26360b7 100644 --- a/lisp/mail/rmailout.el +++ b/lisp/mail/rmailout.el @@ -34,7 +34,6 @@ :type 'boolean :group 'rmail-output) -;; FIXME risky? (defcustom rmail-output-file-alist nil "Alist matching regexps to suggested output Rmail files. This is a list of elements of the form (REGEXP . NAME-EXP). @@ -47,6 +46,7 @@ a file name as a string." (string :tag "File Name") sexp))) :group 'rmail-output) +;; This is risky because NAME-EXP gets evalled. ;;;###autoload(put 'rmail-output-file-alist 'risky-local-variable t) (defcustom rmail-fields-not-to-output nil @@ -58,35 +58,57 @@ The function `rmail-delete-unwanted-fields' uses this, ignoring case." (defun rmail-output-read-file-name () "Read the file name to use for `rmail-output'. -Set `rmail-default-file' to this name as well as returning it." - (let ((default-file - (let (answer tail) - (setq tail rmail-output-file-alist) - ;; Suggest a file based on a pattern match. - (while (and tail (not answer)) - (save-excursion - (goto-char (point-min)) - (if (re-search-forward (car (car tail)) nil t) - (setq answer (eval (cdr (car tail))))) - (setq tail (cdr tail)))) +Set `rmail-default-file' to this name as well as returning it. +This uses `rmail-output-file-alist'." + (let* ((default-file + (or + (when rmail-output-file-alist + (or rmail-buffer (error "There is no Rmail buffer")) + (save-current-buffer + (set-buffer rmail-buffer) + (let ((beg (rmail-msgbeg rmail-current-message)) + (end (rmail-msgend rmail-current-message))) + (if (rmail-buffers-swapped-p) (set-buffer rmail-view-buffer)) + (save-excursion + (save-restriction + (widen) + (narrow-to-region beg end) + (let ((tail rmail-output-file-alist) + answer err) + ;; Suggest a file based on a pattern match. + (while (and tail (not answer)) + (goto-char (point-min)) + (if (re-search-forward (caar tail) nil t) + (setq answer + (condition-case err + (eval (cdar tail)) + (error + (display-warning + :error + (format "Error evaluating \ +`rmail-output-file-alist' element:\nregexp: %s\naction: %s\nerror: %S\n" + (caar tail) (cdar tail) err)) + nil)))) + (setq tail (cdr tail))) + answer)))))) ;; If no suggestion, use same file as last time. - (or answer rmail-default-file)))) - (let ((read-file - (expand-file-name - (read-file-name - (concat "Output message to mail file (default " - (file-name-nondirectory default-file) - "): ") - (file-name-directory default-file) - (abbreviate-file-name default-file)) - (file-name-directory default-file)))) - (setq rmail-default-file - (if (file-directory-p read-file) - (expand-file-name (file-name-nondirectory default-file) - read-file) - (expand-file-name - (or read-file (file-name-nondirectory default-file)) - (file-name-directory default-file))))))) + rmail-default-file)) + (read-file + (expand-file-name + (read-file-name + (concat "Output message to mail file (default " + (file-name-nondirectory default-file) + "): ") + (file-name-directory default-file) + (abbreviate-file-name default-file)) + (file-name-directory default-file)))) + (setq rmail-default-file + (if (file-directory-p read-file) + (expand-file-name (file-name-nondirectory default-file) + read-file) + (expand-file-name + (or read-file (file-name-nondirectory default-file)) + (file-name-directory default-file)))))) (defun rmail-delete-unwanted-fields (preserve) "Delete all headers matching `rmail-fields-not-to-output'. diff --git a/lisp/mouse.el b/lisp/mouse.el index 589bbd67b1b..4ea84288f69 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -1951,12 +1951,14 @@ choose a font." (choice ;; Either choice == 'x-select-font, or choice is a ;; symbol whose name is a font. - (buffer-face-mode-invoke (font-face-attributes - (if (eq choice 'x-select-font) - (x-select-font) - (symbol-name choice))) - t - (called-interactively-p 'interactive)))))))) + (let ((font (if (eq choice 'x-select-font) + (x-select-font) + (symbol-name choice)))) + (buffer-face-mode-invoke + (if (fontp font 'font-spec) + (list :font font) + (font-face-attributes font)) + t (called-interactively-p 'interactive))))))))) ;;; Bindings for mouse commands. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index e757247c2a2..6283188d46a 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2738,51 +2738,64 @@ the result will be a local, non-Tramp, filename." (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer))) (name1 name) (i 0)) - (unwind-protect - (save-excursion - (save-restriction - (unless buffer - ;; BUFFER can be nil. We use a temporary buffer. - (setq buffer (generate-new-buffer tramp-temp-buffer-name))) - (while (get-process name1) - ;; NAME must be unique as process name. - (setq i (1+ i) - name1 (format "%s<%d>" name i))) - (setq name name1) - ;; Set the new process properties. - (tramp-set-connection-property v "process-name" name) - (tramp-set-connection-property v "process-buffer" buffer) - ;; Activate narrowing in order to save BUFFER contents. - ;; Clear also the modification time; otherwise we might - ;; be interrupted by `verify-visited-file-modtime'. - (with-current-buffer (tramp-get-connection-buffer v) - (let ((buffer-undo-list t)) + + (unless buffer + ;; BUFFER can be nil. We use a temporary buffer. + (setq buffer (generate-new-buffer tramp-temp-buffer-name))) + (while (get-process name1) + ;; NAME must be unique as process name. + (setq i (1+ i) + name1 (format "%s<%d>" name i))) + (setq name name1) + ;; Set the new process properties. + (tramp-set-connection-property v "process-name" name) + (tramp-set-connection-property v "process-buffer" buffer) + + (with-current-buffer (tramp-get-connection-buffer v) + (unwind-protect + (save-excursion + (save-restriction + ;; Activate narrowing in order to save BUFFER + ;; contents. Clear also the modification time; + ;; otherwise we might be interrupted by + ;; `verify-visited-file-modtime'. + (let ((buffer-undo-list t) + (buffer-read-only nil) + (mark (point))) (clear-visited-file-modtime) (narrow-to-region (point-max) (point-max)) + ;; We call `tramp-maybe-open-connection', in order + ;; to cleanup the prompt afterwards. + (tramp-maybe-open-connection v) + (widen) + (delete-region mark (point)) + (narrow-to-region (point-max) (point-max)) + ;; Now do it. (if command ;; Send the command. (tramp-send-command v command nil t) ; nooutput ;; Check, whether a pty is associated. - (tramp-maybe-open-connection v) (unless (tramp-compat-process-get (tramp-get-connection-process v) 'remote-tty) (tramp-error v 'file-error - "pty association is not supported for `%s'" name))))) - (let ((p (tramp-get-connection-process v))) - ;; Set query flag for this process. - (tramp-compat-set-process-query-on-exit-flag p t) - ;; Return process. - p))) - ;; Save exit. - (with-current-buffer (tramp-get-connection-buffer v) + "pty association is not supported for `%s'" name)))) + (let ((p (tramp-get-connection-process v))) + ;; Set query flag for this process. We ignore errors, + ;; because the process could have finished already. + (ignore-errors + (tramp-compat-set-process-query-on-exit-flag p t)) + ;; Return process. + p))) + + ;; Save exit. (if (string-match tramp-temp-buffer-name (buffer-name)) (progn (set-process-buffer (tramp-get-connection-process v) nil) (kill-buffer (current-buffer))) - (set-buffer-modified-p bmp))) - (tramp-set-connection-property v "process-name" nil) - (tramp-set-connection-property v "process-buffer" nil))))) + (set-buffer-modified-p bmp)) + (tramp-set-connection-property v "process-name" nil) + (tramp-set-connection-property v "process-buffer" nil)))))) (defun tramp-sh-handle-process-file (program &optional infile destination display &rest args) diff --git a/lisp/progmodes/subword.el b/lisp/progmodes/subword.el index 7d8dd4301a2..e541aed8867 100644 --- a/lisp/progmodes/subword.el +++ b/lisp/progmodes/subword.el @@ -80,6 +80,20 @@ ;;; Code: +(defvar subword-forward-function 'subword-forward-internal + "Function to call for forward subword movement.") + +(defvar subword-backward-function 'subword-backward-internal + "Function to call for backward subword movement.") + +(defvar subword-forward-regexp + "\\W*\\(\\([[:upper:]]*\\W?\\)[[:lower:][:digit:]]*\\)" + "Regexp used by `subword-forward-internal'.") + +(defvar subword-backward-regexp + "\\(\\(\\W\\|[[:lower:][:digit:]]\\)\\([[:upper:]]+\\W*\\)\\|\\W\\w+\\)" + "Regexp used by `subword-backward-internal'.") + (defvar subword-mode-map (let ((map (make-sparse-keymap))) (dolist (cmd '(forward-word backward-word mark-word kill-word @@ -138,10 +152,10 @@ Optional argument ARG is the same as for `forward-word'." (cond ((< 0 arg) (dotimes (i arg (point)) - (subword-forward-internal))) + (funcall subword-forward-function))) ((> 0 arg) (dotimes (i (- arg) (point)) - (subword-backward-internal))) + (funcall subword-backward-function))) (t (point)))) @@ -249,9 +263,7 @@ Optional argument ARG is the same as for `capitalize-word'." (if (and (save-excursion (let ((case-fold-search nil)) - (re-search-forward - (concat "\\W*\\(\\([[:upper:]]*\\W?\\)[[:lower:][:digit:]]*\\)") - nil t))) + (re-search-forward subword-forward-regexp nil t))) (> (match-end 0) (point))) (goto-char (cond @@ -265,11 +277,7 @@ Optional argument ARG is the same as for `capitalize-word'." (defun subword-backward-internal () (if (save-excursion (let ((case-fold-search nil)) - (re-search-backward - (concat - "\\(\\(\\W\\|[[:lower:][:digit:]]\\)\\([[:upper:]]+\\W*\\)" - "\\|\\W\\w+\\)") - nil t))) + (re-search-backward subword-backward-regexp nil t))) (goto-char (cond ((and (match-end 3) diff --git a/lisp/simple.el b/lisp/simple.el index 76243a202bc..1080757f7d2 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -3474,16 +3474,36 @@ The argument is used for internal purposes; do not supply one." ;; Yanking. +(defcustom yank-handled-properties + '((font-lock-face . yank-handle-font-lock-face-property) + (category . yank-handle-category-property)) + "List of special text property handling conditions for yanking. +Each element should have the form (PROP . FUN), where PROP is a +property symbol and FUN is a function. When the `yank' command +inserts text into the buffer, it scans the inserted text for +stretches of text that have `eq' values of the text property +PROP; for each such stretch of text, FUN is called with three +arguments: the property's value in that text, and the start and +end positions of the text. + +This is done prior to removing the properties specified by +`yank-excluded-properties'." + :group 'killing + :version "24.3") + ;; This is actually used in subr.el but defcustom does not work there. (defcustom yank-excluded-properties - '(read-only invisible intangible field mouse-face help-echo local-map keymap - yank-handler follow-link fontified) + '(category field follow-link fontified font-lock-face help-echo + intangible invisible keymap local-map mouse-face read-only + yank-handler) "Text properties to discard when yanking. The value should be a list of text properties to discard or t, -which means to discard all text properties." +which means to discard all text properties. + +See also `yank-handled-properties'." :type '(choice (const :tag "All" t) (repeat symbol)) :group 'killing - :version "22.1") + :version "24.3") (defvar yank-window-start nil) (defvar yank-undo-function nil @@ -3535,15 +3555,16 @@ doc string for `insert-for-yank-1', which see." (defun yank (&optional arg) "Reinsert (\"paste\") the last stretch of killed text. -More precisely, reinsert the stretch of killed text most recently -killed OR yanked. Put point at end, and set mark at beginning. -With just \\[universal-argument] as argument, same but put point at beginning (and mark at end). -With argument N, reinsert the Nth most recently killed stretch of killed -text. - -When this command inserts killed text into the buffer, it honors -`yank-excluded-properties' and `yank-handler' as described in the -doc string for `insert-for-yank-1', which see. +More precisely, reinsert the most recent kill, which is the +stretch of killed text most recently killed OR yanked. Put point +at the end, and set mark at the beginning without activating it. +With just \\[universal-argument] as argument, put point at beginning, and mark at end. +With argument N, reinsert the Nth most recent kill. + +When this command inserts text into the buffer, it honors the +`yank-handled-properties' and `yank-excluded-properties' +variables, and the `yank-handler' text property. See +`insert-for-yank-1' for details. See also the command `yank-pop' (\\[yank-pop])." (interactive "*P") diff --git a/lisp/subr.el b/lisp/subr.el index 1e367a155d0..74afd59f8d5 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2805,35 +2805,24 @@ if it's an autoloaded macro." ;;;; Support for yanking and text properties. +(defvar yank-handled-properties) (defvar yank-excluded-properties) (defun remove-yank-excluded-properties (start end) - "Remove `yank-excluded-properties' between START and END positions. -Replaces `category' properties with their defined properties." + "Process text properties between START and END, inserted for a `yank'. +Perform the handling specified by `yank-handled-properties', then +remove properties specified by `yank-excluded-properties'." (let ((inhibit-read-only t)) - ;; Replace any `category' property with the properties it stands - ;; for. This is to remove `mouse-face' properties that are placed - ;; on categories in *Help* buffers' buttons. See - ;; http://lists.gnu.org/archive/html/emacs-devel/2002-04/msg00648.html - ;; for the details. - (unless (memq yank-excluded-properties '(t nil)) - (save-excursion - (goto-char start) - (while (< (point) end) - (let ((cat (get-text-property (point) 'category)) - run-end) - (setq run-end - (next-single-property-change (point) 'category nil end)) - (when cat - (let (run-end2 original) - (remove-list-of-text-properties (point) run-end '(category)) - (while (< (point) run-end) - (setq run-end2 (next-property-change (point) nil run-end)) - (setq original (text-properties-at (point))) - (set-text-properties (point) run-end2 (symbol-plist cat)) - (add-text-properties (point) run-end2 original) - (goto-char run-end2)))) - (goto-char run-end))))) + (dolist (handler yank-handled-properties) + (let ((prop (car handler)) + (fun (cdr handler)) + (run-start start)) + (while (< run-start end) + (let ((value (get-text-property run-start prop)) + (run-end (next-single-property-change + run-start prop nil end))) + (funcall fun value run-start run-end) + (setq run-start run-end))))) (if (eq yank-excluded-properties t) (set-text-properties start end nil) (remove-list-of-text-properties start end yank-excluded-properties)))) @@ -2851,29 +2840,31 @@ See `insert-for-yank-1' for more details." (insert-for-yank-1 string)) (defun insert-for-yank-1 (string) - "Insert STRING at point, stripping some text properties. - -Strip text properties from the inserted text according to -`yank-excluded-properties'. Otherwise just like (insert STRING). - -If STRING has a non-nil `yank-handler' property on the first character, -the normal insert behavior is modified in various ways. The value of -the yank-handler property must be a list with one to four elements -with the following format: (FUNCTION PARAM NOEXCLUDE UNDO). -When FUNCTION is present and non-nil, it is called instead of `insert' - to insert the string. FUNCTION takes one argument--the object to insert. -If PARAM is present and non-nil, it replaces STRING as the object - passed to FUNCTION (or `insert'); for example, if FUNCTION is - `yank-rectangle', PARAM may be a list of strings to insert as a - rectangle. -If NOEXCLUDE is present and non-nil, the normal removal of the + "Insert STRING at point for the `yank' command. +This function is like `insert', except it honors the variables +`yank-handled-properties' and `yank-excluded-properties', and the +`yank-handler' text property. + +Properties listed in `yank-handled-properties' are processed, +then those listed in `yank-excluded-properties' are discarded. + +If STRING has a non-nil `yank-handler' property on its first +character, the normal insert behavior is altered. The value of +the `yank-handler' property must be a list of one to four +elements, of the form (FUNCTION PARAM NOEXCLUDE UNDO). +FUNCTION, if non-nil, should be a function of one argument, an + object to insert; it is called instead of `insert'. +PARAM, if present and non-nil, replaces STRING as the argument to + FUNCTION or `insert'; e.g. if FUNCTION is `yank-rectangle', PARAM + may be a list of strings to insert as a rectangle. +If NOEXCLUDE is present and non-nil, the normal removal of `yank-excluded-properties' is not performed; instead FUNCTION is - responsible for removing those properties. This may be necessary - if FUNCTION adjusts point before or after inserting the object. -If UNDO is present and non-nil, it is a function that will be called + responsible for the removal. This may be necessary if FUNCTION + adjusts point before or after inserting the object. +UNDO, if present and non-nil, should be a function to be called by `yank-pop' to undo the insertion of the current object. It is - called with two arguments, the start and end of the current region. - FUNCTION may set `yank-undo-function' to override the UNDO value." + given two arguments, the start and end of the region. FUNCTION + may set `yank-undo-function' to override UNDO." (let* ((handler (and (stringp string) (get-text-property 0 'yank-handler string))) (param (or (nth 1 handler) string)) @@ -2882,7 +2873,7 @@ If UNDO is present and non-nil, it is a function that will be called end) (setq yank-undo-function t) - (if (nth 0 handler) ;; FUNCTION + (if (nth 0 handler) ; FUNCTION (funcall (car handler) param) (insert param)) (setq end (point)) @@ -2891,34 +2882,17 @@ If UNDO is present and non-nil, it is a function that will be called ;; following text property changes. (setq inhibit-read-only t) - ;; What should we do with `font-lock-face' properties? - (if font-lock-defaults - ;; No, just wipe them. - (remove-list-of-text-properties opoint end '(font-lock-face)) - ;; Convert them to `face'. - (save-excursion - (goto-char opoint) - (while (< (point) end) - (let ((face (get-text-property (point) 'font-lock-face)) - run-end) - (setq run-end - (next-single-property-change (point) 'font-lock-face nil end)) - (when face - (remove-text-properties (point) run-end '(font-lock-face nil)) - (put-text-property (point) run-end 'face face)) - (goto-char run-end))))) - - (unless (nth 2 handler) ;; NOEXCLUDE - (remove-yank-excluded-properties opoint (point))) + (unless (nth 2 handler) ; NOEXCLUDE + (remove-yank-excluded-properties opoint end)) ;; If last inserted char has properties, mark them as rear-nonsticky. (if (and (> end opoint) (text-properties-at (1- end))) (put-text-property (1- end) end 'rear-nonsticky t)) - (if (eq yank-undo-function t) ;; not set by FUNCTION - (setq yank-undo-function (nth 3 handler))) ;; UNDO - (if (nth 4 handler) ;; COMMAND + (if (eq yank-undo-function t) ; not set by FUNCTION + (setq yank-undo-function (nth 3 handler))) ; UNDO + (if (nth 4 handler) ; COMMAND (setq this-command (nth 4 handler))))) (defun insert-buffer-substring-no-properties (buffer &optional start end) @@ -2944,6 +2918,27 @@ Strip text properties from the inserted text according to (insert-buffer-substring buffer start end) (remove-yank-excluded-properties opoint (point)))) +(defun yank-handle-font-lock-face-property (face start end) + "If `font-lock-defaults' is nil, apply FACE as a `face' property. +START and END denote the start and end of the text to act on. +Do nothing if FACE is nil." + (and face + (null font-lock-defaults) + (put-text-property start end 'face face))) + +;; This removes `mouse-face' properties in *Help* buffer buttons: +;; http://lists.gnu.org/archive/html/emacs-devel/2002-04/msg00648.html +(defun yank-handle-category-property (category start end) + "Apply property category CATEGORY's properties between START and END." + (when category + (let ((start2 start)) + (while (< start2 end) + (let ((end2 (next-property-change start2 nil end)) + (original (text-properties-at start2))) + (set-text-properties start2 end2 (symbol-plist category)) + (add-text-properties start2 end2 original) + (setq start2 end2)))))) + ;;;; Synchronous shell commands. diff --git a/lisp/vc/vc-mtn.el b/lisp/vc/vc-mtn.el index 67c0f985ae1..8429b2b213d 100644 --- a/lisp/vc/vc-mtn.el +++ b/lisp/vc/vc-mtn.el @@ -305,29 +305,28 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." ids))) (defun vc-mtn-revision-completion-table (_files) - ;; TODO: Implement completion for selectors - ;; TODO: Implement completion for composite selectors. ;; What about using `files'?!? --Stef (lambda (string pred action) (cond + ;; Special chars for composite selectors. + ((string-match ".*[^\\]\\(\\\\\\\\\\)*[/|;(]" string) + (completion-table-with-context (substring string 0 (match-end 0)) + (vc-mtn-revision-completion-table nil) + (substring string (match-end 0)) + pred action)) ;; "Tag" selectors. ((string-match "\\`t:" string) (complete-with-action action (mapcar (lambda (tag) (concat "t:" tag)) (vc-mtn-list-tags)) string pred)) - ;; "Branch" selectors. - ((string-match "\\`b:" string) - (complete-with-action action - (mapcar (lambda (tag) (concat "b:" tag)) - (vc-mtn-list-branches)) - string pred)) - ;; "Head" selectors. Not sure how they differ from "branch" selectors. - ((string-match "\\`h:" string) - (complete-with-action action - (mapcar (lambda (tag) (concat "h:" tag)) - (vc-mtn-list-branches)) - string pred)) + ;; "Branch" or "Head" selectors. + ((string-match "\\`[hb]:" string) + (let ((prefix (match-string 0 string))) + (complete-with-action action + (mapcar (lambda (tag) (concat prefix tag)) + (vc-mtn-list-branches)) + string pred))) ;; "ID" selectors. ((string-match "\\`i:" string) (complete-with-action action @@ -339,7 +338,13 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (complete-with-action action '("t:" "b:" "h:" "i:" ;; Completion not implemented for these. - "a:" "c:" "d:" "e:" "l:") + "c:" "a:" "k:" "d:" "m:" "e:" "l:" "i:" "p:" + ;; These have no arg to complete. + "u:" "w:" + ;; Selector functions. + "difference(" "lca(" "max(" "ancestors(" + "descendants(" "parents(" "children(" + "pick(") string pred))))) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 87028194aa2..ddb9565544d 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1652,8 +1652,9 @@ Return t if the buffer had changes, nil otherwise." (setq rev1-default (vc-working-revision first))) ;; if the file is not locked, use last and previous revisions as defaults (t - (setq rev1-default (vc-call-backend backend 'previous-revision first - (vc-working-revision first))) + (setq rev1-default (ignore-errors ;If `previous-revision' doesn't work. + (vc-call-backend backend 'previous-revision first + (vc-working-revision first)))) (when (string= rev1-default "") (setq rev1-default nil)) (setq rev2-default (vc-working-revision first)))) ;; construct argument list diff --git a/lisp/window.el b/lisp/window.el index 5682e7e909a..142e80e1666 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -91,11 +91,13 @@ be any window." (and window (window-parent window) (window-prev-sibling window))) (defun window-child (window) - "Return WINDOW's first child window." + "Return WINDOW's first child window. +WINDOW can be any window." (or (window-top-child window) (window-left-child window))) (defun window-child-count (window) - "Return number of WINDOW's child windows." + "Return number of WINDOW's child windows. +WINDOW can be any window." (let ((count 0)) (when (and (windowp window) (setq window (window-child window))) (while window @@ -104,20 +106,13 @@ be any window." count)) (defun window-last-child (window) - "Return last child window of WINDOW." + "Return last child window of WINDOW. +WINDOW can be any window." (when (and (windowp window) (setq window (window-child window))) (while (window-next-sibling window) (setq window (window-next-sibling window)))) window) -(defun window-valid-p (object) - "Return t if OBJECT denotes a live window or internal window. -Otherwise, return nil; this includes the case where OBJECT is a -deleted window." - (and (windowp object) - (or (window-buffer object) (window-child object)) - t)) - (defun window-normalize-buffer (buffer-or-name) "Return buffer specified by BUFFER-OR-NAME. BUFFER-OR-NAME must be either a buffer or a string naming a live @@ -143,20 +138,22 @@ FRAME must be a live frame and defaults to the selected frame." (selected-frame))) (defun window-normalize-window (window &optional live-only) - "Return window specified by WINDOW. -If WINDOW is nil, return `selected-window'. -If WINDOW is a live window or internal window, return WINDOW; - if LIVE-ONLY is non-nil, return WINDOW for a live window only. + "Return the window specified by WINDOW. +If WINDOW is nil, return the selected window. Otherwise, if +WINDOW is a live or an internal window, return WINDOW; if +LIVE-ONLY is non-nil, return WINDOW for a live window only. Otherwise, signal an error." - (cond ((null window) - (selected-window)) - (live-only - (if (window-live-p window) - window - (error "%s is not a live window" window))) - ((if (window-valid-p window) - window - (error "%s is not a window" window))))) + (cond + ((null window) + (selected-window)) + (live-only + (if (window-live-p window) + window + (error "%s is not a live window" window))) + ((window-valid-p window) + window) + (t + (error "%s is not a valid window" window)))) (defvar ignore-window-parameters nil "If non-nil, standard functions ignore window parameters. @@ -207,7 +204,7 @@ narrower, explicitly specify the SIZE argument of that function." (defun window-combined-p (&optional window horizontal) "Return non-nil if WINDOW has siblings in a given direction. -If WINDOW is omitted or nil, it defaults to the selected window. +WINDOW must be a valid window and defaults to the selected one. HORIZONTAL determines a direction for the window combination. If HORIZONTAL is omitted or nil, return non-nil if WINDOW is part @@ -223,7 +220,7 @@ horizontal window combination." (defun window-combinations (window &optional horizontal) "Return largest number of windows vertically arranged within WINDOW. -If WINDOW is omitted or nil, it defaults to the selected window. +WINDOW must be a valid window and defaults to the selected one. If HORIZONTAL is non-nil, return the largest number of windows horizontally arranged within WINDOW." (setq window (window-normalize-window window)) @@ -321,7 +318,7 @@ too." ;;; Atomic windows. (defun window-atom-root (&optional window) "Return root of atomic window WINDOW is a part of. -WINDOW can be any window and defaults to the selected one. +WINDOW must be a valid window and defaults to the selected one. Return nil if WINDOW is not part of an atomic window." (setq window (window-normalize-window window)) (let (root) @@ -525,10 +522,10 @@ window).") (defun window-min-size (&optional window horizontal ignore) "Return the minimum size of WINDOW. -WINDOW can be an arbitrary window and defaults to the selected -one. Optional argument HORIZONTAL non-nil means return the -minimum number of columns of WINDOW; otherwise return the minimum -number of WINDOW's lines. +WINDOW must be a valid window and defaults to the selected one. +Optional argument HORIZONTAL non-nil means return the minimum +number of columns of WINDOW; otherwise return the minimum number +of WINDOW's lines. Optional argument IGNORE, if non-nil, means ignore restrictions imposed by fixed size windows, `window-min-height' or @@ -608,6 +605,7 @@ means ignore all of the above restrictions for all windows." (defun window-sizable (window delta &optional horizontal ignore) "Return DELTA if DELTA lines can be added to WINDOW. +WINDOW must be a valid window and defaults to the selected one. Optional argument HORIZONTAL non-nil means return DELTA if DELTA columns can be added to WINDOW. A return value of zero means that no lines (or columns) can be added to WINDOW. @@ -649,6 +647,7 @@ ignore all of the above restrictions for all windows." (defun window-sizable-p (window delta &optional horizontal ignore) "Return t if WINDOW can be resized by DELTA lines. +WINDOW must be a valid window and defaults to the selected one. For the meaning of the arguments of this function see the doc-string of `window-sizable'." (setq window (window-normalize-window window)) @@ -691,9 +690,9 @@ doc-string of `window-sizable'." (defun window-size-fixed-p (&optional window horizontal) "Return non-nil if WINDOW's height is fixed. -WINDOW can be an arbitrary window and defaults to the selected -window. Optional argument HORIZONTAL non-nil means return -non-nil if WINDOW's width is fixed. +WINDOW must be a valid window and defaults to the selected one. +Optional argument HORIZONTAL non-nil means return non-nil if +WINDOW's width is fixed. If this function returns nil, this does not necessarily mean that WINDOW can be resized in the desired direction. The function @@ -741,8 +740,8 @@ WINDOW can be resized in the desired direction. The function (defun window-min-delta (&optional window horizontal ignore trail noup nodown) "Return number of lines by which WINDOW can be shrunk. -WINDOW can be an arbitrary window and defaults to the selected -window. Return zero if WINDOW cannot be shrunk. +WINDOW must be a valid window and defaults to the selected one. +Return zero if WINDOW cannot be shrunk. Optional argument HORIZONTAL non-nil means return number of columns by which WINDOW can be shrunk. @@ -823,8 +822,8 @@ at least one other window can be enlarged appropriately." (defun window-max-delta (&optional window horizontal ignore trail noup nodown) "Return maximum number of lines by which WINDOW can be enlarged. -WINDOW can be an arbitrary window and defaults to the selected -window. The return value is zero if WINDOW cannot be enlarged. +WINDOW must be a valid window and defaults to the selected one. +The return value is zero if WINDOW cannot be enlarged. Optional argument HORIZONTAL non-nil means return maximum number of columns by which WINDOW can be enlarged. @@ -861,6 +860,7 @@ only whether other windows can be shrunk appropriately." ;; Make NOUP also inhibit the min-size check. (defun window--resizable (window delta &optional horizontal ignore trail noup nodown) "Return DELTA if WINDOW can be resized vertically by DELTA lines. +WINDOW must be a valid window and defaults to the selected one. Optional argument HORIZONTAL non-nil means return DELTA if WINDOW can be resized horizontally by DELTA columns. A return value of zero means that WINDOW is not resizable. @@ -907,6 +907,7 @@ violate size restrictions of WINDOW or its child windows." (defun window--resizable-p (window delta &optional horizontal ignore trail noup nodown) "Return t if WINDOW can be resized vertically by DELTA lines. +WINDOW must be a valid window and defaults to the selected one. For the meaning of the arguments of this function see the doc-string of `window--resizable'." (setq window (window-normalize-window window)) @@ -918,6 +919,7 @@ doc-string of `window--resizable'." (defun window-resizable (window delta &optional horizontal ignore) "Return DELTA if WINDOW can be resized vertically by DELTA lines. +WINDOW must be a valid window and defaults to the selected one. Optional argument HORIZONTAL non-nil means return DELTA if WINDOW can be resized horizontally by DELTA columns. A return value of zero means that WINDOW is not resizable. @@ -944,7 +946,7 @@ means ignore all of the above restrictions for all windows." (defun window-total-size (&optional window horizontal) "Return the total height or width of WINDOW. -If WINDOW is omitted or nil, it defaults to the selected window. +WINDOW must be a valid window and defaults to the selected one. If HORIZONTAL is omitted or nil, return the total height of WINDOW, in lines, like `window-total-height'. Otherwise return @@ -961,8 +963,8 @@ the total width, in columns, like `window-total-width'." "Return t if WINDOW is as high as its containing frame. More precisely, return t if and only if the total height of WINDOW equals the total height of the root window of WINDOW's -frame. WINDOW can be any window and defaults to the selected -one." +frame. WINDOW must be a valid window and defaults to the +selected one." (setq window (window-normalize-window window)) (= (window-total-size window) (window-total-size (frame-root-window window)))) @@ -971,15 +973,14 @@ one." "Return t if WINDOW is as wide as its containing frame. More precisely, return t if and only if the total width of WINDOW equals the total width of the root window of WINDOW's frame. -WINDOW can be any window and defaults to the selected one." +WINDOW must be a valid window and defaults to the selected one." (setq window (window-normalize-window window)) (= (window-total-size window t) (window-total-size (frame-root-window window) t))) (defun window-body-size (&optional window horizontal) "Return the height or width of WINDOW's text area. -If WINDOW is omitted or nil, it defaults to the selected window. -Signal an error if the window is not live. +WINDOW must be a live window and defaults to the selected one. If HORIZONTAL is omitted or nil, return the height of the text area, like `window-body-height'. Otherwise, return the width of @@ -1089,9 +1090,9 @@ regardless of whether that buffer is current or not." (defun window-at-side-p (&optional window side) "Return t if WINDOW is at SIDE of its containing frame. -WINDOW can be any window and defaults to the selected one. SIDE -can be any of the symbols `left', `top', `right' or `bottom'. -The default value nil is handled like `bottom'." +WINDOW must be a valid window and defaults to the selected one. +SIDE can be any of the symbols `left', `top', `right' or +`bottom'. The default value nil is handled like `bottom'." (setq window (window-normalize-window window)) (let ((edge (cond @@ -2027,7 +2028,8 @@ any windows." (defun adjust-window-trailing-edge (window delta &optional horizontal) "Move WINDOW's bottom edge by DELTA lines. Optional argument HORIZONTAL non-nil means move WINDOW's right -edge by DELTA columns. WINDOW defaults to the selected window. +edge by DELTA columns. WINDOW must be a valid window and +defaults to the selected one. If DELTA is greater than zero, move the edge downwards or to the right. If DELTA is less than zero, move the edge upwards or to @@ -2211,7 +2213,7 @@ Return nil." (defun maximize-window (&optional window) "Maximize WINDOW. Make WINDOW as large as possible without deleting any windows. -WINDOW can be any window and defaults to the selected window." +WINDOW must be a valid window and defaults to the selected one." (interactive) (setq window (window-normalize-window window)) (window-resize window (window-max-delta window)) @@ -2220,7 +2222,7 @@ WINDOW can be any window and defaults to the selected window." (defun minimize-window (&optional window) "Minimize WINDOW. Make WINDOW as small as possible without deleting any windows. -WINDOW can be any window and defaults to the selected window." +WINDOW must be a valid window and defaults to the selected one." (interactive) (setq window (window-normalize-window window)) (window-resize window (- (window-min-delta window))) @@ -2376,8 +2378,8 @@ and no others." ;;; Deleting windows. (defun window-deletable-p (&optional window) "Return t if WINDOW can be safely deleted from its frame. -Return `frame' if deleting WINDOW should also delete its -frame." +WINDOW must be a valid window and defaults to the selected one. +Return `frame' if deleting WINDOW should also delete its frame." (setq window (window-normalize-window window)) (unless ignore-window-parameters @@ -2415,8 +2417,8 @@ frame." (defun delete-window (&optional window) "Delete WINDOW. -WINDOW can be an arbitrary window and defaults to the selected -one. Return nil. +WINDOW must be a valid window and defaults to the selected one. +Return nil. If the variable `ignore-window-parameters' is non-nil or the `delete-window' parameter of WINDOW equals t, do not process any @@ -2427,8 +2429,9 @@ function. Otherwise, if WINDOW is part of an atomic window, call `delete-window' with the root of the atomic window as its -argument. If WINDOW is the only window on its frame or the last -non-side window, signal an error." +argument. Signal an error if WINDOW is either the only window on +its frame, the last non-side window, or part of an atomic window +that is its frame's root window." (interactive) (setq window (window-normalize-window window)) (let* ((frame (window-frame window)) @@ -2495,7 +2498,7 @@ non-side window, signal an error." (defun delete-other-windows (&optional window) "Make WINDOW fill its frame. -WINDOW may be any window and defaults to the selected one. +WINDOW must be a valid window and defaults to the selected one. Return nil. If the variable `ignore-window-parameters' is non-nil or the @@ -2638,11 +2641,13 @@ WINDOW." (defun set-window-buffer-start-and-point (window buffer &optional start point) "Set WINDOW's buffer to BUFFER. +WINDOW must be a live window and defaults to the selected one. Optional argument START non-nil means set WINDOW's start position to START. Optional argument POINT non-nil means set WINDOW's point to POINT. If WINDOW is selected this also sets BUFFER's `point' to POINT. If WINDOW is selected and the buffer it showed before was current this also makes BUFFER the current buffer." + (setq window (window-normalize-window window t)) (let ((selected (eq window (selected-window))) (current (eq (window-buffer window) (current-buffer)))) (set-window-buffer window buffer) @@ -2956,16 +2961,24 @@ displayed there." (defun next-buffer () "In selected window switch to next buffer." (interactive) - (if (window-minibuffer-p) - (error "Cannot switch buffers in minibuffer window")) - (switch-to-next-buffer)) + (cond + ((window-minibuffer-p) + (error "Cannot switch buffers in minibuffer window")) + ((eq (window-dedicated-p) t) + (error "Window is strongly dedicated to its buffer")) + (t + (switch-to-next-buffer)))) (defun previous-buffer () "In selected window switch to previous buffer." (interactive) - (if (window-minibuffer-p) - (error "Cannot switch buffers in minibuffer window")) - (switch-to-prev-buffer)) + (cond + ((window-minibuffer-p) + (error "Cannot switch buffers in minibuffer window")) + ((eq (window-dedicated-p) t) + (error "Window is strongly dedicated to its buffer")) + (t + (switch-to-prev-buffer)))) (defun delete-windows-on (&optional buffer-or-name frame) "Delete all windows showing BUFFER-OR-NAME. @@ -3138,7 +3151,7 @@ Optional argument HORIZONTAL non-nil means return minimum width." (defun split-window (&optional window size side) "Make a new window adjacent to WINDOW. -WINDOW can be any window and defaults to the selected one. +WINDOW must be a valid window and defaults to the selected one. Return the new window which is always a live window. Optional argument SIZE a positive number means make WINDOW SIZE @@ -3459,7 +3472,7 @@ right, if any." (defun balance-windows-2 (window horizontal) "Subroutine of `balance-windows-1'. WINDOW must be a vertical combination (horizontal if HORIZONTAL -is non-nil." +is non-nil)." (let* ((first (window-child window)) (sub first) (number-of-children 0) @@ -5187,9 +5200,9 @@ documentation for additional customization information." (defun set-window-text-height (window height) "Set the height in lines of the text display area of WINDOW to HEIGHT. -WINDOW must be a live window. HEIGHT doesn't include the mode -line or header line, if any, or any partial-height lines in the -text display area. +WINDOW must be a live window and defaults to the selected one. +HEIGHT doesn't include the mode line or header line, if any, or +any partial-height lines in the text display area. Note that the current implementation of this function cannot always set the height exactly, but attempts to be conservative, @@ -5256,7 +5269,9 @@ in some window." (1+ (vertical-motion (buffer-size) window)))))) (defun window-buffer-height (window) - "Return the height (in screen lines) of the buffer that WINDOW is displaying." + "Return the height (in screen lines) of the buffer that WINDOW is displaying. +WINDOW must be a live window and defaults to the selected one." + (setq window (window-normalize-window window t)) (with-current-buffer (window-buffer window) (max 1 (count-screen-lines (point-min) (point-max) @@ -5268,7 +5283,7 @@ in some window." ;;; Resizing buffers to fit their contents exactly. (defun fit-window-to-buffer (&optional window max-height min-height override) "Adjust height of WINDOW to display its buffer's contents exactly. -WINDOW can be any live window and defaults to the selected one. +WINDOW must be a live window and defaults to the selected one. Optional argument MAX-HEIGHT specifies the maximum height of WINDOW and defaults to the height of WINDOW's frame. Optional @@ -5387,7 +5402,7 @@ WINDOW defaults to the selected window." "Shrink height of WINDOW if its buffer doesn't need so many lines. More precisely, shrink WINDOW vertically to be as small as possible, while still showing the full contents of its buffer. -WINDOW defaults to the selected window. +WINDOW must be a live window and defaults to the selected one. Do not shrink WINDOW to less than `window-min-height' lines. Do nothing if the buffer contains more lines than the present window @@ -5809,13 +5824,12 @@ is active. This function is run by `mouse-autoselect-window-timer'." (defun truncated-partial-width-window-p (&optional window) "Return non-nil if lines in WINDOW are specifically truncated due to its width. -WINDOW defaults to the selected window. +WINDOW must be a live window and defaults to the selected one. Return nil if WINDOW is not a partial-width window (regardless of the value of `truncate-lines'). Otherwise, consult the value of `truncate-partial-width-windows' for the buffer shown in WINDOW." - (unless window - (setq window (selected-window))) + (setq window (window-normalize-window window t)) (unless (window-full-width-p window) (let ((t-p-w-w (buffer-local-value 'truncate-partial-width-windows (window-buffer window)))) diff --git a/lisp/xml.el b/lisp/xml.el index 179fdd6b5cc..d395f75ec0f 100644 --- a/lisp/xml.el +++ b/lisp/xml.el @@ -1011,13 +1011,25 @@ The first line is indented with the optional INDENT-STRING." (defalias 'xml-print 'xml-debug-print) (defun xml-escape-string (string) - "Return STRING with entity substitutions made from `xml-entity-alist'." - (mapconcat (lambda (byte) - (let ((char (char-to-string byte))) - (if (rassoc char xml-entity-alist) - (concat "&" (car (rassoc char xml-entity-alist)) ";") - char))) - string "")) + "Convert STRING into a string containing valid XML character data. +Replace occurrences of &<>'\" in STRING with their default XML +entity references (e.g. replace each & with &). + +XML character data must not contain & or < characters, nor the > +character under some circumstances. The XML spec does not impose +restriction on \" or ', but we just substitute for these too +\(as is permitted by the spec)." + (with-temp-buffer + (insert string) + (dolist (substitution '(("&" . "&") + ("<" . "<") + (">" . ">") + ("'" . "'") + ("\"" . """))) + (goto-char (point-min)) + (while (search-forward (car substitution) nil t) + (replace-match (cdr substitution) t t nil))) + (buffer-string))) (defun xml-debug-print-internal (xml indent-string) "Outputs the XML tree in the current buffer. |