diff options
Diffstat (limited to 'lisp')
37 files changed, 847 insertions, 444 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index df930a970d..3ce47461c4 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,270 @@ +2005-03-15 Juri Linkov <[email protected]> + + * isearch.el (isearch-error): New variable. + (isearch-invalid-regexp, isearch-within-brackets): Remove. + (isearch-error-state): Renamed from `isearch-invalid-regexp-state'. + (isearch-within-brackets-state): Remove. + (isearch-case-fold-search-state, isearch-pop-fun-state): + Decrease frame index. + (isearch-mode, isearch-top-state, isearch-push-state) + (isearch-edit-string, isearch-abort, isearch-search-and-update) + (isearch-fallback, isearch-message-prefix, isearch-message-suffix) + (isearch-search, isearch-lazy-highlight-new-loop): + Replace `isearch-invalid-regexp' with `isearch-error'. + Remove `isearch-within-brackets'. + (isearch-search): Add `search-failed' handler to `condition-case'. + (isearch-lazy-highlight-search): Add `condition-case' to catch + errors and allow `isearch-lazy-highlight-update' to try + highlighting from the beginning of the window. + (isearch-repeat): Move up code to set isearch-wrapped to t + before calling isearch-wrap-function. + + * info.el (Info-isearch-initial-node): New internal variable. + (Info-search): Signal an error in isearch mode when search leaves + the initial node. Signal an error when `bound' is non-nil and + nothing was found in the current subfile. + (Info-isearch-search): Remove `condition-case'. + (Info-isearch-wrap): Don't wrap when search failed during leaving + the initial node. If `Info-isearch-search' is nil, wrap around + the current node. + (Info-isearch-start): New fun. + (Info-mode): Add buffer-local hook `Info-isearch-start' to + `isearch-mode-hook'. + +2005-03-15 YAMAMOTO Mitsuharu <[email protected]> + + * simple.el (normal-erase-is-backspace): Set default to t if + running on Mac. + + * term/mac-win.el (function-key-map): Sync with x-win.el. + +2005-03-15 Kenichi Handa <[email protected]> + + * international/mule-cmds.el (locale-language-names): Modify the + format of elements and add more entries. + (locale-preferred-coding-systems): Add more entries. + (set-locale-environment): Adjusted for the change of + locale-language-names. + +2005-03-14 Stefan Monnier <[email protected]> + + * pcvs.el (smerge-ediff): Remove bogus autoload. + +2005-03-14 Lute Kamstra <[email protected]> + + * emacs-lisp/debug.el (debugger-make-xrefs): Docstring fix. + Ignore a `*' at the beginning of a line. + + * subr.el (macro-declaration-function): Move to emacs-lisp/byte-run.el. + * emacs-lisp/byte-run.el (macro-declaration-function): Move from + subr.el. + (dont-compile, eval-when-compile, eval-and-compile): Use declare + to specify indentation. + + * generic.el (define-generic-mode): Let generic-mode-list be a + list of strings; test membership with equal. + +2005-03-14 Kim F. Storm <[email protected]> + + * simple.el (next-line, previous-line): Add optional try-vscroll + arg to recognize interactive use. Pass it on to line-move. + (line-move): Don't perform auto-window-vscroll when defining or + executing keyboard macro to ensure consistent behaviour. + +2005-03-13 Stefan Monnier <[email protected]> + + * pcvs-util.el (cvs-string->strings): Strip trailing whitespace. + +2005-03-13 Lute Kamstra <[email protected]> + + * emacs-lisp/debug.el (debug): Set debug-on-exit before calling + debugger-setup-buffer so that backtrace marks the frames set to + debug-on-exit and we don't have to do it manually. Set an extra + debug-on-exit for macro's. + (debugger-setup-buffer): Don't mark the top frame manually. + +2005-03-12 Lute Kamstra <[email protected]> + + * emacs-lisp/byte-run.el: Replace lisp-indent-hook with + lisp-indent-function throughout. + (with-no-warnings): Set lisp-indent-function property. + +2005-03-12 Thien-Thi Nguyen <[email protected]> + + * progmodes/dcl-mode.el (dcl-mode-syntax-table): + Add entry for backslash. + +2005-03-12 Juri Linkov <[email protected]> + + * info.el (Info-search): Four fixes for backward search. + +2005-03-11 Jay Belanger <[email protected]> + + * calc/calc.el (calc-language-alist): New variable. + * calc/calc-embed.el (calc-embedded-language-alist): Remove. + (calc-embedded-find-modes): Use calc-language-alist instead of + calc-embedded-language-alist. + +2005-03-11 Glenn Morris <[email protected]> + + * calendar/calendar.el (calendar-redrawing): New internal + variable. + (redraw-calendar): Remove bogus save-excursion from previous + change. Bind calendar-redrawing to t for mark-diary-entries. + * calendar/diary-lib.el (mark-diary-entries): No need to redraw + calendar if that is why we were called. + +2005-03-11 Kenichi Handa <[email protected]> + + * international/mule.el (make-coding-system): Set property + 'coding-system-define-form to nil. + (define-coding-system-alias): Likewise. + +2005-03-11 Kenichi Handa <[email protected]> + + These changes are suggested by Dave Love <[email protected]>. + + * textmodes/fill.el: Change encoding to iso-2022-7bit and add + coding: tag. + (adaptive-fill-regexp): Add more bullets. + (fill-french-nobreak-p): Add Latin-1 and Latin-9 guillemets in + regexps. + +2005-03-10 Stefan Monnier <[email protected]> + + * help.el (describe-mode): Properly handle non-trivial lighters. + Don't ignore minor modes that are not listed in minor-mode-list. + + * tooltip.el (tooltip-mode): Don't complain that you can't turn the + feature ON when the user requests to turn it OFF. + +2005-03-10 Lute Kamstra <[email protected]> + + * emacs-lisp/debug.el (debug-entry-code): Delete it. + (implement-debug-on-entry): New function to replace debug-entry-code. + (debug-on-entry-1): Use implement-debug-on-entry. Delete the + second argument as the 2005-03-07 change makes it obsolete. + (debug-on-entry, cancel-debug-on-entry): Update call to + debug-on-entry-1. + (debug, debugger-setup-buffer): Comment update. + (debugger-frame-number): Update to work with implement-debug-on-entry. + +2005-03-10 Jay Belanger <[email protected]> + + * calc/calc-embed.el (math-ms-args): Declare it. + (calc-embedded-eval-expr, calc-embedded-eval-get-var): Use variable + math-ms-args. + (calc-embedded-subst): Use math-multi-subst-rec to substitute + variables. + +2005-03-10 Nick Roberts <[email protected]> + + * progmodes/gdb-ui.el (gdb-var-create-handler, gdb-get-location): + Use message-box. + + * tooltip.el (tooltip-mode): Use define-minor-mode and simplify. + (tooltip-activate-mouse-motions-if-enabled): Use dolist. + (tooltip-gud-tips): Simplify. + (tooltip-gud-tips-p): Remove superflouous :set. + (tooltip-gud-modes): Add fortran-mode. + (gdb-tooltip-print): Remove newline for tooltip-use-echo-area. + + * bindings.el (mode-line-mode-menu): Add tooltip-mode to mode-line. + +2005-03-09 Kim F. Storm <[email protected]> + + * play/animate.el (animate-place-char): Use forward-line instead + of next-line to improve performance. + +2005-03-09 Simon Josefsson <[email protected]> + + * net/browse-url.el (browse-url-default-browser): Doc fix. + +2005-03-09 Miles Bader <[email protected]> + + * emacs-lisp/bytecomp.el (byte-compile-variable-ref) + (byte-compile-obsolete): Change " since VER" to " (as of Emacs VER)". + +2005-03-09 Kenichi Handa <[email protected]> + + * international/latin-1.el: Set case and syntax for 255 only if + set-case-syntax-set-multibyte is nil. + + * textmodes/ispell.el (ispell-insert-word): New function. + (ispell-word): Use ispell-insert-word to insert a new word. + (ispell-process-line): Likewise. + (ispell-complete-word): Likewise. + +2005-03-09 Glenn Morris <[email protected]> + + * calendar/calendar.el (redraw-calendar): Preserve point. + Reported by Matt Hodges <[email protected]>. + (calendar-week-start-day): Move after definition of + redraw-calendar. Delete buffer test, since redraw-calendar has + that now. + + * calendar/diary-lib.el (mark-diary-entries): Only call + redraw-calendar in the first of any recursive calls. + Reported by Alan Shutko <[email protected]>. + +2005-03-08 Juri Linkov <[email protected]> + + * textmodes/sgml-mode.el (sgml-tag, html-tag-alist) + (html-horizontal-rule, html-line, html-image, html-checkboxes) + (html-radio-buttons): Add a space before the trailing `/>' where + sgml-xml-mode is non-nil. + (sgml-delete-tag): Check if the tag ends with `/>' to not delete + the subsequent tag of the empty XML tag. + (html-href-anchor): Don't set initial input to "http:". + (html-image): Ask for the image URL and set point inside alt="". + (html-name-anchor): Duplicate the name in the `id' attribute when + sgml-xml-mode is non-nil. + (html-paragraph): Remove \n before <p>. + (html-checkboxes, html-radio-buttons): Insert `checked="checked"' + instead of `checked' when sgml-xml-mode is non-nil. + + * facemenu.el (list-colors-print): Print #RRGGBB in default face. + Remove 1 space before #RRGGBB to not truncate it on terminal + windows w/o fringes. Remove 1 space between bg and fg examples + to get more space. + (list-colors-duplicates): Replace `and' with `if' for `boundp' to + avoid byte-compile warnings. + + * image-file.el (image-file-handler): Put `safe-magic' property to + `image-file-handler'. + + * info.el (Info-isearch-search): Emulate word search in + isearching through multiple Info nodes with Info-search. + (Info-isearch-wrap): Allow isearch-word. + +2005-03-08 Lute Kamstra <[email protected]> + + * emacs-lisp/debug.el (debugger-step-through): Make sure that + stepping into the debugger's code is not possible. + (debugger-jumping-flag): Docstring update. + +2005-03-08 Jay Belanger <[email protected]> + + * calc/calc-embed.el (calc-do-embedded): Reset mode line when + embedded mode begins. + (calc-embedded-language-alist): New variable. + (calc-embedded-find-modes): Use calc-embedded-language-alist to + set default language mode. + +2005-03-08 Kenichi Handa <[email protected]> + + * international/ccl.el (define-ccl-program): Fix docstring about + extra 256 bytes assured for the output buffer. + + * international/utf-16.el (ccl-encode-mule-utf-16le-with-signature): + Fix BUFFER_MAGNIFICATION to 2. + (ccl-encode-mule-utf-16be-with-signature): Likewise. + +2005-03-07 Karl Chen <[email protected]> + + * align.el (align-rules-list): Added an alignment rule for CSS + declarations (applies to css-mode and html-mode buffers). + 2005-03-07 Stefan Monnier <[email protected]> * emacs-lisp/debug.el (debug-on-entry-1): Fix handling of macros. @@ -191,8 +458,7 @@ that debug-entry-code can be safely removed from a function while this code is being evaluated. Revert the 2005-02-27 change as the new implementation no longer requires it. Make sure that a - function body containing just a string is not mistaken for a - docstring. + function body containing just a string is not mistaken for a docstring. (debug): Skip one more frame in case of debug on entry. (debugger-setup-buffer): Delete one more frame line in case of debug on entry. diff --git a/lisp/align.el b/lisp/align.el index 5e739c8f7c..5238a75807 100644 --- a/lisp/align.el +++ b/lisp/align.el @@ -466,13 +466,13 @@ The possible settings for `align-region-separate' are: (repeat . t) (modes . align-c++-modes) (run-if . ,(function (lambda () current-prefix-arg)))) -; (valid -; . ,(function -; (lambda () -; (memq (caar (c-guess-basic-syntax)) -; '(brace-list-intro -; brace-list-entry -; brace-entry-open)))))) + ; (valid + ; . ,(function + ; (lambda () + ; (memq (caar (c-guess-basic-syntax)) + ; '(brace-list-intro + ; brace-list-entry + ; brace-entry-open)))))) ;; With a prefix argument, comma delimiter will be aligned. Since ;; perl-mode doesn't give us enough syntactic information (and we @@ -525,11 +525,11 @@ The possible settings for `align-region-separate' are: (regexp . "\\(\\s-*\\)\\\\$") (modes . align-c++-modes) (column . c-backslash-column)) -; (valid -; . ,(function -; (lambda () -; (memq (caar (c-guess-basic-syntax)) -; '(cpp-macro cpp-macro-cont)))))) + ; (valid + ; . ,(function + ; (lambda () + ; (memq (caar (c-guess-basic-syntax)) + ; '(cpp-macro cpp-macro-cont)))))) (basic-line-continuation (regexp . "\\(\\s-*\\)\\\\$") @@ -578,7 +578,12 @@ The possible settings for `align-region-separate' are: (justify . t) (run-if . ,(function (lambda () - (eq '- current-prefix-arg)))))) + (eq '- current-prefix-arg))))) + + (css-declaration + (regexp . "^\\s-*\\w+:\\(\\s-*\\).*;") + (group . (1)) + (modes . '(css-mode html-mode)))) "*A list describing all of the available alignment rules. The format is: diff --git a/lisp/bindings.el b/lisp/bindings.el index 98b10f20ce..44e4510c5f 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -392,6 +392,9 @@ Menu of mode operations in the mode line.") "Return the value of symbol VAR if it is bound, else nil." `(and (boundp (quote ,var)) ,var)) +(define-key mode-line-mode-menu [tooltip-mode] + `(menu-item ,(purecopy "Tooltip") tooltip-mode + :button (:toggle . tooltip-mode))) (define-key mode-line-mode-menu [overwrite-mode] `(menu-item ,(purecopy "Overwrite (Ovwrt)") overwrite-mode :button (:toggle . overwrite-mode))) diff --git a/lisp/calc/calc-embed.el b/lisp/calc/calc-embed.el index e3b3b6b5b1..f1a273f7cf 100644 --- a/lisp/calc/calc-embed.el +++ b/lisp/calc/calc-embed.el @@ -244,6 +244,13 @@ This is not required to be present for user-written mode annotations.") (use-local-map calc-mode-map) (setq calc-no-refresh-evaltos nil) (and chg calc-any-evaltos (calc-wrapper (calc-refresh-evaltos))) + (let (str) + (save-excursion + (calc-select-buffer) + (setq str mode-line-buffer-identification)) + (unless (equal str mode-line-buffer-identification) + (setq mode-line-buffer-identification str) + (set-buffer-modified-p (buffer-modified-p)))) (or (eq calc-embedded-quiet t) (message "Embedded Calc mode enabled; %s to return to normal" (if calc-embedded-quiet @@ -717,6 +724,11 @@ The command \\[yank] can retrieve it from there." (setq no-defaults nil))) (backward-char 6)) (goto-char save-pt) + (unless (assq 'the-language modes) + (let ((lang (assoc major-mode calc-language-alist))) + (if lang + (setq modes (cons (cons 'the-language (cdr lang)) + modes))))) (list modes emodes pmodes))) ;; The variable calc-embed-vars-used is local to calc-embedded-make-info, @@ -857,13 +869,13 @@ The command \\[yank] can retrieve it from there." (while (setq x (cdr x)) (calc-embedded-find-vars (car x)))))) - +(defvar math-ms-args) (defun calc-embedded-evaluate-expr (x) (let ((calc-embed-vars-used (aref calc-embedded-info 10))) (or calc-embed-vars-used (calc-embedded-find-vars x)) (if calc-embed-vars-used (let ((active (assq (aref calc-embedded-info 0) calc-embedded-active)) - (args nil)) + (math-ms-args nil)) (save-excursion (calc-embedded-original-buffer t) (or active @@ -887,7 +899,7 @@ The command \\[yank] can retrieve it from there." (list 'calcFunc-assign (nth 1 x) (calc-embedded-subst (nth 2 x))) - (calc-normalize (math-evaluate-expr-rec (math-multi-subst x nil nil)))))) + (calc-normalize (math-evaluate-expr-rec (math-multi-subst-rec x)))))) (defun calc-embedded-eval-get-var (var base) (let ((entry base) @@ -914,7 +926,7 @@ The command \\[yank] can retrieve it from there." (setq val (nth 2 val))) (if (eq (car-safe val) 'calcFunc-assign) (setq val (nth 2 val))) - (setq args (cons (cons var val) args))) + (setq math-ms-args (cons (cons var val) math-ms-args))) (calc-embedded-activate) (calc-embedded-eval-get-var var base)))))) diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 99857ce05a..24336ad933 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -717,6 +717,20 @@ If nil, selections displayed but ignored.") (defvar var-gamma '(special-const (math-gamma-const))) (defvar var-Modes '(special-const (math-get-modes-vec))) +(defvar calc-language-alist + '((latex-mode . latex) + (tex-mode . tex) + (plain-tex-mode . tex) + (context-mode . tex) + (nroff-mode . eqn) + (pascal-mode . pascal) + (c-mode . c) + (c++-mode . c) + (fortran-mode . fortran) + (f90-mode . fortran)) + "Alist of major modes with appropriate Calc languages.") + + (mapcar (lambda (v) (or (boundp v) (set v nil))) calc-local-var-list) diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index 66ee1875a2..8c78d9540b 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -145,24 +145,6 @@ "Name of the buffer used for the calendar.") ;;;###autoload -(defcustom calendar-week-start-day 0 - "*The day of the week on which a week in the calendar begins. -0 means Sunday (default), 1 means Monday, and so on. - -If you change this variable directly (without using customize) -after starting `calendar', you should call `redraw-calendar' to -update the calendar display to reflect the change, otherwise -movement commands will not work correctly." - :type 'integer - :set (lambda (sym val) - (set sym val) - (let ((buffer (get-buffer calendar-buffer))) - (when (buffer-live-p buffer) - (with-current-buffer buffer - (redraw-calendar))))) - :group 'calendar) - -;;;###autoload (defcustom calendar-offset 0 "*The offset of the principal month from the center of the calendar window. 0 means the principal month is in the center (default), -1 means on the left, @@ -2168,15 +2150,34 @@ the inserted text. Value is always t." (forward-line 1)))) t) +(defvar calendar-redrawing nil + "Internal calendar variable, non-nil if inside redraw-calendar.") + (defun redraw-calendar () "Redraw the calendar display, if `calendar-buffer' is live." (interactive) (if (get-buffer calendar-buffer) (with-current-buffer calendar-buffer - (let ((cursor-date (calendar-cursor-to-nearest-date))) + (let ((cursor-date (calendar-cursor-to-nearest-date)) + (calendar-redrawing t)) (generate-calendar-window displayed-month displayed-year) (calendar-cursor-to-visible-date cursor-date))))) +;;;###autoload +(defcustom calendar-week-start-day 0 + "*The day of the week on which a week in the calendar begins. +0 means Sunday (default), 1 means Monday, and so on. + +If you change this variable directly (without using customize) +after starting `calendar', you should call `redraw-calendar' to +update the calendar display to reflect the change, otherwise +movement commands will not work correctly." + :type 'integer + :set (lambda (sym val) + (set sym val) + (redraw-calendar)) + :group 'calendar) + (defcustom calendar-debug-sexp nil "*Turn debugging on when evaluating a sexp in the diary or holiday list." :type 'boolean @@ -2920,40 +2921,40 @@ MARK defaults to `diary-entry-marker'." (save-excursion (set-buffer calendar-buffer) (calendar-cursor-to-visible-date date) - (let ((mark (or (and (stringp mark) (= (length mark) 1) mark) ; single-char - (and (listp mark) (> (length mark) 0) mark) ; attr list - (and (facep mark) mark) ; face-name - diary-entry-marker))) - (if (facep mark) - (progn ; face or an attr-list that contained a face - (overlay-put - (make-overlay (1- (point)) (1+ (point))) 'face mark)) - (if (and (stringp mark) - (= (length mark) 1)) ; single-char - (let ((buffer-read-only nil)) - (forward-char 1) - (delete-char 1) - (insert mark) - (forward-char -2)) - (let ; attr list - ((temp-face - (make-symbol (apply 'concat "temp-face-" - (mapcar '(lambda (sym) + (let ((mark (or (and (stringp mark) (= (length mark) 1) mark) ; single-char + (and (listp mark) (> (length mark) 0) mark) ; attr list + (and (facep mark) mark) ; face-name + diary-entry-marker))) + (if (facep mark) + (progn ; face or an attr-list that contained a face + (overlay-put + (make-overlay (1- (point)) (1+ (point))) 'face mark)) + (if (and (stringp mark) + (= (length mark) 1)) ; single-char + (let ((buffer-read-only nil)) + (forward-char 1) + (delete-char 1) + (insert mark) + (forward-char -2)) + (let ; attr list + ((temp-face + (make-symbol (apply 'concat "temp-face-" + (mapcar '(lambda (sym) (cond ((symbolp sym) (symbol-name sym)) ((numberp sym) (int-to-string sym)) (t sym))) mark)))) (faceinfo mark)) - (make-face temp-face) - ;; Remove :face info from the mark, copy the face info into temp-face - (while (setq faceinfo (memq :face faceinfo)) - (copy-face (read (nth 1 faceinfo)) temp-face) - (setcar faceinfo nil) - (setcar (cdr faceinfo) nil)) - (setq mark (delq nil mark)) - ;; Apply the font aspects - (apply 'set-face-attribute temp-face nil mark) - (overlay-put - (make-overlay (1- (point)) (1+ (point))) 'face temp-face)))))))) + (make-face temp-face) + ;; Remove :face info from the mark, copy the face info into temp-face + (while (setq faceinfo (memq :face faceinfo)) + (copy-face (read (nth 1 faceinfo)) temp-face) + (setcar faceinfo nil) + (setcar (cdr faceinfo) nil)) + (setq mark (delq nil mark)) + ;; Apply the font aspects + (apply 'set-face-attribute temp-face nil mark) + (overlay-put + (make-overlay (1- (point)) (1+ (point))) 'face temp-face)))))))) (defun calendar-star-date () "Replace the date under the cursor in the calendar window with asterisks. diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el index 97dc1dd0a7..124b29c3fe 100644 --- a/lisp/calendar/diary-lib.el +++ b/lisp/calendar/diary-lib.el @@ -842,7 +842,14 @@ After the entries are marked, the hooks `nongregorian-diary-marking-hook' and `mark-diary-entries-hook' are run." (interactive) ;; To remove any deleted diary entries. - (when mark-diary-entries-in-calendar + (when (and mark-diary-entries-in-calendar + ;; Avoid redrawing when called recursively, eg through + ;; mark-diary-entries-hook for #include's, else only get + ;; the last set of diary marks. + (not marking-diary-entries) + ;; If called from redraw-calendar, the calendar has been + ;; erased, so no need to unmark the diary entries. + (not calendar-redrawing)) (setq mark-diary-entries-in-calendar nil) (redraw-calendar)) (let ((marking-diary-entries t) diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 2cd0896c83..60fc862676 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -1,6 +1,6 @@ ;;; byte-run.el --- byte-compiler support for inlining -;; Copyright (C) 1992, 2004 Free Software Foundation, Inc. +;; Copyright (C) 1992, 2004, 2005 Free Software Foundation, Inc. ;; Author: Jamie Zawinski <[email protected]> ;; Hallvard Furuseth <[email protected]> @@ -31,11 +31,35 @@ ;;; Code: +;; We define macro-declaration-function here because it is needed to +;; handle declarations in macro definitions and this is the first file +;; loaded by loadup.el that uses declarations in macros. + +(defun macro-declaration-function (macro decl) + "Process a declaration found in a macro definition. +This is set as the value of the variable `macro-declaration-function'. +MACRO is the name of the macro being defined. +DECL is a list `(declare ...)' containing the declarations. +The return value of this function is not used." + ;; We can't use `dolist' or `cadr' yet for bootstrapping reasons. + (let (d) + ;; Ignore the first element of `decl' (it's always `declare'). + (while (setq decl (cdr decl)) + (setq d (car decl)) + (cond ((and (consp d) (eq (car d) 'indent)) + (put macro 'lisp-indent-function (car (cdr d)))) + ((and (consp d) (eq (car d) 'debug)) + (put macro 'edebug-form-spec (car (cdr d)))) + (t + (message "Unknown declaration %s" d)))))) + +(setq macro-declaration-function 'macro-declaration-function) + + ;; Redefined in byte-optimize.el. ;; This is not documented--it's not clear that we should promote it. (fset 'inline 'progn) -(put 'inline 'lisp-indent-hook 0) - +(put 'inline 'lisp-indent-function 0) ;;; Interface to inline functions. @@ -105,11 +129,10 @@ was first made obsolete, for example a date or a release number." (put variable 'byte-obsolete-variable (cons new when)) variable) -(put 'dont-compile 'lisp-indent-hook 0) (defmacro dont-compile (&rest body) "Like `progn', but the body always runs interpreted (not compiled). If you think you need this, you're probably making a mistake somewhere." - (declare (debug t)) + (declare (debug t) (indent 0)) (list 'eval (list 'quote (if (cdr body) (cons 'progn body) (car body))))) @@ -118,22 +141,21 @@ If you think you need this, you're probably making a mistake somewhere." ;;; definition in the file overrides the magic definitions on the ;;; byte-compile-macro-environment. -(put 'eval-when-compile 'lisp-indent-hook 0) (defmacro eval-when-compile (&rest body) "Like `progn', but evaluates the body at compile time. The result of the body appears to the compiler as a quoted constant." - (declare (debug t)) + (declare (debug t) (indent 0)) ;; Not necessary because we have it in b-c-initial-macro-environment ;; (list 'quote (eval (cons 'progn body))) (cons 'progn body)) -(put 'eval-and-compile 'lisp-indent-hook 0) (defmacro eval-and-compile (&rest body) "Like `progn', but evaluates the body at compile time and at load time." - (declare (debug t)) + (declare (debug t) (indent 0)) ;; Remember, it's magic. (cons 'progn body)) +(put 'with-no-warnings 'lisp-indent-function 0) (defun with-no-warnings (&rest body) "Like `progn', but prevents compiler warnings in the body." ;; The implementation for the interpreter is basically trivial. @@ -147,7 +169,7 @@ The result of the body appears to the compiler as a quoted constant." ;;; There is hardly any reason to change these parameters, anyway. ;;; --rms. -;; (put 'byte-compiler-options 'lisp-indent-hook 0) +;; (put 'byte-compiler-options 'lisp-indent-function 0) ;; (defmacro byte-compiler-options (&rest args) ;; "Set some compilation-parameters for this file. This will affect only the ;; file in which it appears; this does nothing when evaluated, and when loaded diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 25a1ba080d..08d5515524 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1,7 +1,7 @@ ;;; bytecomp.el --- compilation of Lisp code into byte code ;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1998, 2000, 2001, 2002, -;; 2003, 2004 Free Software Foundation, Inc. +;; 2003, 2004, 2005 Free Software Foundation, Inc. ;; Author: Jamie Zawinski <[email protected]> ;; Hallvard Furuseth <[email protected]> @@ -1039,7 +1039,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." (byte-compile-set-symbol-position (car form)) (if (memq 'obsolete byte-compile-warnings) (byte-compile-warn "`%s' is an obsolete function%s; %s" (car form) - (if when (concat " since " when) "") + (if when (concat " (as of Emacs " when ")") "") (if (stringp (car new)) (car new) (format "use `%s' instead." (car new))))) @@ -2779,7 +2779,7 @@ That command is designed for interactive use only" fn)) (let* ((ob (get var 'byte-obsolete-variable)) (when (cdr ob))) (byte-compile-warn "`%s' is an obsolete variable%s; %s" var - (if when (concat " since " when) "") + (if when (concat " (as of Emacs " when ")") "") (if (stringp (car ob)) (car ob) (format "use `%s' instead." (car ob)))))) diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 67836215da..e97e9012fc 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -94,15 +94,8 @@ This is to optimize `debugger-make-xrefs'.") (defvar debugger-jumping-flag nil "Non-nil means that debug-on-entry is disabled. -This variable is used by `debugger-jump' and `debugger-reenable'.") - -;; When you change this, you may also need to change the number of -;; frames that the debugger skips. -(defconst debug-entry-code - '(if (or inhibit-debug-on-entry debugger-jumping-flag) - nil - (debug 'debug)) - "Code added to a function to cause it to call the debugger upon entry.") +This variable is used by `debugger-jump', `debugger-step-through', +and `debugger-reenable' to temporarily disable debug-on-entry.") ;;;###autoload (setq debugger 'debug) @@ -177,7 +170,14 @@ first will be printed into the backtrace buffer." (save-excursion (save-window-excursion (with-no-warnings - (setq unread-command-char -1)) + (setq unread-command-char -1)) + (when (eq (car debugger-args) 'debug) + ;; Skip the frames for backtrace-debug, byte-code, + ;; and implement-debug-on-entry. + (backtrace-debug 4 t) + ;; Place an extra debug-on-exit for macro's. + (when (eq 'lambda (car-safe (cadr (backtrace-frame 4)))) + (backtrace-debug 5 t))) (pop-to-buffer debugger-buffer) (debugger-mode) (debugger-setup-buffer debugger-args) @@ -197,10 +197,6 @@ first will be printed into the backtrace buffer." (goto-char (point-min)) (message "%s" (buffer-string)) (kill-emacs)) - (if (eq (car debugger-args) 'debug) - ;; Skip the frames for backtrace-debug, byte-code, - ;; and debug-entry-code. - (backtrace-debug 4 t)) (message "") (let ((standard-output nil) (buffer-read-only t)) @@ -232,7 +228,7 @@ first will be printed into the backtrace buffer." (setq last-command debugger-outer-last-command) (setq this-command debugger-outer-this-command) (with-no-warnings - (setq unread-command-char debugger-outer-unread-command-char)) + (setq unread-command-char debugger-outer-unread-command-char)) (setq unread-command-events debugger-outer-unread-command-events) (setq unread-post-input-method-events debugger-outer-unread-post-input-method-events) @@ -263,19 +259,14 @@ That buffer should be current already." (progn (search-forward "\n debug(") (forward-line (if (eq (car debugger-args) 'debug) - 2 ; Remove debug-entry-code frame. + 2 ; Remove implement-debug-on-entry frame. 1)) (point))) (insert "Debugger entered") ;; lambda is for debug-on-call when a function call is next. ;; debug is for debug-on-entry function called. (cond ((memq (car debugger-args) '(lambda debug)) - (insert "--entering a function:\n") - (if (eq (car debugger-args) 'debug) - (progn - (delete-char 1) - (insert ?*) - (beginning-of-line)))) + (insert "--entering a function:\n")) ;; Exiting a function. ((eq (car debugger-args) 'exit) (insert "--returning value: ") @@ -311,7 +302,7 @@ That buffer should be current already." (debugger-make-xrefs)) (defun debugger-make-xrefs (&optional buffer) - "Attach cross-references to symbol names in the `*Backtrace*' buffer." + "Attach cross-references to function names in the `*Backtrace*' buffer." (interactive "b") (save-excursion (set-buffer (or buffer (current-buffer))) @@ -362,6 +353,7 @@ That buffer should be current already." ;; Scan the new part of the backtrace, inserting xrefs. (goto-char (point-min)) (while (progn + (goto-char (+ (point) 2)) (skip-syntax-forward "^w_") (not (eobp))) (let* ((beg (point)) @@ -373,8 +365,8 @@ That buffer should be current already." (goto-char beg) ;; help-xref-button needs to operate on something matched ;; by a regexp, so set that up for it. - (re-search-forward "\\(\\(\\sw\\|\\s_\\)+\\)") - (help-xref-button 1 'help-function-def sym file))) + (re-search-forward "\\(\\sw\\|\\s_\\)+") + (help-xref-button 0 'help-function-def sym file))) (forward-line 1)) (widen)) (setq debugger-previous-backtrace (buffer-string)))) @@ -384,6 +376,8 @@ That buffer should be current already." Enter another debugger on next entry to eval, apply or funcall." (interactive) (setq debugger-step-after-exit t) + (setq debugger-jumping-flag t) + (add-hook 'post-command-hook 'debugger-reenable) (message "Proceeding, will debug on next eval or call.") (exit-recursive-edit)) @@ -429,8 +423,8 @@ removes itself from that hook." (count 0)) (while (not (eq (cadr (backtrace-frame count)) 'debug)) (setq count (1+ count))) - ;; Skip debug-entry-code frame. - (when (member '(debug (quote debug)) (cdr (backtrace-frame (1+ count)))) + ;; Skip implement-debug-on-entry frame. + (when (eq 'implement-debug-on-entry (cadr (backtrace-frame (1+ count)))) (setq count (1+ count))) (goto-char (point-min)) (when (looking-at "Debugger entered--\\(Lisp error\\|returning value\\):") @@ -513,12 +507,12 @@ Applies to the frame whose line point is on in the backtrace." (unwind-protect (progn (with-no-warnings - (setq unread-command-char debugger-outer-unread-command-char)) + (setq unread-command-char debugger-outer-unread-command-char)) (prog1 (progn ,@body) (with-no-warnings - (setq debugger-outer-unread-command-char unread-command-char)))) + (setq debugger-outer-unread-command-char unread-command-char)))) (with-no-warnings - (setq unread-command-char save-ucc)))) + (setq unread-command-char save-ucc)))) (setq debugger-outer-match-data (match-data)) (setq debugger-outer-load-read-function load-read-function) (setq debugger-outer-overriding-terminal-local-map @@ -620,6 +614,16 @@ Complete list of commands: (use-local-map debugger-mode-map) (run-mode-hooks 'debugger-mode-hook)) +;; When you change this, you may also need to change the number of +;; frames that the debugger skips. +(defun implement-debug-on-entry () + "Conditionally call the debugger. +A call to this function is inserted by `debug-on-entry' to cause +functions to break on entry." + (if (or inhibit-debug-on-entry debugger-jumping-flag) + nil + (funcall debugger 'debug))) + ;;;###autoload (defun debug-on-entry (function) "Request FUNCTION to invoke debugger each time it is called. @@ -644,7 +648,7 @@ Redefining FUNCTION also cancels it." (debug-convert-byte-code function)) (or (consp (symbol-function function)) (error "Definition of %s is not a list" function)) - (fset function (debug-on-entry-1 function (symbol-function function) t)) + (fset function (debug-on-entry-1 function t)) (or (memq function debug-function-list) (push function debug-function-list)) function) @@ -661,7 +665,7 @@ If argument is nil or an empty string, cancel for all functions." (if name (intern name))))) (if (and function (not (string= function ""))) (progn - (let ((f (debug-on-entry-1 function (symbol-function function) nil))) + (let ((f (debug-on-entry-1 function nil))) (condition-case nil (if (and (equal (nth 1 f) '(&rest debug-on-entry-args)) (eq (car (nth 3 f)) 'apply)) @@ -692,8 +696,9 @@ If argument is nil or an empty string, cancel for all functions." (setq body (cons (documentation function) body))) (fset function (cons 'lambda (cons (car contents) body))))))) -(defun debug-on-entry-1 (function defn flag) - (let ((tail defn)) +(defun debug-on-entry-1 (function flag) + (let* ((defn (symbol-function function)) + (tail defn)) (if (subrp tail) (error "%s is a built-in function" function) (if (eq (car tail) 'macro) (setq tail (cdr tail))) @@ -705,10 +710,10 @@ If argument is nil or an empty string, cancel for all functions." ;; Skip the interactive form. (when (eq 'interactive (car-safe (cadr tail))) (setq tail (cdr tail))) - (unless (eq flag (equal (cadr tail) debug-entry-code)) + (unless (eq flag (equal (cadr tail) '(implement-debug-on-entry))) ;; Add/remove debug statement as needed. (if flag - (setcdr tail (cons debug-entry-code (cdr tail))) + (setcdr tail (cons '(implement-debug-on-entry) (cdr tail))) (setcdr tail (cddr tail)))) defn))) diff --git a/lisp/facemenu.el b/lisp/facemenu.el index a996d4c15e..cd3998520a 100644 --- a/lisp/facemenu.el +++ b/lisp/facemenu.el @@ -513,17 +513,17 @@ argument BUFFER-NAME is nil, it defaults to *Colors*." 'face (cons 'background-color (car color))) (put-text-property (prog1 (point) - (insert " " (if (cdr color) - (mapconcat 'identity (cdr color) ", ") - (car color))) - (indent-to (max (- (window-width) 8) 44)) - (insert (apply 'format " #%02x%02x%02x" - (mapcar (lambda (c) (lsh c -8)) - (color-values (car color))))) - - (insert "\n")) + (insert " " (if (cdr color) + (mapconcat 'identity (cdr color) ", ") + (car color)))) (point) - 'face (cons 'foreground-color (car color)))) + 'face (cons 'foreground-color (car color))) + (indent-to (max (- (window-width) 8) 44)) + (insert (apply 'format "#%02x%02x%02x" + (mapcar (lambda (c) (lsh c -8)) + (color-values (car color))))) + + (insert "\n")) (goto-char (point-min))) (defun list-colors-duplicates (&optional list) @@ -539,8 +539,8 @@ a list of colors that the current display can handle." (l list)) (while (cdr l) (if (and (facemenu-color-equal (car (car l)) (car (car (cdr l)))) - (not (and (boundp 'w32-default-color-map) - (not (assoc (car (car l)) w32-default-color-map))))) + (not (if (boundp 'w32-default-color-map) + (not (assoc (car (car l)) w32-default-color-map))))) (progn (setcdr (car l) (cons (car (car (cdr l))) (cdr (car l)))) (setcdr l (cdr (cdr l)))) diff --git a/lisp/faces.el b/lisp/faces.el index 936e0a132a..2d94c28c9f 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -225,7 +225,8 @@ Value is FACE." (defun face-id (face &optional frame) "Return the internal ID of face with name FACE. -If optional argument FRAME is nil or omitted, use the selected frame." +The optional argument FRAME is ignored, since the internal face ID +of a face name is the same for all frames." (check-face face) (get face 'face)) diff --git a/lisp/generic.el b/lisp/generic.el index fe3c2c274a..9545b0970a 100644 --- a/lisp/generic.el +++ b/lisp/generic.el @@ -1,6 +1,6 @@ ;;; generic.el --- defining simple major modes with comment and font-lock ;; -;; Copyright (C) 1997, 1999, 2004 Free Software Foundation, Inc. +;; Copyright (C) 1997, 1999, 2004, 2005 Free Software Foundation, Inc. ;; ;; Author: Peter Breton <[email protected]> ;; Created: Fri Sep 27 1996 @@ -215,8 +215,7 @@ FUNCTION-LIST is a list of functions to call to do some additional setup. See the file generic-x.el for some examples of `define-generic-mode'." ;; Add a new entry - (unless (assq name generic-mode-list) - (push (list (symbol-name name)) generic-mode-list)) + (add-to-list 'generic-mode-list (symbol-name name)) ;; Add it to auto-mode-alist (dolist (re auto-mode-list) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 76d4cb419c..9213b44170 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,14 +1,28 @@ +2005-03-10 Stefan Monnier <[email protected]> + + * nnimap.el (nnimap-retrieve-headers-from-server): Fix last change. + +2005-03-10 Arne J,Ax(Brgensen <[email protected]> (tiny change) + + * nnimap.el (nnimap-retrieve-headers-from-server): Fix off-by-one + flaw. + +2005-03-08 Bjorn Solberg <[email protected]> (tiny change) + + * nnimap.el (nnimap-retrieve-headers-from-server): Sort NOV + buffer (since IMAP server might return FETCH response out of + order, and the nntp buffer must be sorted). + 2005-03-04 Reiner Steib <[email protected]> * message.el: Don't autoload former message-utils variables. - (message-strip-subject-trailing-was): Changed doc string. + (message-strip-subject-trailing-was): Change doc string. * nnweb.el: Fixes for `gnus-group-make-web-group'. - (nnweb-type-definition): Don't add "hl=en" in `address'. Added - `base'. + (nnweb-type-definition): Don't add "hl=en" in `address'. Add `base'. (nnweb-google-search): Add "hl=en" here. - (nnweb-google-parse-1, nnweb-google-create-mapping): Don't - hardcode URL. + (nnweb-google-parse-1, nnweb-google-create-mapping): + Don't hardcode URL. 2005-03-03 Reiner Steib <[email protected]> diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 59b0178de4..09d9aef6f3 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -665,6 +665,8 @@ If EXAMINE is non-nil the group is selected read-only." (if (imap-capability 'IMAP4rev1) (format "BODY.PEEK[HEADER.FIELDS %s])" headers) (format "RFC822.HEADER.LINES %s)" headers))))) + (with-current-buffer nntp-server-buffer + (sort-numeric-fields 1 (point-min) (point-max))) (and (numberp nnmail-large-newsgroup) (> nnimap-length nnmail-large-newsgroup) (nnheader-message 6 "nnimap: Retrieving headers...done"))))) diff --git a/lisp/help.el b/lisp/help.el index de5ac093dd..22d383559a 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -1,7 +1,7 @@ ;;; help.el --- help commands for Emacs -;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001, 2002, 2004 -;; Free Software Foundation, Inc. +;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001, 2002, 2004, +;; 2005 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: help, internal @@ -685,34 +685,35 @@ For this to work correctly for a minor mode, the mode's indicator variable \(listed in `minor-mode-alist') must also be a function whose documentation describes the minor mode." (interactive) - (help-setup-xref (list #'describe-mode (or buffer (current-buffer))) + (unless buffer (setq buffer (current-buffer))) + (help-setup-xref (list #'describe-mode buffer) (interactive-p)) ;; For the sake of help-do-xref and help-xref-go-back, ;; don't switch buffers before calling `help-buffer'. (with-output-to-temp-buffer (help-buffer) - (save-excursion - (when buffer (set-buffer buffer)) + (with-current-buffer buffer (let (minor-modes) + ;; Older packages do not register in minor-mode-list but only in + ;; minor-mode-alist. + (dolist (x minor-mode-alist) + (setq x (car x)) + (unless (memq x minor-mode-list) + (push x minor-mode-list))) ;; Find enabled minor mode we will want to mention. (dolist (mode minor-mode-list) ;; Document a minor mode if it is listed in minor-mode-alist, ;; non-nil, and has a function definition. (and (boundp mode) (symbol-value mode) (fboundp mode) - (let ((pretty-minor-mode mode) - indicator) + (let ((pretty-minor-mode mode)) (if (string-match "\\(-minor\\)?-mode\\'" (symbol-name mode)) (setq pretty-minor-mode (capitalize (substring (symbol-name mode) 0 (match-beginning 0))))) - (setq indicator (cadr (assq mode minor-mode-alist))) - (while (and indicator (symbolp indicator) - (boundp indicator) - (not (eq indicator (symbol-value indicator)))) - (setq indicator (symbol-value indicator))) - (push (list pretty-minor-mode mode indicator) + (push (list pretty-minor-mode mode + (format-mode-line (assq mode minor-mode-alist))) minor-modes)))) (if auto-fill-function ;; copy pure string so we can add face property to it below. @@ -729,6 +730,9 @@ whose documentation describes the minor mode." (let ((pretty-minor-mode (nth 0 mode)) (mode-function (nth 1 mode)) (indicator (nth 2 mode))) + (setq indicator (if (zerop (length indicator)) + "no indicator" + (format "indicator%s" indicator))) (add-text-properties 0 (length pretty-minor-mode) '(face bold) pretty-minor-mode) (save-excursion @@ -737,20 +741,14 @@ whose documentation describes the minor mode." (push (point-marker) help-button-cache) ;; Document the minor modes fully. (insert pretty-minor-mode) - (princ (format " minor mode (%s):\n" - (if indicator - (format "indicator%s" indicator) - "no indicator"))) + (princ (format " minor mode (%s):\n" indicator)) (princ (documentation mode-function))) (princ " ") (insert-button pretty-minor-mode 'action (car help-button-cache) 'follow-link t 'help-echo "mouse-2, RET: show full information") - (princ (format " minor mode (%s):\n" - (if indicator - (format "indicator%s" indicator) - "no indicator")))))) + (princ (format " minor mode (%s):\n" indicator))))) (princ "\n(Full information about these minor modes follows the description of the major mode.)\n\n")) ;; Document the major mode. @@ -896,5 +894,5 @@ out of view." ;; defcustoms which require 'help'. (provide 'help) -;;; arch-tag: cf427352-27e9-49b7-9a6f-741ebab02423 +;; arch-tag: cf427352-27e9-49b7-9a6f-741ebab02423 ;;; help.el ends here diff --git a/lisp/image-file.el b/lisp/image-file.el index 4a13019a09..11676021af 100644 --- a/lisp/image-file.el +++ b/lisp/image-file.el @@ -135,6 +135,7 @@ the command `insert-file-contents'." (setq truncate-lines t)))) rval)) +(put 'image-file-handler 'safe-magic t) (defun image-file-handler (operation &rest args) "Filename handler for inserting image files. OPERATION is the operation to perform, on ARGS. diff --git a/lisp/info.el b/lisp/info.el index 4905bf0844..b2920bd6ec 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -210,6 +210,8 @@ top/final node depending on search direction." :type 'boolean :group 'info) +(defvar Info-isearch-initial-node nil) + (defcustom Info-mode-hook ;; Try to obey obsolete Info-fontify settings. (unless (and (boundp 'Info-fontify) (null Info-fontify)) @@ -1502,7 +1504,7 @@ If DIRECTION is `backward', search in the reverse direction." ;; Skip node header line (and (save-excursion (forward-line -1) (looking-at "\^_")) - (forward-line 1)) + (forward-line (if backward -1 1))) ;; Skip Tag Table node (save-excursion (and (search-backward "\^_" nil t) @@ -1514,6 +1516,14 @@ If DIRECTION is `backward', search in the reverse direction." (setq found (point) beg-found (if backward (match-end 0) (match-beginning 0))) (setq give-up t)))))) + + (when (and isearch-mode Info-isearch-search + (not Info-isearch-initial-node) + (not bound) + (or give-up (and found (not (and (> found opoint-min) + (< found opoint-max)))))) + (signal 'search-failed (list regexp "initial node"))) + ;; If no subfiles, give error now. (if give-up (if (null Info-current-subfile) @@ -1523,6 +1533,9 @@ If DIRECTION is `backward', search in the reverse direction." (re-search-forward regexp))) (setq found nil))) + (if (and bound (not found)) + (signal 'search-failed (list regexp))) + (unless (or found bound) (unwind-protect ;; Try other subfiles. @@ -1540,6 +1553,7 @@ If DIRECTION is `backward', search in the reverse direction." (search-forward (concat "\n" osubfile ": ")) ;; Skip that one. (forward-line (if backward 0 1)) + (if backward (forward-char -1)) ;; Make a list of all following subfiles. ;; Each elt has the form (VIRT-POSITION . SUBFILENAME). (while (not (if backward (bobp) (eobp))) @@ -1578,7 +1592,7 @@ If DIRECTION is `backward', search in the reverse direction." ;; Skip node header line (and (save-excursion (forward-line -1) (looking-at "\^_")) - (forward-line 1)) + (forward-line (if backward -1 1))) ;; Skip Tag Table node (save-excursion (and (search-backward "\^_" nil t) @@ -1615,7 +1629,8 @@ If DIRECTION is `backward', search in the reverse direction." ;; Use string-equal, not equal, to ignore text props. (or (and (string-equal onode Info-current-node) (equal ofile Info-current-file)) - (and isearch-mode isearch-wrapped (eq opoint opoint-min)) + (and isearch-mode isearch-wrapped + (eq opoint (if isearch-forward opoint-min opoint-max))) (setq Info-history (cons (list ofile onode opoint) Info-history)))))) @@ -1646,21 +1661,30 @@ If DIRECTION is `backward', search in the reverse direction." (Info-search regexp bound noerror count 'backward)) (defun Info-isearch-search () - (if (and Info-isearch-search (not isearch-word)) + (if Info-isearch-search (lambda (string &optional bound noerror count) - (condition-case nil - (progn - (Info-search (if isearch-regexp string (regexp-quote string)) - bound noerror count - (unless isearch-forward 'backward)) - (point)) - (error nil))) + (if isearch-word + (Info-search (concat "\\b" (replace-regexp-in-string + "\\W+" "\\\\W+" + (replace-regexp-in-string + "^\\W+\\|\\W+$" "" string)) "\\b") + bound noerror count + (unless isearch-forward 'backward)) + (Info-search (if isearch-regexp string (regexp-quote string)) + bound noerror count + (unless isearch-forward 'backward)) + (point))) (let ((isearch-search-fun-function nil)) (isearch-search-fun)))) (defun Info-isearch-wrap () - (when (and Info-isearch-search (not isearch-word)) - (if isearch-forward (Info-top-node) (Info-final-node)) + (if Info-isearch-search + (if Info-isearch-initial-node + (progn + (if isearch-forward (Info-top-node) (Info-final-node)) + (goto-char (if isearch-forward (point-min) (point-max)))) + (setq Info-isearch-initial-node Info-current-node) + (setq isearch-wrapped nil)) (goto-char (if isearch-forward (point-min) (point-max))))) (defun Info-isearch-push-state () @@ -1672,6 +1696,8 @@ If DIRECTION is `backward', search in the reverse direction." (string= Info-current-node node)) (progn (Info-find-node file node) (sit-for 0)))) +(defun Info-isearch-start () + (setq Info-isearch-initial-node nil)) (defun Info-extract-pointer (name &optional errorname) "Extract the value of the node-pointer named NAME. @@ -3209,6 +3235,7 @@ Advanced commands: (setq desktop-save-buffer 'Info-desktop-buffer-misc-data) (add-hook 'clone-buffer-hook 'Info-clone-buffer-hook nil t) (add-hook 'change-major-mode-hook 'font-lock-defontify nil t) + (add-hook 'isearch-mode-hook 'Info-isearch-start nil t) (set (make-local-variable 'isearch-search-fun-function) 'Info-isearch-search) (set (make-local-variable 'isearch-wrap-function) diff --git a/lisp/international/ccl.el b/lisp/international/ccl.el index e55f1fbcf3..93ad935872 100644 --- a/lisp/international/ccl.el +++ b/lisp/international/ccl.el @@ -1305,7 +1305,9 @@ CCL-PROGRAM has this form: BUFFER_MAGNIFICATION is an integer value specifying the approximate output buffer magnification size compared with the bytes of input data -text. If the value is zero, the CCL program can't execute `read' and +text. It is assured that the actual output buffer has 256 bytes +more than the size calculated by BUFFER_MAGNIFICATION. +If the value is zero, the CCL program can't execute `read' and `write' commands. CCL_MAIN_CODE and CCL_EOF_CODE are CCL program codes. CCL_MAIN_CODE diff --git a/lisp/international/latin-1.el b/lisp/international/latin-1.el index 3c30ba0721..610ed1cb9f 100644 --- a/lisp/international/latin-1.el +++ b/lisp/international/latin-1.el @@ -104,7 +104,10 @@ (set-case-syntax-pair 222 254 tbl) ;latin letter thorn (Icelandic) (set-case-syntax 223 "w" tbl) ;latin small letter sharp s (German) (set-case-syntax 247 "_" tbl) ;division sign - (set-case-syntax 255 "w" tbl)) ;latin small letter y with diaeresis + ;; The following setting should be suppressed when we are loading + ;; this file for setting syntax of multibyte characters. + (or set-case-syntax-set-multibyte + (set-case-syntax 255 "w" tbl))) ;latin small letter y with diaeresis ;; When preloading this file, don't provide the feature. ;; Explicit `require' is used to load this for 8-bit characters. diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 24992b3c10..3fac3ab6dd 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -2043,55 +2043,60 @@ of `buffer-file-coding-system' set by this function." ;; and Chinese are exceptions, which are listed in the ;; non-standard section at the bottom of locale-language-names. - ; aa Afar - ; ab Abkhazian + ("aa_DJ" . "Latin-1") ; Afar + ("aa" . "UTF-8") + ;; ab Abkhazian ("af" . "Latin-1") ; Afrikaans - ("am" . "Ethiopic") ; Amharic + ("am" "Ethiopic" utf-8) ; Amharic + ("an" . "Latin-9") ; Aragonese ; ar Arabic glibc uses 8859-6 ; as Assamese ; ay Aymara - ; az Azerbaijani + ("az" . "UTF-8") ; Azerbaijani ; ba Bashkir - ("be" . "Belarusian") ; Belarusian [Byelorussian until early 1990s] - ("bg" . "Bulgarian") ; Bulgarian + ("be" "Belarusian" cp1251) ; Belarusian [Byelorussian until early 1990s] + ("bg" "Bulgarian" cp1251) ; Bulgarian ; bh Bihari ; bi Bislama - ; bn Bengali, Bangla + ("bn" . "UTF-8") ; Bengali, Bangla ("bo" . "Tibetan") ("br" . "Latin-1") ; Breton ("bs" . "Latin-2") ; Bosnian + ("byn" . "UTF-8") ; Bilin; Blin ("ca" . "Latin-1") ; Catalan ; co Corsican - ("cs" . "Czech") - ("cy" . "Welsh") ; Welsh [glibc uses Latin-8. Did this change?] + ("cs" "Czech" iso-8859-2) + ("cy" "Welsh" iso-8859-14) ("da" . "Latin-1") ; Danish - ("de" . "German") + ("de" "German" iso-8859-1) ; dz Bhutani - ("el" . "Greek") + ("el" "Greek" iso-8859-7) ;; Users who specify "en" explicitly typically want Latin-1, not ASCII. ;; That's actually what the GNU locales define, modulo things like ;; en_IN -- fx. + ("en_IN" "English" utf-8) ; glibc uses utf-8 for English in India ("en" . "Latin-1") ; English ("eo" . "Latin-3") ; Esperanto - ("es" . "Spanish") - ("et" . "Latin-4") ; Estonian + ("es" "Spanish" iso-8859-1) + ("et" . "Latin-1") ; Estonian ("eu" . "Latin-1") ; Basque - ; fa Persian glibc uses utf-8 + ("fa" . "UTF-8") ; Persian ("fi" . "Latin-1") ; Finnish - ; fj Fiji + ("fj" . "Latin-1") ; Fiji ("fo" . "Latin-1") ; Faroese - ("fr" . "French") ; French + ("fr" "French" iso-8859-1) ; French ("fy" . "Latin-1") ; Frisian ("ga" . "Latin-1") ; Irish Gaelic (new orthography) - ("gd" . "Latin-1") ; Scots Gaelic - ("gl" . "Latin-1") ; Galician + ("gd" . "Latin-9") ; Scots Gaelic + ("gez" "Ethiopic" utf-8) ; Geez + ("gl" . "Latin-1") ; Gallegan; Galician ; gn Guarani - ; gu Gujarati - ("gv" . "Latin-8") ; Manx Gaelic glibc uses 8859-1 + ("gu" . "UTF-8") ; Gujarati + ("gv" . "Latin-1") ; Manx Gaelic ; ha Hausa - ("he" . "Hebrew") - ("hi" . "Devanagari") ; Hindi glibc uses utf-8 - ("hr" . "Croatian") ; Croatian + ("he" "Hebrew" iso-8859-8) + ("hi" "Devanagari" utf-8) ; Hindi + ("hr" "Croatian" iso-8859-2) ; Croatian ("hu" . "Latin-2") ; Hungarian ; hy Armenian ; ia Interlingua @@ -2099,110 +2104,114 @@ of `buffer-file-coding-system' set by this function." ; ie Interlingue ; ik Inupiak ("is" . "Latin-1") ; Icelandic - ("it" . "Italian") ; Italian + ("it" "Italian" iso-8859-1) ; Italian ; iu Inuktitut - ("ja" . "Japanese") + ("iw" "Hebrew" iso-8859-8) + ("ja" "Japanese" euc-jp) ; jw Javanese - ("ka" . "Georgian") ; Georgian + ("ka" "Georgian" georgian-ps) ; Georgian ; kk Kazakh ("kl" . "Latin-1") ; Greenlandic ; km Cambodian - ; kn Kannada - ("ko" . "Korean") + ("kn" "Kannada" utf-8) + ("ko" "Korean" euc-kr) ; ks Kashmiri ; ku Kurdish ("kw" . "Latin-1") ; Cornish ; ky Kirghiz ("la" . "Latin-1") ; Latin ("lb" . "Latin-1") ; Luxemburgish + ("lg" . "Laint-6") ; Ganda ; ln Lingala - ("lo" . "Lao") ; Laothian - ("lt" . "Lithuanian") + ("lo" "Lao" utf-8) ; Laothian + ("lt" "Lithuanian" iso-8859-13) ("lv" . "Latvian") ; Latvian, Lettish ; mg Malagasy ("mi" . "Latin-7") ; Maori - ("mk" . "Cyrillic-ISO") ; Macedonian - ; ml Malayalam - ; mn Mongolian + ("mk" "Cyrillic-ISO" iso-8859-5) ; Macedonian + ("ml" "Malayalam" utf-8) + ("mn" . "UTF-8") ; Mongolian ; mo Moldavian - ("mr" . "Devanagari") ; Marathi glibc uses utf-8 + ("mr" "Devanagari" utf-8) ; Marathi ("ms" . "Latin-1") ; Malay ("mt" . "Latin-3") ; Maltese ; my Burmese ; na Nauru - ("ne" . "Devanagari") ; Nepali - ("nl" . "Dutch") + ("nb" . "Latin-1") ; Norwegian + ("ne" "Devanagari" utf-8) ; Nepali + ("nl" "Dutch" iso-8859-1) ("no" . "Latin-1") ; Norwegian ("oc" . "Latin-1") ; Occitan - ; om (Afan) Oromo + ("om_ET" . "UTF-8") ; (Afan) Oromo + ("om" . "Latin-1") ; (Afan) Oromo ; or Oriya - ; pa Punjabi + ("pa" . "UTF-8") ; Punjabi ("pl" . "Latin-2") ; Polish ; ps Pashto, Pushto ("pt" . "Latin-1") ; Portuguese ; qu Quechua ("rm" . "Latin-1") ; Rhaeto-Romanic ; rn Kirundi - ("ro" . "Romanian") - ("ru.*[_.]koi8" . "Russian") - ("ru" . "Cyrillic-ISO") ; Russian + ("ro" "Romanian" iso-8859-2) + ("ru_RU" "Russian" iso-8859-5) + ("ru_UA" "Russian" koi8-u) ; rw Kinyarwanda ("sa" . "Devanagari") ; Sanskrit ; sd Sindhi - ; se Northern Sami + ("se" . "UTF-8") ; Northern Sami ; sg Sangho ("sh" . "Latin-2") ; Serbo-Croatian ; si Sinhalese - ("sk" . "Slovak") - ("sl" . "Slovenian") + ("sid" . "UTF-8") ; Sidamo + ("sk" "Slovak" iso-8859-2) + ("sl" "Slovenian" iso-8859-2) ; sm Samoan ; sn Shona - ; so Somali + ("so_ET" "UTF-8") ; Somali + ("so" "Latin-1") ; Somali ("sq" . "Latin-1") ; Albanian + ("sr_YU@cyrillic" . "Cyrillic-ISO") ; Serbian (Cyrillic alphabet) ("sr" . "Latin-2") ; Serbian (Latin alphabet) - ("sr_YU@cyrillic" . "Cyrillic-ISO") ; per glibc ; ss Siswati - ; st Sesotho + ("st" . "Latin-1") ; Sesotho ; su Sundanese - ("sv" . "Swedish") ; Swedish + ("sv" "Swedish" iso-8859-1) ; Swedish ("sw" . "Latin-1") ; Swahili - ; ta Tamil glibc uses utf-8 - ; te Telugu glibc uses utf-8 - ("tg" . "Tajik") - ("th" . "Thai") - ; ti Tigrinya + ("ta" "Tamil" utf-8) + ("te" . "UTF-8") ; Telugu + ("tg" "Tajik" koi8-t) + ("th" "Thai" tis-620) + ("ti" "Ethiopic" utf-8) ; Tigrinya + ("tig_ER" . "UTF-8") ; Tigre ; tk Turkmen ("tl" . "Latin-1") ; Tagalog ; tn Setswana ; to Tonga - ("tr" . "Turkish") + ("tr" "Turkish" iso-8859-9) ; ts Tsonga - ; tt Tatar + ("tt" . "UTF-8") ; Tatar ; tw Twi ; ug Uighur - ("uk" . "Ukrainian") ; Ukrainian - ; ur Urdu glibc uses utf-8 + ("uk" "Ukrainian" koi8-u) + ("ur" . "UTF-8") ; Urdu + ("uz_UZ@cyrillic" . "UTF-8"); Uzbek ("uz" . "Latin-1") ; Uzbek - ("vi" . "Vietnamese") ; glibc uses utf-8 + ("vi" "Vietnamese" utf-8) ; vo Volapuk ("wa" . "Latin-1") ; Walloon ; wo Wolof - ; xh Xhosa + ("xh" . "Latin-1") ; Xhosa ("yi" . "Windows-1255") ; Yiddish ; yo Yoruba ; za Zhuang - - ; glibc: + ("zh_HK" . "Chinese-Big5") + ("zh_TW" . "Chinese-Big5") + ("zh_CN" . "Chinese-GB") + ("zh" . "Chinese-GB") ; zh_CN.GB18030/GB18030 \ ; zh_CN.GBK/GBK \ ; zh_HK/BIG5-HKSCS \ - - ("zh.*[._]big5" . "Chinese-BIG5") - ("zh.*[._]gbk" . nil) ; Solaris 2.7; has gbk-0 as well as GB 2312.1980-0 - ("zh_tw" . "Chinese-CNS") ; glibc uses big5 - ("zh_tw[._]euc-tw" . "Chinese-EUC-TW") - ("zh" . "Chinese-GB") - ; zu Zulu + ("zu" . "Latin-1") ; Zulu ;; ISO standard locales ("c$" . "ASCII") @@ -2222,10 +2231,16 @@ of `buffer-file-coding-system' set by this function." ("chs" . "Chinese-GB") ; MS Windows Chinese Simplified ("cht" . "Chinese-BIG5") ; MS Windows Chinese Traditional )) - "List of pairs of locale regexps and language names. -The first element whose locale regexp matches the start of a downcased locale -specifies the language name corresponding to that locale. -If the language name is nil, there is no corresponding language environment.") + "Alist of locale regexps vs the corresponding languages and coding systems. +Each element has these form: + \(LOCALE-REGEXP LANG-ENV CODING-SYSTEM) +The first element whose LOCALE-REGEXP matches the start of a +downcased locale specifies the LANG-ENV \(language environtment) +and CODING-SYSTEM corresponding to that locale. If there is no +appropriate language environment, the element may have this form: + \(LOCALE-REGEXP . LANG-ENV) +In this case, LANG-ENV is one of generic language environments for an +specific encoding such as \"Latin-1\" and \"UTF-8\".") (defconst locale-charset-language-names (purecopy @@ -2243,20 +2258,43 @@ If the language name is nil, there is no corresponding language environment.") "List of pairs of locale regexps and charset language names. The first element whose locale regexp matches the start of a downcased locale specifies the language name whose charset corresponds to that locale. -This language name is used if its charsets disagree with the charsets of -the language name that would otherwise be used for this locale.") +This language name is used if the locale is not listed in +`locale-language-names'") (defconst locale-preferred-coding-systems (purecopy - '(("ja.*[._]euc" . japanese-iso-8bit) + '((".*8859[-_]?1\\>" . iso-8859-1) + (".*8859[-_]?2\\>" . iso-8859-2) + (".*8859[-_]?3\\>" . iso-8859-3) + (".*8859[-_]?4\\>" . iso-8859-4) + (".*8859[-_]?9\\>" . iso-8859-9) + (".*8859[-_]?14\\>" . iso-8859-14) + (".*8859[-_]?15\\>" . iso-8859-15) + (".*utf\\(?:-?8\\)?" . utf-8) + ;; utf-8@euro exists, so put this after utf-8. (@euro really + ;; specifies the currency, rather than the charset.) + (".*@euro" . iso-8859-15) + ("koi8-?r" . koi8-r) + ("koi8-?u" . koi8-u) + ("tcvn" . tcvn) + ("big5" . big5) + ("euc-?tw" . euc-tw) + ;; We don't support GBK, but as it is upper compatible with + ;; GB-2312, we setup the default coding system to gb2312. + ("gbk" . gb2312) + ;; We don't support BIG5-HKSCS, but as it is upper compatible with + ;; BIG5, we setup the default coding system to big5. + ("big5hkscs" . big5) + ("ja.*[._]euc" . japanese-iso-8bit) ("ja.*[._]jis7" . iso-2022-jp) ("ja.*[._]pck" . japanese-shift-jis) ("ja.*[._]sjis" . japanese-shift-jis) ("jpn" . japanese-shift-jis) ; MS-Windows uses this. - (".*[._]utf" . utf-8))) + )) "List of pairs of locale regexps and preferred coding systems. The first element whose locale regexp matches the start of a downcased locale -specifies the coding system to prefer when using that locale.") +specifies the coding system to prefer when using that locale. +This coding system is used if the locale specifies a specific charset.") (defun locale-name-match (key alist) "Search for KEY in ALIST, which should be a list of regexp-value pairs. @@ -2462,12 +2500,17 @@ See also `locale-charset-language-names', `locale-language-names', (coding-system (get-locale-coding-system locale))) - ;; Give preference to charset-language-name over language-name. - (if (and charset-language-name - (not - (equal (get-language-info language-name 'charset) - (get-language-info charset-language-name 'charset)))) - (setq language-name charset-language-name)) + (if (consp language-name) + ;; locale-language-names specify both lang-env and coding. + ;; But, what specified in locale-preferred-coding-systems + ;; has higher priority. + (setq coding-system (or coding-system + (nth 1 language-name)) + language-name (car language-name)) + ;; Otherwise, if locale is not listed in locale-language-names, + ;; use what listed in locale-charset-language-names. + (if (not language-name) + (setq language-name charset-language-name))) (when language-name @@ -2478,7 +2521,9 @@ See also `locale-charset-language-names', `locale-language-names', (setq locale-coding-system (car (get-language-info language-name 'coding-priority)))) - (when coding-system + (when (and coding-system + (not (coding-system-equal coding-system + locale-coding-system))) (prefer-coding-system coding-system) (setq locale-coding-system coding-system)))) diff --git a/lisp/international/mule.el b/lisp/international/mule.el index 9a5646217e..1b1d77ff46 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -1041,6 +1041,7 @@ a value of `safe-charsets' in PLIST." (setq coding-category (plist-get plist 'coding-category)) (aset coding-spec coding-spec-plist-idx plist)) (put coding-system 'coding-system coding-spec) + (put coding-system 'coding-system-define-form nil) (put coding-category 'coding-systems (cons coding-system (get coding-category 'coding-systems)))) @@ -1102,6 +1103,7 @@ a value of `safe-charsets' in PLIST." (defun define-coding-system-alias (alias coding-system) "Define ALIAS as an alias for coding system CODING-SYSTEM." (put alias 'coding-system (coding-system-spec coding-system)) + (put alias 'coding-system-define-form nil) (add-to-coding-system-list alias) (setq coding-system-alist (cons (list (symbol-name alias)) coding-system-alist)) diff --git a/lisp/international/utf-16.el b/lisp/international/utf-16.el index 04c9f68213..0c3d3724ea 100644 --- a/lisp/international/utf-16.el +++ b/lisp/international/utf-16.el @@ -411,7 +411,7 @@ after translation through the translation-table named Others are encoded as U+FFFD.") (define-ccl-program ccl-encode-mule-utf-16le-with-signature - `(4 + `(2 ((write #xFF) (write #xFE) ,@utf-16le-encode-loop)) @@ -423,7 +423,7 @@ after translation through the translation-table of name Others are encoded as U+FFFD.") (define-ccl-program ccl-encode-mule-utf-16be-with-signature - `(4 + `(2 ((write #xFE) (write #xFF) ,@utf-16be-encode-loop)) diff --git a/lisp/isearch.el b/lisp/isearch.el index 77208c42ee..66bf0dc5c2 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -437,9 +437,8 @@ Each set is a vector of the form: (defvar isearch-string "") ; The current search string. (defvar isearch-message "") ; text-char-description version of isearch-string -(defvar isearch-success t) ; Searching is currently successful. -(defvar isearch-invalid-regexp nil) ; Regexp not well formed. -(defvar isearch-within-brackets nil) ; Regexp has unclosed [. +(defvar isearch-success t) ; Searching is currently successful. +(defvar isearch-error nil) ; Error message for failed search. (defvar isearch-other-end nil) ; Start (end) of match if forward (backward). (defvar isearch-wrapped nil) ; Searching restarted from the top (bottom). (defvar isearch-barrier 0) @@ -640,8 +639,7 @@ is treated as a regexp. See \\[isearch-forward] for more info." isearch-barrier (point) isearch-adjusted nil isearch-yank-flag nil - isearch-invalid-regexp nil - isearch-within-brackets nil + isearch-error nil isearch-slow-terminal-mode (and (<= baud-rate search-slow-speed) (> (window-height) (* 4 @@ -867,7 +865,7 @@ REGEXP says which ring to use." (defsubst isearch-word-state (frame) "Return the search-by-word flag in FRAME." (aref frame 6)) -(defsubst isearch-invalid-regexp-state (frame) +(defsubst isearch-error-state (frame) "Return the regexp error message in FRAME, or nil if its regexp is valid." (aref frame 7)) (defsubst isearch-wrapped-state (frame) @@ -876,15 +874,12 @@ REGEXP says which ring to use." (defsubst isearch-barrier-state (frame) "Return the barrier value in FRAME." (aref frame 9)) -(defsubst isearch-within-brackets-state (frame) - "Return the in-character-class flag in FRAME." - (aref frame 10)) (defsubst isearch-case-fold-search-state (frame) "Return the case-folding flag in FRAME." - (aref frame 11)) + (aref frame 10)) (defsubst isearch-pop-fun-state (frame) "Return the function restoring the mode-specific isearch state in FRAME." - (aref frame 12)) + (aref frame 11)) (defun isearch-top-state () (let ((cmd (car isearch-cmds))) @@ -894,10 +889,9 @@ REGEXP says which ring to use." isearch-forward (isearch-forward-state cmd) isearch-other-end (isearch-other-end-state cmd) isearch-word (isearch-word-state cmd) - isearch-invalid-regexp (isearch-invalid-regexp-state cmd) + isearch-error (isearch-error-state cmd) isearch-wrapped (isearch-wrapped-state cmd) isearch-barrier (isearch-barrier-state cmd) - isearch-within-brackets (isearch-within-brackets-state cmd) isearch-case-fold-search (isearch-case-fold-search-state cmd)) (if (functionp (isearch-pop-fun-state cmd)) (funcall (isearch-pop-fun-state cmd) cmd)) @@ -912,8 +906,8 @@ REGEXP says which ring to use." (cons (vector isearch-string isearch-message (point) isearch-success isearch-forward isearch-other-end isearch-word - isearch-invalid-regexp isearch-wrapped isearch-barrier - isearch-within-brackets isearch-case-fold-search + isearch-error isearch-wrapped isearch-barrier + isearch-case-fold-search (if isearch-push-state-function (funcall isearch-push-state-function))) isearch-cmds))) @@ -976,8 +970,7 @@ If first char entered is \\[isearch-yank-word-or-char], then do word search inst (isearch-barrier isearch-barrier) (isearch-adjusted isearch-adjusted) (isearch-yank-flag isearch-yank-flag) - (isearch-invalid-regexp isearch-invalid-regexp) - (isearch-within-brackets isearch-within-brackets) + (isearch-error isearch-error) ;;; Don't bind this. We want isearch-search, below, to set it. ;;; And the old value won't matter after that. ;;; (isearch-other-end isearch-other-end) @@ -1124,7 +1117,7 @@ Use `isearch-exit' to quit without signaling." (isearch-cancel)) ;; If search is failing, or has an incomplete regexp, ;; rub out until it is once more successful. - (while (or (not isearch-success) isearch-invalid-regexp) + (while (or (not isearch-success) isearch-error) (isearch-pop-state)) (isearch-update))) @@ -1146,10 +1139,11 @@ Use `isearch-exit' to quit without signaling." ;; If already have what to search for, repeat it. (or isearch-success (progn + ;; Set isearch-wrapped before calling isearch-wrap-function + (setq isearch-wrapped t) (if isearch-wrap-function (funcall isearch-wrap-function) - (goto-char (if isearch-forward (point-min) (point-max)))) - (setq isearch-wrapped t)))) + (goto-char (if isearch-forward (point-min) (point-max))))))) ;; C-s in reverse or C-r in forward, change direction. (setq isearch-forward (not isearch-forward))) @@ -1384,8 +1378,7 @@ might return the position of the end of the line." (min isearch-opoint isearch-barrier)))) (progn (setq isearch-success t - isearch-invalid-regexp nil - isearch-within-brackets nil + isearch-error nil isearch-other-end (match-end 0)) (if (and (eq isearch-case-fold-search t) search-upper-case) (setq isearch-case-fold-search @@ -1432,8 +1425,8 @@ barrier." (not want-backslash)) ;; We have to check 2 stack frames because the last might be ;; invalid just because of a backslash. - (or (not isearch-invalid-regexp) - (not (isearch-invalid-regexp-state (cadr isearch-cmds))) + (or (not isearch-error) + (not (isearch-error-state (cadr isearch-cmds))) allow-invalid)) (if to-barrier (progn (goto-char isearch-barrier) @@ -1448,7 +1441,7 @@ barrier." ;; Also skip over postfix operators -- though horrid, ;; 'ab?\{5,6\}+\{1,2\}*' is perfectly legal. (while (and previous - (or (isearch-invalid-regexp-state frame) + (or (isearch-error-state frame) (let* ((string (isearch-string-state frame)) (lchar (aref string (1- (length string))))) ;; The operators aren't always operators; check @@ -1981,11 +1974,10 @@ If there is no completion possible, say so and continue searching." ;; If about to search, and previous search regexp was invalid, ;; check that it still is. If it is valid now, ;; let the message we display while searching say that it is valid. - (and isearch-invalid-regexp ellipsis + (and isearch-error ellipsis (condition-case () (progn (re-search-forward isearch-string (point) t) - (setq isearch-invalid-regexp nil - isearch-within-brackets nil)) + (setq isearch-error nil)) (error nil))) ;; If currently failing, display no ellipsis. (or isearch-success (setq ellipsis nil)) @@ -2011,8 +2003,8 @@ If there is no completion possible, say so and continue searching." (defun isearch-message-suffix (&optional c-q-hack ellipsis) (concat (if c-q-hack "^Q" "") - (if isearch-invalid-regexp - (concat " [" isearch-invalid-regexp "]") + (if isearch-error + (concat " [" isearch-error "]") ""))) @@ -2049,8 +2041,7 @@ Can be changed via `isearch-search-fun-function' for special needs." (case-fold-search isearch-case-fold-search) (search-spaces-regexp search-whitespace-regexp) (retry t)) - (if isearch-regexp (setq isearch-invalid-regexp nil)) - (setq isearch-within-brackets nil) + (setq isearch-error nil) (while retry (setq isearch-success (funcall @@ -2074,16 +2065,19 @@ Can be changed via `isearch-search-fun-function' for special needs." (setq isearch-success nil)) (invalid-regexp - (setq isearch-invalid-regexp (car (cdr lossage))) - (setq isearch-within-brackets (string-match "\\`Unmatched \\[" - isearch-invalid-regexp)) + (setq isearch-error (car (cdr lossage))) (if (string-match "\\`Premature \\|\\`Unmatched \\|\\`Invalid " - isearch-invalid-regexp) - (setq isearch-invalid-regexp "incomplete input"))) + isearch-error) + (setq isearch-error "incomplete input"))) + + (search-failed + (setq isearch-success nil) + (setq isearch-error (nth 2 lossage))) + (error ;; stack overflow in regexp search. - (setq isearch-invalid-regexp (format "%s" lossage)))) + (setq isearch-error (format "%s" lossage)))) (if isearch-success nil @@ -2315,7 +2309,7 @@ since they have special meaning in a regexp." ;; `isearch-word' and `isearch-regexp'; ;; - the direction of the current search is expected to be given by ;; `isearch-forward'; -;; - the variable `isearch-invalid-regexp' is expected to be true +;; - the variable `isearch-error' is expected to be true ;; iff `isearch-string' is an invalid regexp. (defvar isearch-lazy-highlight-overlays nil) @@ -2369,7 +2363,7 @@ by other Emacs features." isearch-lazy-highlight-window-end)))) ;; something important did indeed change (isearch-lazy-highlight-cleanup t) ;kill old loop & remove overlays - (when (not isearch-invalid-regexp) + (when (not isearch-error) (setq isearch-lazy-highlight-start-limit beg isearch-lazy-highlight-end-limit end) (setq isearch-lazy-highlight-window (selected-window) @@ -2391,18 +2385,20 @@ by other Emacs features." Attempt to do the search exactly the way the pending isearch would." (let ((case-fold-search isearch-case-fold-search) (search-spaces-regexp search-whitespace-regexp)) - (funcall (isearch-search-fun) - isearch-string - (if isearch-forward - (min (or isearch-lazy-highlight-end-limit (point-max)) - (if isearch-lazy-highlight-wrapped - isearch-lazy-highlight-start - (window-end))) - (max (or isearch-lazy-highlight-start-limit (point-min)) - (if isearch-lazy-highlight-wrapped - isearch-lazy-highlight-end - (window-start)))) - t))) + (condition-case nil + (funcall (isearch-search-fun) + isearch-string + (if isearch-forward + (min (or isearch-lazy-highlight-end-limit (point-max)) + (if isearch-lazy-highlight-wrapped + isearch-lazy-highlight-start + (window-end))) + (max (or isearch-lazy-highlight-start-limit (point-min)) + (if isearch-lazy-highlight-wrapped + isearch-lazy-highlight-end + (window-start)))) + t) + (error nil)))) (defun isearch-lazy-highlight-update () "Update highlighting of other matches for current search." diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 78c8e97626..9b5708d650 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -815,8 +815,9 @@ the effect of `browse-url-new-window-flag'. When called non-interactively, optional second argument NEW-WINDOW is used instead of `browse-url-new-window-flag'. -The order attempted is gnome-moz-remote, Mozilla, Galeon, Netscape, -Mosaic, IXI Mosaic, Lynx in an xterm, MMM, Konqueror, and then W3." +The order attempted is gnome-moz-remote, Mozilla, Galeon, +Konqueror, Netscape, Mosaic, IXI Mosaic, Lynx in an xterm, MMM, +and then W3." (apply (cond ((executable-find browse-url-gnome-moz-program) 'browse-url-gnome-moz) diff --git a/lisp/pcvs-util.el b/lisp/pcvs-util.el index a4eda95e23..2cbb00b324 100644 --- a/lisp/pcvs-util.el +++ b/lisp/pcvs-util.el @@ -1,7 +1,7 @@ ;;; pcvs-util.el --- utility functions for PCL-CVS -*- byte-compile-dynamic: t -*- ;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -;; 2000, 2001, 2004 Free Software Foundation, Inc. +;; 2000, 2001, 2004, 2005 Free Software Foundation, Inc. ;; Author: Stefan Monnier <[email protected]> ;; Keywords: pcl-cvs @@ -205,8 +205,8 @@ It understands elisp style quoting within STRING such that The SEPARATOR regexp defaults to \"\\s-+\"." (let ((sep (or separator "\\s-+")) (i (string-match "[\"]" string))) - (if (null i) (split-string string sep) ; no quoting: easy - (append (unless (eq i 0) (split-string (substring string 0 i) sep)) + (if (null i) (split-string string sep t) ; no quoting: easy + (append (unless (eq i 0) (split-string (substring string 0 i) sep t)) (let ((rfs (read-from-string string i))) (cons (car rfs) (cvs-string->strings (substring string (cdr rfs)) diff --git a/lisp/pcvs.el b/lisp/pcvs.el index 2c0016dcc4..b00de07e50 100644 --- a/lisp/pcvs.el +++ b/lisp/pcvs.el @@ -1704,8 +1704,6 @@ Signal an error if there is no backup file." (message "Retrieving revision %s... Done" rev) (current-buffer)))))) -(eval-and-compile (autoload 'smerge-ediff "smerge-mode")) - ;; FIXME: The user should be able to specify ancestor/head/backup and we should ;; provide sensible defaults when merge info is unavailable (rather than rely ;; on smerge-ediff). Also provide sane defaults for need-merge files. diff --git a/lisp/play/animate.el b/lisp/play/animate.el index 23e7939f47..dcbf3bc261 100644 --- a/lisp/play/animate.el +++ b/lisp/play/animate.el @@ -80,9 +80,11 @@ ;;; Place the character CHAR at position VPOS, HPOS in the current buffer. (defun animate-place-char (char vpos hpos) (goto-char (window-start)) - (let ((next-line-add-newlines t)) + (let (abbrev-mode) (dotimes (i vpos) - (next-line 1))) + (end-of-line) + (if (= (forward-line 1) 1) + (insert "\n")))) (beginning-of-line) (move-to-column (floor hpos) t) (unless (eolp) (delete-char 1)) diff --git a/lisp/progmodes/dcl-mode.el b/lisp/progmodes/dcl-mode.el index 861c3bbb8c..81ed7780a6 100644 --- a/lisp/progmodes/dcl-mode.el +++ b/lisp/progmodes/dcl-mode.el @@ -284,13 +284,13 @@ See `imenu-generic-expression' for details." (defvar dcl-mode-syntax-table nil "Syntax table used in DCL-buffers.") -(if dcl-mode-syntax-table - () +(unless dcl-mode-syntax-table (setq dcl-mode-syntax-table (make-syntax-table)) (modify-syntax-entry ?! "<" dcl-mode-syntax-table) ; comment start (modify-syntax-entry ?\n ">" dcl-mode-syntax-table) ; comment end (modify-syntax-entry ?< "(>" dcl-mode-syntax-table) ; < and ... (modify-syntax-entry ?> ")<" dcl-mode-syntax-table) ; > is a matching pair + (modify-syntax-entry ?\\ "_" dcl-mode-syntax-table) ; not an escape ) diff --git a/lisp/progmodes/gdb-ui.el b/lisp/progmodes/gdb-ui.el index 4fc259cae5..86d0bfaaf4 100644 --- a/lisp/progmodes/gdb-ui.el +++ b/lisp/progmodes/gdb-ui.el @@ -351,7 +351,7 @@ detailed description of this mode. ,(nth 1 var) nil)))) (setq gdb-var-changed t))) (if (re-search-forward "Undefined command" nil t) - (message "Watching expressions requires gdb 6.0 onwards") + (message-box "Watching expressions requires gdb 6.0 onwards") (message "No symbol %s in current context." expr))))) (defun gdb-var-evaluate-expression-handler (varnum changed) @@ -2119,13 +2119,8 @@ Put in buffer and place breakpoint icon." (push (cons bptno (match-string 0)) gdb-location-list)) (gdb-resync) (push (cons bptno "File not found") gdb-location-list) - (if (eq window-system 'x) - (x-popup-dialog - t '("Cannot find source file for breakpoint location.\n\ -Add directory to search path for source files using the GDB command, dir." - ("Ok" . nil))) - (message "Cannot find source file for breakpoint location.\n\ -Add directory to search path for source files using the GDB command, dir.")) + (message-box "Cannot find source file for breakpoint location.\n\ +Add directory to search path for source files using the GDB command, dir.") (throw 'file-not-found nil)) (with-current-buffer (find-file-noselect (match-string 0)) diff --git a/lisp/simple.el b/lisp/simple.el index d0d5f9f017..99e826a6d1 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -3181,8 +3181,9 @@ commands which are sensitive to the Transient Mark mode." :version "21.1" :group 'editing-basics) -(defun next-line (&optional arg) +(defun next-line (&optional arg try-vscroll) "Move cursor vertically down ARG lines. +Interactively, vscroll tall lines if `auto-window-vscroll' is enabled. 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. @@ -3201,7 +3202,7 @@ when there is no goal column. If you are thinking of using this in a Lisp program, consider using `forward-line' instead. It is usually easier to use and more reliable (no dependence on goal column, etc.)." - (interactive "p") + (interactive "p\np") (or arg (setq arg 1)) (if (and next-line-add-newlines (= arg 1)) (if (save-excursion (end-of-line) (eobp)) @@ -3209,16 +3210,17 @@ and more reliable (no dependence on goal column, etc.)." (let ((abbrev-mode nil)) (end-of-line) (insert "\n")) - (line-move arg nil nil t)) + (line-move arg nil nil try-vscroll)) (if (interactive-p) (condition-case nil - (line-move arg nil nil t) + (line-move arg nil nil try-vscroll) ((beginning-of-buffer end-of-buffer) (ding))) - (line-move arg nil nil t))) + (line-move arg nil nil try-vscroll))) nil) -(defun previous-line (&optional arg) +(defun previous-line (&optional arg try-vscroll) "Move cursor vertically up ARG lines. +Interactively, vscroll tall lines if `auto-window-vscroll' is enabled. 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. @@ -3233,13 +3235,13 @@ when there is no goal column. If you are thinking of using this in a Lisp program, consider using `forward-line' with a negative argument instead. It is usually easier to use and more reliable (no dependence on goal column, etc.)." - (interactive "p") + (interactive "p\np") (or arg (setq arg 1)) (if (interactive-p) (condition-case nil - (line-move (- arg) nil nil t) + (line-move (- arg) nil nil try-vscroll) ((beginning-of-buffer end-of-buffer) (ding))) - (line-move (- arg) nil nil t)) + (line-move (- arg) nil nil try-vscroll)) nil) (defcustom track-eol nil @@ -3278,8 +3280,11 @@ Outline mode sets this." (assq prop buffer-invisibility-spec))))) ;; Perform vertical scrolling of tall images if necessary. +;; Don't vscroll in a keyboard macro. (defun line-move (arg &optional noerror to-end try-vscroll) - (if (and auto-window-vscroll try-vscroll) + (if (and auto-window-vscroll try-vscroll + (not defining-kbd-macro) + (not executing-kbd-macro)) (let ((forward (> arg 0)) (part (nth 2 (pos-visible-in-window-p (point) nil t)))) (if (and (consp part) @@ -5068,6 +5073,7 @@ the front of the list of recently selected ones." (defcustom normal-erase-is-backspace (and (not noninteractive) (or (memq system-type '(ms-dos windows-nt)) + (eq initial-window-system 'mac) (and (memq initial-window-system '(x)) (fboundp 'x-backspace-delete-keys-p) (x-backspace-delete-keys-p)) diff --git a/lisp/subr.el b/lisp/subr.el index b318f22491..27abec6781 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -37,27 +37,6 @@ Each element of this list holds the arguments to one call to `defcustom'.") (cons arguments custom-declare-variable-list))) -(defun macro-declaration-function (macro decl) - "Process a declaration found in a macro definition. -This is set as the value of the variable `macro-declaration-function'. -MACRO is the name of the macro being defined. -DECL is a list `(declare ...)' containing the declarations. -The return value of this function is not used." - ;; We can't use `dolist' or `cadr' yet for bootstrapping reasons. - (let (d) - ;; Ignore the first element of `decl' (it's always `declare'). - (while (setq decl (cdr decl)) - (setq d (car decl)) - (cond ((and (consp d) (eq (car d) 'indent)) - (put macro 'lisp-indent-function (car (cdr d)))) - ((and (consp d) (eq (car d) 'debug)) - (put macro 'edebug-form-spec (car (cdr d)))) - (t - (message "Unknown declaration %s" d)))))) - -(setq macro-declaration-function 'macro-declaration-function) - - ;;;; Lisp language features. (defalias 'not 'null) diff --git a/lisp/term/mac-win.el b/lisp/term/mac-win.el index d43264f275..69438c349a 100644 --- a/lisp/term/mac-win.el +++ b/lisp/term/mac-win.el @@ -1010,20 +1010,29 @@ XConsortium: rgb.txt,v 10.41 94/02/20 18:39:36 rws Exp") ;; Map certain keypad keys into ASCII characters ;; that people usually expect. -(define-key function-key-map [return] [?\C-m]) -(define-key function-key-map [M-return] [?\M-\C-m]) -(define-key function-key-map [tab] [?\t]) -(define-key function-key-map [M-tab] [?\M-\t]) (define-key function-key-map [backspace] [?\d]) -(define-key function-key-map [M-backspace] [?\M-\d]) +(define-key function-key-map [delete] [?\d]) +(define-key function-key-map [tab] [?\t]) +(define-key function-key-map [linefeed] [?\n]) +(define-key function-key-map [clear] [?\C-l]) +(define-key function-key-map [return] [?\C-m]) (define-key function-key-map [escape] [?\e]) +(define-key function-key-map [M-backspace] [?\M-\d]) +(define-key function-key-map [M-delete] [?\M-\d]) +(define-key function-key-map [M-tab] [?\M-\t]) +(define-key function-key-map [M-linefeed] [?\M-\n]) +(define-key function-key-map [M-clear] [?\M-\C-l]) +(define-key function-key-map [M-return] [?\M-\C-m]) (define-key function-key-map [M-escape] [?\M-\e]) ;; These tell read-char how to convert ;; these special chars to ASCII. -(put 'return 'ascii-character ?\C-m) -(put 'tab 'ascii-character ?\t) (put 'backspace 'ascii-character ?\d) +(put 'delete 'ascii-character ?\d) +(put 'tab 'ascii-character ?\t) +(put 'linefeed 'ascii-character ?\n) +(put 'clear 'ascii-character ?\C-l) +(put 'return 'ascii-character ?\C-m) (put 'escape 'ascii-character ?\e) diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el index dfd471a87c..ccd7f21f50 100644 --- a/lisp/textmodes/fill.el +++ b/lisp/textmodes/fill.el @@ -1,4 +1,4 @@ -;;; fill.el --- fill commands for Emacs +;;; fill.el --- fill commands for Emacs -*- coding: iso-2022-7bit -*- ;; Copyright (C) 1985,86,92,94,95,96,97,1999,2001,02,03,2004 ;; Free Software Foundation, Inc. @@ -87,7 +87,7 @@ reinserts the fill prefix in each resulting line." (defcustom adaptive-fill-regexp ;; Added `!' for doxygen comments starting with `//!' or `/*!'. ;; Added `%' for TeX comments. - (purecopy "[ \t]*\\([-!|#%;>*]+[ \t]*\\|(?[0-9]+[.)][ \t]*\\)*") + (purecopy "[ \t]*\\([-!|#%;>*,A7$,1s"s#sC$,2"F(B]+[ \t]*\\|(?[0-9]+[.)][ \t]*\\)*") "*Regexp to match text at start of line that constitutes indentation. If Adaptive Fill mode is enabled, a prefix matching this pattern on the first and second lines of a paragraph is used as the @@ -304,12 +304,12 @@ after an opening paren or just before a closing paren or a punctuation mark such as `?' or `:'. It is common in French writing to put a space at such places, which would normally allow breaking the line at those places." - (or (looking-at "[ \t]*[])}�?!;:-]") + (or (looking-at "[ \t]*[])},A;,b;(B?!;:-]") (save-excursion (skip-chars-backward " \t") (unless (bolp) (backward-char 1) - (or (looking-at "[([{�]") + (or (looking-at "[([{,A+,b+(B]") ;; Don't cut right after a single-letter word. (and (memq (preceding-char) '(?\t ?\ )) (eq (char-syntax (following-char)) ?w))))))) diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 2a84d58463..38f69bd225 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -1406,6 +1406,14 @@ This allows it to improve the suggestion list based on actual mispellings." (setq more-lines (= 0 (forward-line)))))))))))))) +;; Insert WORD while translating Latin characters to the equivalent +;; characters that is supported by buffer-file-coding-system. + +(defun ispell-insert-word (word) + (let ((pos (point))) + (insert word) + (if (char-table-p translation-table-for-input) + (translate-region pos (point) translation-table-for-input)))) ;;;###autoload (defun ispell-word (&optional following quietly continue) @@ -1504,7 +1512,7 @@ quit spell session exited." (progn (delete-region start end) (setq start (point)) - (insert new-word) + (ispell-insert-word new-word) (setq end (point)))) (if (not (atom replace)) ;recheck spelling of replacement (progn @@ -2883,7 +2891,7 @@ Returns the sum shift due to changes in word replacements." (delete-region (point) (+ word-len (point))) (if (not (listp replace)) (progn - (insert replace) ; insert dictionary word + (ispell-insert-word replace) ; insert dictionary word (ispell-send-replacement (car poss) replace) (setq accept-list (cons replace accept-list))) (let ((replace-word (car replace))) @@ -3052,7 +3060,7 @@ Standard ispell choices are then available." (setq word (if (atom replacement) replacement (car replacement)) cursor-location (+ (- (length word) (- end start)) cursor-location)) - (insert word) + (ispell-insert-word word) (if (not (atom replacement)) ; recheck spelling of replacement. (progn (goto-char cursor-location) diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index 694903b1fb..6fcf586914 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -350,7 +350,7 @@ an optional alist of possible values." "*When non-nil, tag insertion functions will be XML-compliant. If this variable is customized, the custom value is used always. Otherwise, it is set to be buffer-local when the file has - a DOCTYPE or an XML declaration." +a DOCTYPE or an XML declaration." :type 'boolean :version "22.1" :group 'sgml) @@ -629,7 +629,7 @@ skeleton-transformation RET upcase RET, or put this in your `.emacs': (backward-char) '(("") " [ " _ " ]]")) ((and (eq v2 t) sgml-xml-mode (member ,str sgml-empty-tags)) - '(("") -1 "/>")) + '(("") -1 " />")) ((or (and (eq v2 t) (not sgml-xml-mode)) (string-match "^[/!?]" ,str)) nil) ((symbolp v2) @@ -818,7 +818,8 @@ With prefix argument ARG, repeat this ARG times." (goto-char close) (kill-sexp 1)) (setq open (point)) - (when (sgml-skip-tag-forward 1) + (when (and (sgml-skip-tag-forward 1) + (not (looking-back "/>"))) (kill-sexp -1))) ;; Delete any resulting empty line. If we didn't kill-sexp, ;; this *should* do nothing, because we're right after the tag. @@ -1572,7 +1573,7 @@ This takes effect when first loading the library.") ("dir" ,@list) ("font" nil "size" ("-1") ("+1") ("-2") ("+2") ,@1-7) ("form" (\n _ \n "<input type=\"submit\" value=\"\"" - (if sgml-xml-mode "/>" ">")) + (if sgml-xml-mode " />" ">")) ("action" ,@(cdr href)) ("method" ("get") ("post"))) ("h1" ,@align) ("h2" ,@align) @@ -1891,13 +1892,15 @@ Can be used as a value for `html-mode-hook'." (define-skeleton html-href-anchor "HTML anchor tag with href attribute." "URL: " - '(setq input "http:") + ;; '(setq input "http:") "<a href=\"" str "\">" _ "</a>") (define-skeleton html-name-anchor "HTML anchor tag with name attribute." "Name: " - "<a name=\"" str "\">" _ "</a>") + "<a name=\"" str "\"" + (if sgml-xml-mode (concat " id=\"" str "\"")) + ">" _ "</a>") (define-skeleton html-headline-1 "HTML level 1 headline tags." @@ -1932,18 +1935,18 @@ Can be used as a value for `html-mode-hook'." (define-skeleton html-horizontal-rule "HTML horizontal rule tag." nil - (if sgml-xml-mode "<hr/>" "<hr>") \n) + (if sgml-xml-mode "<hr />" "<hr>") \n) (define-skeleton html-image "HTML image tag." - nil - "<img src=\"" _ "\"" - (if sgml-xml-mode "/>" ">")) + "Image URL: " + "<img src=\"" str "\" alt=\"" _ "\"" + (if sgml-xml-mode " />" ">")) (define-skeleton html-line "HTML line break tag." nil - (if sgml-xml-mode "<br/>" "<br>") \n) + (if sgml-xml-mode "<br />" "<br>") \n) (define-skeleton html-ordered-list "HTML ordered list tags." @@ -1969,7 +1972,7 @@ Can be used as a value for `html-mode-hook'." "HTML paragraph tag." nil (if (bolp) nil ?\n) - \n "<p>" _ (if sgml-xml-mode "</p>")) + "<p>" _ (if sgml-xml-mode "</p>")) (define-skeleton html-checkboxes "Group of connected checkbox inputs." @@ -1981,12 +1984,13 @@ Can be used as a value for `html-mode-hook'." "\" name=\"" (or v1 (setq v1 (skeleton-read "Name: "))) "\" value=\"" str ?\" (when (y-or-n-p "Set \"checked\" attribute? ") - (funcall skeleton-transformation " checked")) - (if sgml-xml-mode "/>" ">") + (funcall skeleton-transformation + (if sgml-xml-mode " checked=\"checked\"" " checked"))) + (if sgml-xml-mode " />" ">") (skeleton-read "Text: " (capitalize str)) (or v2 (setq v2 (if (y-or-n-p "Newline after text? ") (funcall skeleton-transformation - (if sgml-xml-mode "<br/>" "<br>")) + (if sgml-xml-mode "<br />" "<br>")) ""))) \n)) @@ -2000,12 +2004,13 @@ Can be used as a value for `html-mode-hook'." "\" name=\"" (or (car v2) (setcar v2 (skeleton-read "Name: "))) "\" value=\"" str ?\" (when (and (not v1) (setq v1 (y-or-n-p "Set \"checked\" attribute? "))) - (funcall skeleton-transformation " checked")) - (if sgml-xml-mode "/>" ">") + (funcall skeleton-transformation + (if sgml-xml-mode " checked=\"checked\"" " checked"))) + (if sgml-xml-mode " />" ">") (skeleton-read "Text: " (capitalize str)) (or (cdr v2) (setcdr v2 (if (y-or-n-p "Newline after text? ") (funcall skeleton-transformation - (if sgml-xml-mode "<br/>" "<br>")) + (if sgml-xml-mode "<br />" "<br>")) ""))) \n)) diff --git a/lisp/tooltip.el b/lisp/tooltip.el index c4ac57eac9..e4cab1beba 100644 --- a/lisp/tooltip.el +++ b/lisp/tooltip.el @@ -1,6 +1,6 @@ ;;; tooltip.el --- show tooltip windows -;; Copyright (C) 1997, 1999, 2000, 2001, 2002, 2003, 2004 +;; Copyright (C) 1997, 1999, 2000, 2001, 2002, 2003, 2004, 2005 ;; Free Software Foundation, Inc. ;; Author: Gerd Moellmann <[email protected]> @@ -41,8 +41,6 @@ :version "21.1" :tag "Tool Tips") -(defvar tooltip-mode) - (defcustom tooltip-delay 0.7 "Seconds to wait before displaying a tooltip the first time." :tag "Delay" @@ -122,11 +120,9 @@ position to pop up the tooltip." "*Non-nil means show tooltips in GUD sessions." :type 'boolean :tag "GUD" - :set #'(lambda (symbol on) - (setq tooltip-gud-tips-p on)) :group 'tooltip) -(defcustom tooltip-gud-modes '(gud-mode c-mode c++-mode) +(defcustom tooltip-gud-modes '(gud-mode c-mode c++-mode fortran-mode) "List of modes for which to enable GUD tips." :type 'sexp :tag "GUD modes" @@ -187,26 +183,23 @@ This might return nil if the event did not occur over a buffer." ;; would be accompanied by a full redisplay. ;;;###autoload -(defun tooltip-mode (&optional arg) - "Mode for tooltip display. +(define-minor-mode tooltip-mode + "Toggle Tooltip display. With ARG, turn tooltip mode on if and only if ARG is positive." - (interactive "P") - (unless (fboundp 'x-show-tip) + :global t + :group 'tooltip + (unless (or (null tooltip-mode) (fboundp 'x-show-tip)) (error "Sorry, tooltips are not yet available on this system")) - (let* ((on (if arg - (> (prefix-numeric-value arg) 0) - (not tooltip-mode))) - (hook-fn (if on 'add-hook 'remove-hook))) - (setq tooltip-mode on) + (let ((hook-fn (if tooltip-mode 'add-hook 'remove-hook))) (funcall hook-fn 'change-major-mode-hook 'tooltip-change-major-mode) (tooltip-activate-mouse-motions-if-enabled) (funcall hook-fn 'pre-command-hook 'tooltip-hide) (funcall hook-fn 'tooltip-hook 'tooltip-gud-tips) (funcall hook-fn 'tooltip-hook 'tooltip-help-tips) - (setq show-help-function (if on 'tooltip-show-help-function nil)) + (setq show-help-function (if tooltip-mode 'tooltip-show-help-function nil)) ;; `ignore' is the default binding for mouse movements. (define-key global-map [mouse-movement] - (if on 'tooltip-mouse-motion 'ignore)))) + (if tooltip-mode 'tooltip-mouse-motion 'ignore)))) ;;; Timeout for tooltip display @@ -246,16 +239,14 @@ With ARG, turn tooltip mode on if and only if ARG is positive." (defun tooltip-activate-mouse-motions-if-enabled () "Reconsider for all buffers whether mouse motion events are desired." (remove-hook 'post-command-hook 'tooltip-activate-mouse-motions-if-enabled) - (let ((buffers (buffer-list))) + (dolist (buffer (buffer-list)) (save-excursion - (while buffers - (set-buffer (car buffers)) - (if (and tooltip-mode - tooltip-gud-tips-p - (memq major-mode tooltip-gud-modes)) - (tooltip-activate-mouse-motions t) - (tooltip-activate-mouse-motions nil)) - (setq buffers (cdr buffers)))))) + (set-buffer buffer) + (if (and tooltip-mode + tooltip-gud-tips-p + (memq major-mode tooltip-gud-modes)) + (tooltip-activate-mouse-motions t) + (tooltip-activate-mouse-motions nil))))) (defvar tooltip-mouse-motions-active nil "Locally t in a buffer if tooltip processing of mouse motion is enabled.") @@ -441,12 +432,11 @@ region for the tip window to be shown. If tooltip-gud-dereference is t, add a `*' in front of the printed expression. This function must return nil if it doesn't handle EVENT." - (let (gud-buffer process) + (let (process) (when (and (eventp event) tooltip-gud-tips-p (boundp 'gud-comint-buffer) - (setq gud-buffer gud-comint-buffer) - (setq process (get-buffer-process gud-buffer)) + (setq process (get-buffer-process gud-comint-buffer)) (posn-point (event-end event)) (progn (setq tooltip-gud-event event) (eval (cons 'and tooltip-gud-display)))) @@ -464,9 +454,11 @@ This function must return nil if it doesn't handle EVENT." expr))))))) (defun gdb-tooltip-print () - (tooltip-show + (tooltip-show (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer) - (buffer-string)))) + (let ((string (buffer-string))) + ;; remove newline for tooltip-use-echo-area + (substring string 0 (- (length string) 1)))))) ;;; Tooltip help. @@ -520,23 +512,6 @@ Value is non-nil if this function handled the tip." (tooltip-show tooltip-help-message) t)) - -;;; Do this after all functions have been defined that are called from -;;; `tooltip-mode'. The actual default value of `tooltip-mode' is set -;;; in startup.el. - -;;;###autoload -(defcustom tooltip-mode nil - "Non-nil if Tooltip mode is enabled. -Setting this variable directly does not take effect; -use either \\[customize] or the function `tooltip-mode'." - :set (lambda (symbol value) - (tooltip-mode (or value 0))) - :initialize 'custom-initialize-default - :type 'boolean - :require 'tooltip - :group 'tooltip) - (provide 'tooltip) ;; arch-tag: 3d61135e-4618-4a78-af28-183f6df5636f |