diff options
| author | Karoly Lorentey <[email protected]> | 2005-04-25 11:49:38 +0000 |
|---|---|---|
| committer | Karoly Lorentey <[email protected]> | 2005-04-25 11:49:38 +0000 |
| commit | 351c9889873cb0e8c4e43bc51f9a5b36b81ac9a6 (patch) | |
| tree | b487571bcab596eefd9c6049e9d9354e8ec0ac67 | |
| parent | 5ad1bc4dead80db3e81a6855714bc0b5817f5fc0 (diff) | |
| parent | 61b397cdc2019424c47f1fc5571fc127e2ed747d (diff) | |
Merged from [email protected] (patch 67, 270-278)
Patches applied:
* [email protected]/emacs--cvs-trunk--0--patch-270
Update from CVS
* [email protected]/emacs--cvs-trunk--0--patch-271
Update from CVS
* [email protected]/emacs--cvs-trunk--0--patch-272
src/xdisp.c (dump_glyph_row): Don't display overlay_arrow_p field.
* [email protected]/emacs--cvs-trunk--0--patch-273
Update from CVS
* [email protected]/emacs--cvs-trunk--0--patch-274
Update from CVS
* [email protected]/emacs--cvs-trunk--0--patch-275
Update from CVS
* [email protected]/emacs--cvs-trunk--0--patch-276
Update from CVS
* [email protected]/emacs--cvs-trunk--0--patch-277
Merge from gnus--rel--5.10
* [email protected]/emacs--cvs-trunk--0--patch-278
Update from CVS
* [email protected]/gnus--rel--5.10--patch-67
Update from CVS
git-archimport-id: [email protected]/emacs--multi-tty--0--patch-332
84 files changed, 3357 insertions, 953 deletions
@@ -1,3 +1,13 @@ +2005-04-23 Andreas Schwab <[email protected]> + + * configure.in: Remove duplicate match for powerpc configuration. + * configure: Regenerate. + +2005-04-20 Thien-Thi Nguyen <[email protected]> + + * configure.in: Check for <pwd.h>. + * configure: Regenerate. + 2005-04-14 Lute Kamstra <[email protected]> * make-dist: Distribute all ChangeLog files in lisp/. @@ -1816,11 +1816,6 @@ _ACEOF machine=arm opsys=gnu-linux ;; - ppc-*-linux | \ - powerpc-*-linux* ) - machine=macppc opsys=gnu-linux - ;; - ## Altos 3068 m68*-altos-sysv* ) machine=altos opsys=usg5-2 @@ -5297,11 +5292,12 @@ fi + for ac_header in sys/select.h sys/timeb.h sys/time.h unistd.h utime.h \ linux/version.h sys/systeminfo.h termios.h limits.h string.h stdlib.h \ termcap.h stdio_ext.h fcntl.h strings.h coff.h pty.h sys/mman.h \ sys/param.h sys/vlimit.h sys/resource.h locale.h sys/_mbstate_t.h \ - sys/utsname.h + sys/utsname.h pwd.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if eval "test \"\${$as_ac_Header+set}\" = set"; then diff --git a/configure.in b/configure.in index 1a818a5b74..e384ed68b5 100644 --- a/configure.in +++ b/configure.in @@ -337,11 +337,6 @@ dnl see the `changequote' comment above. machine=arm opsys=gnu-linux ;; - ppc-*-linux | \ - powerpc-*-linux* ) - machine=macppc opsys=gnu-linux - ;; - ## Altos 3068 m68*-altos-sysv* ) machine=altos opsys=usg5-2 @@ -1455,7 +1450,7 @@ AC_CHECK_HEADERS(sys/select.h sys/timeb.h sys/time.h unistd.h utime.h \ linux/version.h sys/systeminfo.h termios.h limits.h string.h stdlib.h \ termcap.h stdio_ext.h fcntl.h strings.h coff.h pty.h sys/mman.h \ sys/param.h sys/vlimit.h sys/resource.h locale.h sys/_mbstate_t.h \ - sys/utsname.h) + sys/utsname.h pwd.h) AC_MSG_CHECKING(if personality LINUX32 can be set) AC_TRY_COMPILE([#include <sys/personality.h>], [personality (PER_LINUX32)], @@ -1555,7 +1550,7 @@ AC_CHECK_MEMBER(struct tm.tm_gmtoff, [AC_DEFINE(HAVE_TM_GMTOFF, 1, [Define to 1 if `tm_gmtoff' is member of `struct tm'.])],, [#include <time.h>]) -AC_CHECK_MEMBERS([struct ifreq.ifr_flags, struct ifreq.ifr_hwaddr, +AC_CHECK_MEMBERS([struct ifreq.ifr_flags, struct ifreq.ifr_hwaddr, struct ifreq.ifr_netmask, struct ifreq.ifr_broadaddr, struct ifreq.ifr_addr], , , [AC_INCLUDES_DEFAULT @@ -1765,7 +1760,7 @@ else HAVE_XFREE386=no fi AC_MSG_RESULT($HAVE_XFREE386) - + dnl Check for need for bigtoc support on IBM AIX case ${host_os} in @@ -2178,7 +2173,7 @@ if test "${with_xim}" != "no"; then AC_DEFINE(USE_XIM, 1, [Define to 1 if we should use XIM, if it is available.]) fi - + if test "${HAVE_XIM}" != "no"; then late_CFLAGS=$CFLAGS @@ -2662,7 +2657,7 @@ dnl The following looks like a useful start. dnl dnl AC_SYS_POSIX_TERMIOS dnl if test $ac_cv_sys_posix_termios = yes; then -dnl AC_DEFINE(HAVE_TERMIOS, 1, [Define to 1 if you have POSIX-style functions +dnl AC_DEFINE(HAVE_TERMIOS, 1, [Define to 1 if you have POSIX-style functions dnl and macros for terminal control.]) dnl AC_DEFINE(HAVE_TCATTR, 1, [Define to 1 if you have tcgetattr and tcsetattr.]) dnl fi @@ -120,10 +120,17 @@ versions which recognize Thai words. Affected commands are ** fast-lock.el and lazy-lock.el are obsolete. Use jit-lock.el instead. +--- +** The default settings for JIT stealth lock parameters are changed. +The default value for the user option jit-lock-stealth-time is now 16 +instead of 3, and the default value of jit-lock-stealth-nice is now +0.5 instead of 0.125. The new defaults should lower the CPU usage +when Emacs is fontifying in the background. + ** iso-acc.el is now obsolete. Use one of the latin input methods instead. --- -** Languange environment and various default coding systems are setup +** Language environment and various default coding systems are setup more correctly according to the current locale name. If the locale name doesn't specify a charset, the default is what glibc defines. This change may result in using the different coding systems as @@ -2507,6 +2514,9 @@ buffers to change filenames, permissions, etc... ** The thumbs.el package allows you to preview image files as thumbnails and can be invoked from a Dired buffer. +** Image files are normally visited in Image mode, which lets you toggle +between viewing the image and viewing the text using C-c C-c. + +++ ** The new python.el package is used to edit Python and Jython programs. @@ -2754,12 +2764,10 @@ the command `undefined'. (In earlier Emacs versions, it used * Lisp Changes in Emacs 22.1 ---- -** easy-mmode-define-global-mode has been renamed to -define-global-minor-mode. The old name remains as an alias. +** New functions, macros, and commands +++ -** The new function `filter-buffer-substring' extracts a buffer +*** The new function `filter-buffer-substring' extracts a buffer substring, passes it through a set of filter functions, and returns the filtered substring. It is used instead of `buffer-substring' or `delete-and-extract-region' when copying text into a user-accessible @@ -2770,6 +2778,95 @@ list of filter function is specified by the new variable text. +++ +*** (while-no-input BODY...) runs BODY, but only so long as no input +arrives. If the user types or clicks anything, BODY stops as if a +quit had occurred. while-no-input returns the value of BODY, if BODY +finishes. It returns nil if BODY was aborted. + ++++ +*** New function `looking-back' checks whether a regular expression matches +the text before point. Specifying the LIMIT argument bounds how far +back the match can start; this is a way to keep it from taking too long. + ++++ +*** New functions `make-progress-reporter', `progress-reporter-update', +`progress-reporter-force-update', `progress-reporter-done', and +`dotimes-with-progress-reporter' provide a simple and efficient way for +a command to present progress messages for the user. + ++++ +*** The new primitive `get-internal-run-time' returns the processor +run time used by Emacs since start-up. + ++++ +*** The new function `called-interactively-p' does what many people +have mistakenly believed `interactive-p' did: it returns t if the +calling function was called through `call-interactively'. This should +only be used when you cannot add a new "interactive" argument to the +command. + ++++ +*** The new function `assoc-string' replaces `assoc-ignore-case' and +`assoc-ignore-representation', which are still available, but have +been declared obsolete. + +--- +*** New function quail-find-key returns a list of keys to type in the +current input method to input a character. + ++++ +*** New functions posn-at-point and posn-at-x-y return +click-event-style position information for a given visible buffer +position or for a given window pixel coordinate. + ++++ +*** The new primitive `set-file-times' sets a file's access and +modification times. Magic file name handlers can handle this +operation. + ++++ +*** The new function syntax-after returns the syntax code +of the character after a specified buffer position, taking account +of text properties as well as the character code. + ++++ +*** `syntax-class' extracts the class of a syntax code (as returned +by syntax-after). + ++++ +*** New function `line-number-at-pos' returns line number of current +line in current buffer, or if optional buffer position is given, line +number of corresponding line in current buffer. + ++++ +*** New function `macroexpand-all' expands all macros in a form. +It is similar to the Common-Lisp function of the same name. +One difference is that it guarantees to return the original argument +if no expansion is done, which may be tested using `eq'. + ++++ +*** New macro with-local-quit temporarily sets inhibit-quit to nil for use +around potentially blocking or long-running code in timers +and post-command-hooks. + ++++ +*** The new function `rassq-delete-all' deletes all elements from an +alist whose cdr is `eq' to a specified value. + ++++ +*** New macro define-obsolete-variable-alias to combine defvaralias and +make-obsolete-variable. + ++++ +** copy-file now takes an additional option arg MUSTBENEW. + +This argument works like the MUSTBENEW argument of write-file. + +--- +** easy-mmode-define-global-mode has been renamed to +define-global-minor-mode. The old name remains as an alias. + ++++ ** An element of buffer-undo-list can now have the form (apply FUNNAME . ARGS), where FUNNAME is a symbol other than t or nil. That stands for a high-level change that should be undone by evaluating (apply @@ -2801,28 +2898,11 @@ clickable link with the new function `mouse-on-link-p'. This is the function used by the new `mouse-1-click-follows-link' functionality. +++ -** (while-no-input BODY...) runs BODY, but only so long as no input -arrives. If the user types or clicks anything, BODY stops as if a -quit had occurred. while-no-input returns the value of BODY, if BODY -finishes. It returns nil if BODY was aborted. - -+++ ** `set-auto-mode' now gives the interpreter magic line (if present) precedence over the file name. Likewise an <?xml or <!DOCTYPE declaration will give the buffer XML or SGML mode, based on the new var `magic-mode-alist'. -+++ -** New function `looking-back' checks whether a regular expression matches -the text before point. Specifying the LIMIT argument bounds how far -back the match can start; this is a way to keep it from taking too long. - -+++ -** New functions `make-progress-reporter', `progress-reporter-update', -`progress-reporter-force-update', `progress-reporter-done', and -`dotimes-with-progress-reporter' provide a simple and efficient way for -a command to present progress messages for the user. - --- ** To manipulate the File menu using easy-menu, you must specify the proper name "file". In previous Emacs versions, you had to specify @@ -2851,27 +2931,6 @@ If it is non-nil, it specifies which buffers to list. NOMODIFY. If it is non-nil, it means don't mark the buffer modified. +++ -** The new function syntax-after returns the syntax code -of the character after a specified buffer position, taking account -of text properties as well as the character code. - -+++ -** The new primitive `get-internal-run-time' returns the processor -run time used by Emacs since start-up. - -+++ -** The new function `called-interactively-p' does what many people -have mistakenly believed `interactive-p' did: it returns t if the -calling function was called through `call-interactively'. This should -only be used when you cannot add a new "interactive" argument to the -command. - -+++ -** The new function `assoc-string' replaces `assoc-ignore-case' and -`assoc-ignore-representation', which are still available, but have -been declared obsolete. - -+++ ** An interactive specification may now use the code letter 'U' to get the up-event that was discarded in case the last key sequence read for a previous 'k' or 'K' argument was a down-event; otherwise nil is used. @@ -2930,15 +2989,6 @@ changed to "connection broken by remote peer". undo-outer-limit, garbage collection empties it. This is to prevent it from using up the available memory and choking Emacs. ---- -** New function quail-find-key returns a list of keys to type in the -current input method to input a character. - -+++ -** New functions posn-at-point and posn-at-x-y return -click-event-style position information for a given visible buffer -position or for a given window pixel coordinate. - +++ ** skip-chars-forward and skip-chars-backward now handle character classes such as [:alpha:], along with individual characters @@ -2953,11 +3003,6 @@ arg is non-nil. ** The function `eql' is now available without requiring the CL package. +++ -** The new primitive `set-file-times' sets a file's access and -modification times. Magic file name handlers can handle this -operation. - -+++ ** The display space :width and :align-to text properties are now supported on text terminals. @@ -3081,11 +3126,6 @@ text property string that may be present at the current window position. The cursor may now be placed on any character of such strings by giving that character a non-nil `cursor' text property. -+++ -** New macro with-local-quit temporarily sets inhibit-quit to nil for use -around potentially blocking or long-running code in timers -and post-command-hooks. - ** The first face specification element in a defface can specify `default' instead of frame classification. Then its attributes act as defaults that apply to all the subsequent cases (and may be overridden @@ -3143,11 +3183,6 @@ If either property is not set, the default `overlay-arrow-string' or 'overlay-arrow-fringe-bitmap' will be used. +++ -** New function `line-number-at-pos' returns line number of current -line in current buffer, or if optional buffer position is given, line -number of corresponding line in current buffer. - -+++ ** The default value of `sentence-end' is now defined using the new variable `sentence-end-without-space' which contains such characters that end a sentence without following spaces. @@ -3165,12 +3200,6 @@ then this function returns the regexp constructed from the variables implemented (such as "*") are no longer accepted. +++ -** New function `macroexpand-all' expands all macros in a form. -It is similar to the Common-Lisp function of the same name. -One difference is that it guarantees to return the original argument -if no expansion is done, which may be tested using `eq'. - -+++ ** New function `delete-dups' destructively removes `equal' duplicates from a list. Of several `equal' occurrences of an element in the list, the first one is kept. @@ -4195,16 +4224,8 @@ This returns the mode-line or header-line of the selected (or a specified) window as a string with or without text properties. +++ -** New function `safe-get'. - -This function is like `get', but never signals an error for -a malformed symbol property list. - -+++ -** New function `safe-plist-get'. - -This function is like `plist-get', but never signals an error for -a malformed property list. +** Functions `get' and `plist-get' no longer signals an error for +a malformed property list. They also detect cyclic lists. +++ ** New functions `lax-plist-get' and `lax-plist-put'. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index b4437f350d..8820980bf7 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,200 @@ +2005-04-25 Kenichi Handa <[email protected]> + + * international/mule-cmds.el (select-safe-coding-system): Don't + check consistency with coding: spec, etc if raw-text or + no-conversion was found to be safe. + +2005-04-24 Richard M. Stallman <[email protected]> + + * mail/sendmail.el (mail-font-lock-keywords): Match any number of + citation markers at start of each line. + + * mail/rmail.el (rmail-font-lock-keywords): Match any number of + citation markers at start of each line. + + * font-lock.el (font-lock-comment-delimiter-face): Doc fix. + + * files.el (mode-require-final-newline): Fix previous change. + (require-final-newline): Fix type label. + +2005-04-24 Glenn Morris <[email protected]> + + * progmodes/f90.el (f90-calculate-indent): Fix treatment of first + statement in buffer (broken by 2004-11-24 change). + +2005-04-24 Kim F. Storm <[email protected]> + + * ido.el (ido-everywhere): Save and restore old read-buffer-function + and read-file-name-function values. Don't overwrite existing + non-nil values if ido-mode is enabled without ido-everywhere. + +2005-04-24 Luc Teirlinck <[email protected]> + + * files.el (mode-require-final-newline): Minor doc fix. + +2005-04-24 Eli Zaretskii <[email protected]> + + * subr.el (syntax-after): Doc fix. + (syntax-class): If argument is nil, return nil. Mask off upper 16 + bits, not 8 bits. + + * files.el (mode-require-final-newline): Doc fix. + (backup-buffer-copy): Fix last change. + +2005-04-24 YAMAMOTO Mitsuharu <[email protected]> + + * term/mac-win.el: Require select. Set selection-coding-system to + mac-system-coding-system. Call menu-bar-enable-clipboard. + (x-last-selected-text-clipboard, x-last-selected-text-primary) + (x-select-enable-clipboard): New variables. + (x-select-text, x-get-selection, x-selection-value) + (x-get-selection-value, mac-select-convert-to-string) + (mac-services-open-file, mac-services-open-selection) + (mac-services-insert-text): New functions. + (CLIPBOARD, FIND): Put mac-scrap-name property. + (com.apple.traditional-mac-plain-text, public.utf16-plain-text) + (public.tiff): Put mac-ostype property. + (selection-converter-alist): Add entries for them. + (mac-application-menu-map): New keymap. + (interprogram-cut-function, interprogram-paste-function): Set to + x-select-text and x-get-selection-value, respectively. + (split-window-keep-point): Set to t. + +2005-04-23 Richard M. Stallman <[email protected]> + + * files.el (read-directory-name): Always pass non-nil + DEFAULT-FILENAME arg to read-file-name. + (backup-buffer-copy, basic-save-buffer-2): Take care against + writing thru an unexpected existing symlink. + (revert-buffer): In indirect buffer, revert the base buffer. + (magic-mode-alist): Doc fix. + (buffer-stale-function): Doc fix. + (minibuffer-with-setup-hook): Avoid warning. + (mode-require-final-newline): Doc and custom fix. + + * follow.el (follow-end-of-buffer): Use with-no-warnings. + + * font-lock.el (font-lock-comment-face): On terminals with few colors, + use the default appearance. + (font-lock-comment-delimiter-face): New face, new variable. + + * imenu.el (imenu--generic-function): The official position of a + definition is the start of the line that BEG is in. + + * midnight.el (midnight-timer): Move defvar up. + + * mouse.el (mouse-drag-region-1): Delete some debugging code. + + * saveplace.el (save-place-to-alist): Use with-no-warnings. + + * startup.el (command-line): Use with-no-warnings. + + * window.el (window-size-fixed): New defvar. + + * emacs-lisp/easymenu.el (easy-menu-do-define): Use defalias, not fset. + + * mail/rmail.el (rmail-font-lock-keywords): + Use font-lock-comment-delimiter-face. + + * mail/sendmail.el (mail-font-lock-keywords): + Use font-lock-comment-delimiter-face. + + * progmodes/compile.el (next-error-highlight-timer): New defvar. + +2005-04-23 SAITO Takuya <[email protected]> (tiny change) + + * progmodes/compile.el (compilation-mode-font-lock-keywords): + Specify t for LAXMATCH when matching directories. + Save match data around compilation-compat-error-properties form. + +2005-04-23 David Kastrup <[email protected]> + + * textmodes/tex-mode.el (TeX-mode, plain-TeX-mode, LaTeX-mode): + Mention that the autoloaded aliases should be kept for AUCTeX. + +2005-04-23 Andreas Schwab <[email protected]> + + * isearch.el (isearch-forward): Doc fix. + +2005-04-23 Eli Zaretskii <[email protected]> + + * jit-lock.el (jit-lock-stealth-time): Change default value to 16. + (jit-lock-stealth-nice): Change default value to 0.5. + +2005-04-23 Eric Hanchrow <[email protected]> (tiny change) + + * abbrev.el (write-abbrev-file): Write table entries in + alphabetical order by table name. + +2005-04-22 Kim F. Storm <[email protected]> + + * ido.el (ido-read-internal): Fix `list' completion. + +2005-04-22 Kenichi Handa <[email protected]> + + * recentf.el (recentf-save-file-coding-system): New variable. + (recentf-save-list): Encode the file by + recentf-save-file-coding-system and add coding: tag. + +2005-04-22 Nick Roberts <[email protected]> + + * emacs-lisp/byte-run.el (define-obsolete-variable-alias): New macro. + +2005-04-21 Lute Kamstra <[email protected]> + + * loadhist.el (unload-feature): Don't remove a function from hooks + if it is about to be restored to an autoload . Remove functions + that will become unbound from auto-mode-alist. Simplify the code. + + * subr.el (assq-delete-all): New implementation that is linear, + not quadratic. Suggested by David Kastrup <[email protected]>. + (rassq-delete-all): New function. + + * menu-bar.el (menu-bar-options-save, menu-bar-showhide-menu): Add + size-indication-mode. + +2005-04-21 Kenichi Handa <[email protected]> + + * international/mule-cmds.el: Add autoload for widget-value in + eval-when-compile + +2005-04-21 Nick Roberts <[email protected]> + + * menu-bar.el (menu-bar-options-save, menu-bar-showhide-menu): + Add tooltip-mode. + + * bindings.el (mode-line-mode-menu): Remove tooltip-mode. + +2005-04-20 Luc Teirlinck <[email protected]> + + * progmodes/inf-lisp.el (inferior-lisp): New defgroup. + (inferior-lisp-filter-regexp, inferior-lisp-program) + (inferior-lisp-load-command, inferior-lisp-prompt) + (inferior-lisp-mode-hook, lisp-source-modes) + (inferior-lisp-load-hook): defvar->defcustom. + (inferior-lisp-program, inferior-lisp-prompt) + (inferior-lisp-load-hook): Doc fixes. + (inferior-lisp-install-letter-bindings): Small change in + introductory comment. + +2005-04-20 Dan Nicolaescu <[email protected]> + + * vc.el (vc-annotate-color-map): Change some colors so that text + using them as foreground is readable on both white and black + backgrounds. + +2005-04-20 Stefan Monnier <[email protected]> + + * international/mule-conf.el (translation-table-for-input): + Remove redundant declaration. + +2005-04-20 Nick Roberts <[email protected]> + + * progmodes/gud.el (gud-menu-map): Add tooltip-toggle-gud-tips. + + * tooltip.el (tooltip-gud-tips-p): Expand documentation. + (tooltip-toggle-gud-tips): New function. + 2005-04-20 YAMAMOTO Mitsuharu <[email protected]> * term/mac-win.el (mac-symbol-encoder): Fix mappings of left and diff --git a/lisp/abbrev.el b/lisp/abbrev.el index aa4249d014..711e8e2ebe 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -92,11 +92,11 @@ Mark is set after the inserted text." (interactive) (push-mark (save-excursion - (let ((tables abbrev-table-name-list)) - (while tables - (insert-abbrev-table-description (car tables) t) - (setq tables (cdr tables)))) - (point)))) + (let ((tables abbrev-table-name-list)) + (while tables + (insert-abbrev-table-description (car tables) t) + (setq tables (cdr tables)))) + (point)))) (defun list-abbrevs (&optional local) "Display a list of defined abbrevs. @@ -168,23 +168,23 @@ the ones defined from the buffer now." (interactive "P") (if arg (kill-all-abbrevs)) (save-excursion - (goto-char (point-min)) - (while (and (not (eobp)) (re-search-forward "^(" nil t)) - (let* ((buf (current-buffer)) - (table (read buf)) - abbrevs name hook exp count sys) - (forward-line 1) - (while (progn (forward-line 1) - (not (eolp))) - (setq name (read buf) count (read buf)) - (if (equal count '(sys)) - (setq sys t count (read buf))) - (setq exp (read buf)) - (skip-chars-backward " \t\n\f") - (setq hook (if (not (eolp)) (read buf))) - (skip-chars-backward " \t\n\f") - (setq abbrevs (cons (list name exp hook count sys) abbrevs))) - (define-abbrev-table table abbrevs))))) + (goto-char (point-min)) + (while (and (not (eobp)) (re-search-forward "^(" nil t)) + (let* ((buf (current-buffer)) + (table (read buf)) + abbrevs name hook exp count sys) + (forward-line 1) + (while (progn (forward-line 1) + (not (eolp))) + (setq name (read buf) count (read buf)) + (if (equal count '(sys)) + (setq sys t count (read buf))) + (setq exp (read buf)) + (skip-chars-backward " \t\n\f") + (setq hook (if (not (eolp)) (read buf))) + (skip-chars-backward " \t\n\f") + (setq abbrevs (cons (list name exp hook count sys) abbrevs))) + (define-abbrev-table table abbrevs))))) (defun read-abbrev-file (&optional file quietly) "Read abbrev definitions from file written with `write-abbrev-file'. @@ -201,7 +201,7 @@ Optional second argument QUIETLY non-nil means don't display a message." Optional argument FILE is the name of the file to read; it defaults to the value of `abbrev-file-name'. Does not display any message." - ;(interactive "fRead abbrev file: ") + ;(interactive "fRead abbrev file: ") (read-abbrev-file file t)) (defun write-abbrev-file (&optional file) @@ -221,7 +221,17 @@ specified in `abbrev-file-name' is used." (let ((coding-system-for-write 'emacs-mule)) (with-temp-file file (insert ";;-*-coding: emacs-mule;-*-\n") - (dolist (table abbrev-table-name-list) + (dolist (table + ;; We sort the table in order to ease the automatic + ;; merging of different versions of the user's abbrevs + ;; file. This is useful, for example, for when the + ;; user keeps their home directory in a revision + ;; control system, and is therefore keeping multiple + ;; slightly-differing copies loosely synchronized. + (sort (copy-sequence abbrev-table-name-list) + (lambda (s1 s2) + (string< (symbol-name s1) + (symbol-name s2))))) (insert-abbrev-table-description table nil))))) (defun add-mode-abbrev (arg) diff --git a/lisp/bindings.el b/lisp/bindings.el index fa10873c33..1a30313fe5 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -392,9 +392,6 @@ 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/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 60fc862676..ab7259b667 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -129,6 +129,18 @@ was first made obsolete, for example a date or a release number." (put variable 'byte-obsolete-variable (cons new when)) variable) +(defmacro define-obsolete-variable-alias (variable new + &optional when docstring) + "Make VARIABLE a variable alias for NEW and warn that VARIABLE is obsolete. +If provided, WHEN should be a string indicating when VARIABLE was +first made obsolete, for example a date or a release number. The +optional argument DOCSTRING specifies the documentation string +for VARIABLE; if DOCSTRING is omitted or nil, VARIABLE uses the +documentation string of NEW unless it already has one." + `(progn + (defvaralias ,variable ,new ,docstring) + (make-obsolete-variable ,variable ,new ,when))) + (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." diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el index b0f3b9b9d3..78ba1fe27b 100644 --- a/lisp/emacs-lisp/easymenu.el +++ b/lisp/emacs-lisp/easymenu.el @@ -160,18 +160,18 @@ A menu item can be a list with the same format as MENU. This is a submenu." (let ((keymap (easy-menu-create-menu (car menu) (cdr menu)))) (when symbol (set symbol keymap) - (fset symbol - `(lambda (event) ,doc (interactive "@e") - ;; FIXME: XEmacs uses popup-menu which calls the binding - ;; while x-popup-menu only returns the selection. - (x-popup-menu event - (or (and (symbolp ,symbol) - (funcall - (or (plist-get (get ,symbol 'menu-prop) - :filter) - 'identity) - (symbol-function ,symbol))) - ,symbol))))) + (defalias symbol + `(lambda (event) ,doc (interactive "@e") + ;; FIXME: XEmacs uses popup-menu which calls the binding + ;; while x-popup-menu only returns the selection. + (x-popup-menu event + (or (and (symbolp ,symbol) + (funcall + (or (plist-get (get ,symbol 'menu-prop) + :filter) + 'identity) + (symbol-function ,symbol))) + ,symbol))))) (mapcar (lambda (map) (define-key map (vector 'menu-bar (easy-menu-intern (car menu))) (cons 'menu-item diff --git a/lisp/files.el b/lisp/files.el index c8f30138ab..6de413c8ed 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -286,7 +286,7 @@ from `mode-require-final-newline'." :type '(choice (const :tag "When visiting" visit) (const :tag "When saving" t) (const :tag "When visiting or saving" visit-save) - (const :tag "Never" nil) + (const :tag "Don't add newlines" nil) (other :tag "Ask" ask)) :group 'editing-basics) @@ -300,16 +300,16 @@ A value of t means do this only when the file is about to be saved. A value of `visit' means do this right after the file is visited. A value of `visit-save' means do it at both of those times. Any other non-nil value means ask user whether to add a newline, when saving. -nil means don't add newlines. -You will have to be careful if you set this to nil: you will have -to remember to manually add a final newline whenever you finish a -file that really needs one." +nil means do not add newlines. That is a risky choice in this variable +since this value is used for modes for files that ought to have final newlines. +So if you set this to nil, you must explicitly check and add +a final newline, whenever you save a file that really needs one." :type '(choice (const :tag "When visiting" visit) (const :tag "When saving" t) (const :tag "When visiting or saving" visit-save) - (const :tag "Never" nil) - (other :tag "Ask" ask)) + (const :tag "Don't add newlines" nil) + (other :tag "Ask each time" ask)) :group 'editing-basics :version "22.1") @@ -529,8 +529,8 @@ See Info node `(elisp)Standard File Names' for more details." Value is not expanded---you must call `expand-file-name' yourself. Default name to DEFAULT-DIRNAME if user exits with the same non-empty string that was inserted by this function. - (If DEFAULT-DIRNAME is omitted, the current buffer's directory is used, - except that if INITIAL is specified, that combined with DIR is used.) + (If DEFAULT-DIRNAME is omitted, DIR combined with INITIAL is used, + or just DIR if INITIAL is nil.) If the user exits with an empty minibuffer, this function returns an empty string. (This can only happen if the user erased the pre-inserted contents or if `insert-default-directory' is nil.) @@ -544,7 +544,10 @@ the value of `default-directory'." (unless default-dirname (setq default-dirname (if initial (concat dir initial) default-directory))) - (read-file-name prompt dir default-dirname mustmatch initial + (read-file-name prompt dir (or default-dirname + (if initial (expand-file-name initial dir) + dir)) + mustmatch initial 'file-directory-p)) @@ -940,12 +943,13 @@ BODY should use the minibuffer at most once. Recursive uses of the minibuffer will not be affected." (declare (indent 1) (debug t)) (let ((hook (make-symbol "setup-hook"))) - `(let ((,hook - (lambda () - ;; Clear out this hook so it does not interfere - ;; with any recursive minibuffer usage. - (remove-hook 'minibuffer-setup-hook ,hook) - (,fun)))) + `(let (,hook) + (setq ,hook + (lambda () + ;; Clear out this hook so it does not interfere + ;; with any recursive minibuffer usage. + (remove-hook 'minibuffer-setup-hook ,hook) + (,fun))) (unwind-protect (progn (add-hook 'minibuffer-setup-hook ,hook) @@ -1973,8 +1977,13 @@ with that interpreter in `interpreter-mode-alist'.") ("%![^V]" . ps-mode) ("# xmcd " . conf-unix-mode)) "Alist of buffer beginnings vs. corresponding major mode functions. -Each element looks like (REGEXP . FUNCTION). FUNCTION will be -called, unless it is nil (to allow `auto-mode-alist' to override).") +Each element looks like (REGEXP . FUNCTION). After visiting a file, +if REGEXP matches the text at the beginning of the buffer, +`normal-mode' will call FUNCTION rather than allowing `auto-mode-alist' +to decide the buffer's major mode. + +If FUNCTION is nil, then it is not called. (That is a way of saying +\"allow `auto-mode-alist' to decide for these files.") (defun set-auto-mode (&optional keep-mode-if-same) "Select major mode appropriate for current buffer. @@ -2740,15 +2749,28 @@ BACKUPNAME is the backup file name, which is the old file renamed." (file-error nil)))))) (defun backup-buffer-copy (from-name to-name modes) - (condition-case () - (copy-file from-name to-name t t) - (file-error - ;; If copying fails because file TO-NAME - ;; is not writable, delete that file and try again. - (if (and (file-exists-p to-name) - (not (file-writable-p to-name))) - (delete-file to-name)) - (copy-file from-name to-name t t))) + (let ((umask (default-file-modes))) + (unwind-protect + (progn + ;; Create temp files with strict access rights. It's easy to + ;; loosen them later, whereas it's impossible to close the + ;; time-window of loose permissions otherwise. + (set-default-file-modes ?\700) + (while (condition-case () + (progn + (condition-case nil + (delete-file to-name) + (file-error nil)) + (write-region "" nil to-name nil 'silent nil 'excl) + nil) + (file-already-exists t)) + ;; the file was somehow created by someone else between + ;; `make-temp-name' and `write-region', let's try again. + nil) +; (copy-file from-name to-name t t 'excl)) + (copy-file from-name to-name t t)) + ;; Reset the umask. + (set-default-file-modes umask))) (and modes (set-file-modes to-name (logand modes #o1777)))) @@ -3331,39 +3353,41 @@ Before and after saving the buffer, this function runs ;; This requires write access to the containing dir, ;; which is why we don't try it if we don't have that access. (let ((realname buffer-file-name) - tempname nogood i succeed + tempname succeed + (umask (default-file-modes)) (old-modtime (visited-file-modtime))) - (setq i 0) - (setq nogood t) - ;; Find the temporary name to write under. - (while nogood - (setq tempname (format - (if (and (eq system-type 'ms-dos) - (not (msdos-long-file-names))) - "%s#%d.tm#" ; MSDOS limits files to 8+3 - (if (memq system-type '(vax-vms axp-vms)) - "%s$tmp$%d" - "%s#tmp#%d")) - dir i)) - (setq nogood (file-exists-p tempname)) - (setq i (1+ i))) + ;; Create temp files with strict access rights. It's easy to + ;; loosen them later, whereas it's impossible to close the + ;; time-window of loose permissions otherwise. (unwind-protect - (progn (clear-visited-file-modtime) - (write-region (point-min) (point-max) - tempname nil realname - buffer-file-truename) - (setq succeed t)) - ;; If writing the temp file fails, - ;; delete the temp file. - (or succeed - (progn - (condition-case nil - (delete-file tempname) - (file-error nil)) - (set-visited-file-modtime old-modtime)))) - ;; Since we have created an entirely new file - ;; and renamed it, make sure it gets the - ;; right permission bits set. + (progn + (clear-visited-file-modtime) + (set-default-file-modes ?\700) + ;; Try various temporary names. + ;; This code follows the example of make-temp-file, + ;; but it calls write-region in the appropriate way + ;; for saving the buffer. + (while (condition-case () + (progn + (setq tempname + (make-temp-name + (expand-file-name "tmp" dir))) + (write-region (point-min) (point-max) + tempname nil realname + buffer-file-truename 'excl) + nil) + (file-already-exists t)) + ;; The file was somehow created by someone else between + ;; `make-temp-name' and `write-region', let's try again. + nil) + (setq succeed t)) + ;; Reset the umask. + (set-default-file-modes umask) + ;; If we failed, restore the buffer's modtime. + (unless succeed + (set-visited-file-modtime old-modtime))) + ;; Since we have created an entirely new file, + ;; make sure it gets the right permission bits set. (setq setmodes (or setmodes (cons (file-modes buffer-file-name) buffer-file-name))) ;; We succeeded in writing the temp file, @@ -3649,7 +3673,7 @@ The function you specify is responsible for updating (or preserving) point.") (defvar buffer-stale-function nil "Function to check whether a non-file buffer needs reverting. This should be a function with one optional argument NOCONFIRM. -Auto Revert Mode sets NOCONFIRM to t. The function should return +Auto Revert Mode passes t for NOCONFIRM. The function should return non-nil if the buffer should be reverted. A return value of `fast' means that the need for reverting was not checked, but that reverting the buffer is fast. The buffer is current when @@ -3718,91 +3742,93 @@ non-nil, it is called instead of rereading visited file contents." (interactive (list (not current-prefix-arg))) (if revert-buffer-function (funcall revert-buffer-function ignore-auto noconfirm) - (let* ((auto-save-p (and (not ignore-auto) - (recent-auto-save-p) - buffer-auto-save-file-name - (file-readable-p buffer-auto-save-file-name) - (y-or-n-p - "Buffer has been auto-saved recently. Revert from auto-save file? "))) - (file-name (if auto-save-p - buffer-auto-save-file-name - buffer-file-name))) - (cond ((null file-name) - (error "Buffer does not seem to be associated with any file")) - ((or noconfirm - (and (not (buffer-modified-p)) - (let ((tail revert-without-query) - (found nil)) - (while tail - (if (string-match (car tail) file-name) - (setq found t)) - (setq tail (cdr tail))) - found)) - (yes-or-no-p (format "Revert buffer from file %s? " - file-name))) - (run-hooks 'before-revert-hook) - ;; If file was backed up but has changed since, - ;; we shd make another backup. - (and (not auto-save-p) - (not (verify-visited-file-modtime (current-buffer))) - (setq buffer-backed-up nil)) - ;; Get rid of all undo records for this buffer. - (or (eq buffer-undo-list t) - (setq buffer-undo-list nil)) - ;; Effectively copy the after-revert-hook status, - ;; since after-find-file will clobber it. - (let ((global-hook (default-value 'after-revert-hook)) - (local-hook-p (local-variable-p 'after-revert-hook)) - (local-hook (and (local-variable-p 'after-revert-hook) - after-revert-hook))) - (let (buffer-read-only - ;; Don't make undo records for the reversion. - (buffer-undo-list t)) - (if revert-buffer-insert-file-contents-function - (funcall revert-buffer-insert-file-contents-function - file-name auto-save-p) - (if (not (file-exists-p file-name)) - (error (if buffer-file-number - "File %s no longer exists!" - "Cannot revert nonexistent file %s") - file-name)) - ;; Bind buffer-file-name to nil - ;; so that we don't try to lock the file. - (let ((buffer-file-name nil)) - (or auto-save-p - (unlock-buffer))) - (widen) - (let ((coding-system-for-read - ;; Auto-saved file shoule be read by Emacs' - ;; internal coding. - (if auto-save-p 'auto-save-coding - (or coding-system-for-read - buffer-file-coding-system-explicit)))) - ;; This force after-insert-file-set-coding - ;; (called from insert-file-contents) to set - ;; buffer-file-coding-system to a proper value. - (kill-local-variable 'buffer-file-coding-system) - - ;; Note that this preserves point in an intelligent way. - (if preserve-modes - (let ((buffer-file-format buffer-file-format)) - (insert-file-contents file-name (not auto-save-p) - nil nil t)) - (insert-file-contents file-name (not auto-save-p) - nil nil t))))) - ;; Recompute the truename in case changes in symlinks - ;; have changed the truename. - (setq buffer-file-truename - (abbreviate-file-name (file-truename buffer-file-name))) - (after-find-file nil nil t t preserve-modes) - ;; Run after-revert-hook as it was before we reverted. - (setq-default revert-buffer-internal-hook global-hook) - (if local-hook-p - (set (make-local-variable 'revert-buffer-internal-hook) - local-hook) - (kill-local-variable 'revert-buffer-internal-hook)) - (run-hooks 'revert-buffer-internal-hook)) - t))))) + (with-current-buffer (or (buffer-base-buffer (current-buffer)) + (current-buffer)) + (let* ((auto-save-p (and (not ignore-auto) + (recent-auto-save-p) + buffer-auto-save-file-name + (file-readable-p buffer-auto-save-file-name) + (y-or-n-p + "Buffer has been auto-saved recently. Revert from auto-save file? "))) + (file-name (if auto-save-p + buffer-auto-save-file-name + buffer-file-name))) + (cond ((null file-name) + (error "Buffer does not seem to be associated with any file")) + ((or noconfirm + (and (not (buffer-modified-p)) + (let ((tail revert-without-query) + (found nil)) + (while tail + (if (string-match (car tail) file-name) + (setq found t)) + (setq tail (cdr tail))) + found)) + (yes-or-no-p (format "Revert buffer from file %s? " + file-name))) + (run-hooks 'before-revert-hook) + ;; If file was backed up but has changed since, + ;; we shd make another backup. + (and (not auto-save-p) + (not (verify-visited-file-modtime (current-buffer))) + (setq buffer-backed-up nil)) + ;; Get rid of all undo records for this buffer. + (or (eq buffer-undo-list t) + (setq buffer-undo-list nil)) + ;; Effectively copy the after-revert-hook status, + ;; since after-find-file will clobber it. + (let ((global-hook (default-value 'after-revert-hook)) + (local-hook-p (local-variable-p 'after-revert-hook)) + (local-hook (and (local-variable-p 'after-revert-hook) + after-revert-hook))) + (let (buffer-read-only + ;; Don't make undo records for the reversion. + (buffer-undo-list t)) + (if revert-buffer-insert-file-contents-function + (funcall revert-buffer-insert-file-contents-function + file-name auto-save-p) + (if (not (file-exists-p file-name)) + (error (if buffer-file-number + "File %s no longer exists!" + "Cannot revert nonexistent file %s") + file-name)) + ;; Bind buffer-file-name to nil + ;; so that we don't try to lock the file. + (let ((buffer-file-name nil)) + (or auto-save-p + (unlock-buffer))) + (widen) + (let ((coding-system-for-read + ;; Auto-saved file shoule be read by Emacs' + ;; internal coding. + (if auto-save-p 'auto-save-coding + (or coding-system-for-read + buffer-file-coding-system-explicit)))) + ;; This force after-insert-file-set-coding + ;; (called from insert-file-contents) to set + ;; buffer-file-coding-system to a proper value. + (kill-local-variable 'buffer-file-coding-system) + + ;; Note that this preserves point in an intelligent way. + (if preserve-modes + (let ((buffer-file-format buffer-file-format)) + (insert-file-contents file-name (not auto-save-p) + nil nil t)) + (insert-file-contents file-name (not auto-save-p) + nil nil t))))) + ;; Recompute the truename in case changes in symlinks + ;; have changed the truename. + (setq buffer-file-truename + (abbreviate-file-name (file-truename buffer-file-name))) + (after-find-file nil nil t t preserve-modes) + ;; Run after-revert-hook as it was before we reverted. + (setq-default revert-buffer-internal-hook global-hook) + (if local-hook-p + (set (make-local-variable 'revert-buffer-internal-hook) + local-hook) + (kill-local-variable 'revert-buffer-internal-hook)) + (run-hooks 'revert-buffer-internal-hook)) + t)))))) (defun recover-this-file () "Recover the visited file--get contents from its last auto-save file." diff --git a/lisp/follow.el b/lisp/follow.el index a01b0e77eb..61517a68ff 100644 --- a/lisp/follow.el +++ b/lisp/follow.el @@ -980,7 +980,8 @@ of the way from the true end." (t (select-window (car (reverse followers))))) (goto-char pos) - (end-of-buffer arg))) + (with-no-warnings + (end-of-buffer arg)))) ;;}}} diff --git a/lisp/font-lock.el b/lisp/font-lock.el index 49e29c4896..5bac7c56b2 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -309,6 +309,9 @@ If a number, only buffers greater than this size have fontification messages." (defvar font-lock-comment-face 'font-lock-comment-face "Face name to use for comments.") +(defvar font-lock-comment-delimiter-face 'font-lock-comment-delimiter-face + "Face name to use for comment delimiters.") + (defvar font-lock-string-face 'font-lock-string-face "Face name to use for strings.") @@ -1615,7 +1618,7 @@ Sets various variables using `font-lock-defaults' (or, if nil, using ;; But now we do it the custom way. Note that `defface' will not overwrite any ;; faces declared above via `custom-declare-face'. -(defface font-lock-comment-face +(defface font-lock-comment-delimiter-face '((((class grayscale) (background light)) (:foreground "DimGray" :weight bold :slant italic)) (((class grayscale) (background dark)) @@ -1636,6 +1639,27 @@ Sets various variables using `font-lock-defaults' (or, if nil, using "Font Lock mode face used to highlight comments." :group 'font-lock-highlighting-faces) +(defface font-lock-comment-face + '((((class grayscale) (background light)) + (:foreground "DimGray" :weight bold :slant italic)) + (((class grayscale) (background dark)) + (:foreground "LightGray" :weight bold :slant italic)) + (((class color) (min-colors 88) (background light)) + (:foreground "Firebrick")) + (((class color) (min-colors 88) (background dark)) + (:foreground "chocolate1")) + (((class color) (min-colors 16) (background light)) + (:foreground "red")) + (((class color) (min-colors 16) (background dark)) + (:foreground "red1")) + (((class color) (min-colors 8) (background light)) + ) + (((class color) (min-colors 8) (background dark)) + ) + (t (:weight bold :slant italic))) + "Font Lock mode face used to highlight comments." + :group 'font-lock-highlighting-faces) + (defface font-lock-string-face '((((class grayscale) (background light)) (:foreground "DimGray" :slant italic)) (((class grayscale) (background dark)) (:foreground "LightGray" :slant italic)) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index f08f21fadb..a5c403f0d7 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,24 @@ +2005-04-24 Teodor Zlatanov <[email protected]> + + * spam-report.el (spam-report-unplug-agent) + (spam-report-plug-agent, spam-report-deagentize) + (spam-report-agentize, spam-report-url-ping-temp-agent-function): + support for the Agent in spam-report: when unplugged, report to a + file; when plugged, submit all the requests. + [Added missing offline functionality from trunk.] + +2005-04-24 Reiner Steib <[email protected]> + + * spam-report.el (spam-report-url-to-file) + (spam-report-requests-file): New function and variable for offline + reporting. + (spam-report-url-ping-function): Add `spam-report-url-to-file' + and user defined function. + (spam-report-process-queue): New function. + Process requests from `spam-report-requests-file'. + (spam-report-url-ping-mm-url): Autoload. + [Added missing offline functionality from trunk.] + 2005-04-18 Katsumi Yamaoka <[email protected]> * qp.el (quoted-printable-encode-region): Save excursion. diff --git a/lisp/gnus/spam-report.el b/lisp/gnus/spam-report.el index 80d422b06a..b8283ffaaa 100644 --- a/lisp/gnus/spam-report.el +++ b/lisp/gnus/spam-report.el @@ -59,14 +59,32 @@ instead." (defcustom spam-report-url-ping-function 'spam-report-url-ping-plain - "Function to use for url ping spam reporting." + "Function to use for url ping spam reporting. +The function must accept the arguments `host' and `report'." :type '(choice (const :tag "Connect directly" spam-report-url-ping-plain) (const :tag "Use the external program specified in `mm-url-program'" - spam-report-url-ping-mm-url)) + spam-report-url-ping-mm-url) + (const :tag "Store request URLs in `spam-report-requests-file'" + spam-report-url-to-file) + (function :tag "User defined function" nil)) :group 'spam-report) +(defcustom spam-report-requests-file + (nnheader-concat gnus-directory "spam/" "spam-report-requests.url") + ;; Is there a convention for the extension of such a file? + ;; Should we use `spam-directory'? + "File where spam report request are stored." + :type 'file + :group 'spam-report) + +(defvar spam-report-url-ping-temp-agent-function nil + "Internal variable for `spam-report-agentize' and `spam-report-deagentize'. +This variable will store the value of `spam-report-url-ping-function' from +before `spam-report-agentize' was run, so that `spam-report-deagentize' can +undo that change.") + (defun spam-report-gmane (&rest articles) "Report an article as spam through Gmane" (dolist (article articles) @@ -75,10 +93,11 @@ instead." (string-match spam-report-gmane-regex gnus-newsgroup-name))) (gnus-message 6 "Reporting spam article %d to spam.gmane.org..." article) (if spam-report-gmane-use-article-number - (spam-report-url-ping "spam.gmane.org" - (format "/%s:%d" - (gnus-group-real-name gnus-newsgroup-name) - article)) + (spam-report-url-ping + "spam.gmane.org" + (format "/%s:%d" + (gnus-group-real-name gnus-newsgroup-name) + article)) (with-current-buffer nntp-server-buffer (gnus-request-head article gnus-newsgroup-name) (goto-char (point-min)) @@ -113,14 +132,113 @@ the function specified by `spam-report-url-ping-function'." (format "GET %s HTTP/1.1\nUser-Agent: %s (spam-report.el)\nHost: %s\n\n" report (gnus-emacs-version) host))))) +;;;###autoload +(defun spam-report-process-queue (&optional file keep) + "Report all queued requests from `spam-report-requests-file'. + +If FILE is given, use it instead of `spam-report-requests-file'. +If KEEP is t, leave old requests in the file. If KEEP is the +symbol `ask', query before flushing the queue file." + (interactive + (list (read-file-name + "File: " + (file-name-directory spam-report-requests-file) + spam-report-requests-file + nil + (file-name-nondirectory spam-report-requests-file)) + current-prefix-arg)) + (if (eq spam-report-url-ping-function 'spam-report-url-to-file) + (error (concat "Cannot process requests when " + "`spam-report-url-ping-function' is " + "`spam-report-url-to-file'.")) + (gnus-message 7 "Processing requests using `%s'." + spam-report-url-ping-function)) + (or file (setq file spam-report-requests-file)) + (save-excursion + (set-buffer (find-file-noselect file)) + (goto-char (point-min)) + (while (and (not (eobp)) + (re-search-forward + "http://\\([^/]+\\)\\(/.*\\) *$" (point-at-eol) t)) + (funcall spam-report-url-ping-function (match-string 1) (match-string 2)) + (forward-line 1)) + (if (or (eq keep nil) + (and (eq keep 'ask) + (y-or-n-p + (format + "Flush requests from `%s'? " (current-buffer))))) + (progn + (gnus-message 7 "Flushing request file `%s'" + spam-report-requests-file) + (erase-buffer) + (save-buffer) + (kill-buffer (current-buffer))) + (gnus-message 7 "Keeping requests in `%s'" spam-report-requests-file)))) + +;;;###autoload (defun spam-report-url-ping-mm-url (host report) "Ping a host through HTTP, addressing a specific GET resource. Use the external program specified in `mm-url-program' to connect to server." (with-temp-buffer - (let ((url (concat "http://" host "/" report))) + (let ((url (concat "http://" host report))) (mm-url-insert url t)))) +;;;###autoload +(defun spam-report-url-to-file (host report) + "Collect spam report requests in `spam-report-requests-file'. +Customize `spam-report-url-ping-function' to use this function." + (let ((url (concat "http://" host report)) + (file spam-report-requests-file)) + (gnus-make-directory (file-name-directory file)) + (gnus-message 9 "Writing URL `%s' to file `%s'" url file) + (with-temp-buffer + (insert url) + (newline) + (append-to-file (point-min) (point-max) file)))) + +;;;###autoload +(defun spam-report-agentize () + "Add spam-report support to the Agent. +Spam reports will be queued with \\[spam-report-url-to-file] when +the Agent is unplugged, and will be submitted in a batch when the +Agent is plugged." + (interactive) + (add-hook 'gnus-agent-plugged-hook 'spam-report-plug-agent) + (add-hook 'gnus-agent-unplugged-hook 'spam-report-unplug-agent)) + +;;;###autoload +(defun spam-report-deagentize () + "Remove spam-report support from the Agent. +Spam reports will be queued with the method used when +\\[spam-report-agentize] was run." + (interactive) + (remove-hook 'gnus-agent-plugged-hook 'spam-report-plug-agent) + (remove-hook 'gnus-agent-unplugged-hook 'spam-report-unplug-agent)) + +(defun spam-report-plug-agent () + "Adjust spam report settings for plugged state. +Process queued spam reports." + ;; Process the queue, unless the user only wanted to report to a file + ;; anyway. + (unless (equal spam-report-url-ping-temp-agent-function + 'spam-report-url-to-file) + (spam-report-process-queue)) + ;; Set the reporting function, if we have memorized something otherwise, + ;; stick with plain URL reporting. + (setq spam-report-url-ping-function + (or spam-report-url-ping-temp-agent-function + 'spam-report-url-ping-plain))) + +(defun spam-report-unplug-agent () + "Restore spam report settings for unplugged state." + ;; save the old value + (setq spam-report-url-ping-temp-agent-function + spam-report-url-ping-function) + ;; store all reports to file + (setq spam-report-url-ping-function + 'spam-report-url-to-file)) + (provide 'spam-report) ;;; arch-tag: f6683295-ec89-4ab5-8803-8cc842293022 diff --git a/lisp/ido.el b/lisp/ido.el index 2e2aca3126..1c95676db0 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -1346,12 +1346,21 @@ This function also adds a hook to the minibuffer." (setq ido-everywhere (if arg (> (prefix-numeric-value arg) 0) (not ido-everywhere))) - (setq read-file-name-function - (and ido-everywhere (memq ido-mode '(both file)) - 'ido-read-file-name)) - (setq read-buffer-function - (and ido-everywhere (memq ido-mode '(both buffer)) - 'ido-read-buffer))) + (when (get 'ido-everywhere 'file) + (setq read-file-name-function (get 'ido-everywhere 'file)) + (put 'ido-everywhere 'file nil)) + (when (get 'ido-everywhere 'buffer) + (setq read-buffer-function (get 'ido-everywhere 'buffer)) + (put 'ido-everywhere 'buffer nil)) + (when ido-everywhere + (when (memq ido-mode '(both file)) + (unless (get 'ido-everywhere 'file) + (put 'ido-everywhere 'file read-file-name-function)) + (setq read-file-name-function 'ido-read-file-name)) + (when (memq ido-mode '(both buffer)) + (unless (get 'ido-everywhere 'buffer) + (put 'ido-everywhere 'buffer read-buffer-function)) + (setq read-buffer-function 'ido-read-buffer)))) ;;; IDO KEYMAP @@ -1793,7 +1802,7 @@ If INITIAL is non-nil, it specifies the initial input string." (ido-name (car ido-matches)))) (cond - ((eq item 'buffer) + ((memq item '(buffer list)) (setq done t)) ((string-equal "./" ido-selected) diff --git a/lisp/imenu.el b/lisp/imenu.el index 85430bbdbf..831550bd7a 100644 --- a/lisp/imenu.el +++ b/lisp/imenu.el @@ -777,7 +777,7 @@ They may also be nested index alists like: depending on PATTERNS." (let ((index-alist (list 'dummy)) - prev-pos beg + prev-pos (case-fold-search (if (or (local-variable-p 'imenu-case-fold-search) (not (local-variable-p 'font-lock-defaults))) imenu-case-fold-search @@ -807,7 +807,7 @@ depending on PATTERNS." (index (nth 2 pat)) (function (nth 3 pat)) (rest (nthcdr 4 pat)) - start) + start beg) ;; Go backwards for convenience of adding items in order. (goto-char (point-max)) (while (and (re-search-backward regexp nil t) @@ -815,32 +815,35 @@ depending on PATTERNS." ;; because it means a bad regexp was specified. (not (= (match-beginning 0) (match-end 0)))) (setq start (point)) - (goto-char (match-end index)) - (setq beg (match-beginning index)) - ;; Go to the start of the match. + ;; Record the start of the line in which the match starts. ;; That's the official position of this definition. - (goto-char start) + (goto-char (match-beginning index)) + (beginning-of-line) + (setq beg (point)) (imenu-progress-message prev-pos nil t) ;; Add this sort of submenu only when we've found an ;; item for it, avoiding empty, duff menus. (unless (assoc menu-title index-alist) (push (list menu-title) index-alist)) (if imenu-use-markers - (setq start (copy-marker start))) + (setq beg (copy-marker beg))) (let ((item (if function (nconc (list (match-string-no-properties index) - start function) + beg function) rest) (cons (match-string-no-properties index) - start))) + beg))) ;; This is the desired submenu, ;; starting with its title (or nil). (menu (assoc menu-title index-alist))) ;; Insert the item unless it is already present. (unless (member item (cdr menu)) (setcdr menu - (cons item (cdr menu)))))))) + (cons item (cdr menu))))) + ;; Go to the start of the match, to make sure we + ;; keep making progress backwards. + (goto-char start)))) (set-syntax-table old-table))) (imenu-progress-message prev-pos 100 t) ;; Sort each submenu by position. diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index cc39f39638..8d758abe53 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -27,7 +27,9 @@ ;;; Code: -(eval-when-compile (defvar dos-codepage)) +(eval-when-compile + (defvar dos-codepage) + (autoload 'widget-value "wid-edit")) ;;; MULE related key bindings and menus. @@ -925,7 +927,9 @@ and TO is ignored." ;; give when file is re-read. ;; But don't do this if we explicitly ignored the cookie ;; by using `find-file-literally'. - (unless (or (stringp from) find-file-literally) + (unless (or (stringp from) + find-file-literally + (memq (coding-system-type coding-system) '(0 5))) (let ((auto-cs (save-excursion (save-restriction (widen) diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el index d160e4107f..75f1b4803a 100644 --- a/lisp/international/mule-conf.el +++ b/lisp/international/mule-conf.el @@ -2,6 +2,7 @@ ;; Copyright (C) 1997 Electrotechnical Laboratory, JAPAN. ;; Licensed to the Free Software Foundation. +;; Copyright (C) 2005 Free Software Foundation, Inc. ;; Keywords: mule, multilingual, character set, coding system @@ -289,10 +290,6 @@ (get 'oldjis-newjis-jisroman-ascii 'translation-table)) (setq standard-translation-table-for-encode nil) - -(defvar translation-table-for-input nil - "If non-nil, a char table used to translate characters from input methods. -\(Currently only used by Quail.)") ;;; Make fundamental coding systems. @@ -559,5 +556,5 @@ for decoding and encoding files, process I/O, etc." (update-coding-systems-internal) -;;; arch-tag: 7d5fed55-b6df-42f6-8d3d-0011190551f5 +;; arch-tag: 7d5fed55-b6df-42f6-8d3d-0011190551f5 ;;; mule-conf.el ends here diff --git a/lisp/isearch.el b/lisp/isearch.el index e01f2c0c0e..a8718836c5 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -531,9 +531,9 @@ Type \\[isearch-quote-char] to quote control character to search for it. starting point. Type \\[isearch-query-replace] to start `query-replace' with string to\ -replace from last search string. + replace from last search string. Type \\[isearch-query-replace-regexp] to start `query-replace-regexp'\ -with string to replace from last search string.. + with string to replace from last search string.. Type \\[isearch-toggle-case-fold] to toggle search case-sensitivity. Type \\[isearch-toggle-regexp] to toggle regular-expression mode. diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el index fe64d871d9..100eb6076d 100644 --- a/lisp/jit-lock.el +++ b/lisp/jit-lock.el @@ -69,7 +69,7 @@ Preserves the `buffer-modified-p' state of the current buffer." :group 'jit-lock) -(defcustom jit-lock-stealth-time 3 +(defcustom jit-lock-stealth-time 16 "*Time in seconds to wait before beginning stealth fontification. Stealth fontification occurs if there is no input within this time. If nil, stealth fontification is never performed. @@ -80,7 +80,7 @@ The value of this variable is used when JIT Lock mode is turned on." :group 'jit-lock) -(defcustom jit-lock-stealth-nice 0.125 +(defcustom jit-lock-stealth-nice 0.5 "*Time in seconds to pause between chunks of stealth fontification. Each iteration of stealth fontification is separated by this amount of time, thus reducing the demand that stealth fontification makes on the system. diff --git a/lisp/loadhist.el b/lisp/loadhist.el index 1c71cc6cd0..da6fd695da 100644 --- a/lisp/loadhist.el +++ b/lisp/loadhist.el @@ -188,27 +188,34 @@ such as redefining an Emacs function." (string-match "-hooks?\\'" (symbol-name x))) (memq x unload-feature-special-hooks))) ; Known abnormal hooks etc. (dolist (y unload-hook-features-list) - (when (eq (car-safe y) 'defun) - (remove-hook x (cdr y)))))))) + (when (and (eq (car-safe y) 'defun) + (not (get (cdr y) 'autoload))) + (remove-hook x (cdr y))))))) + ;; Remove any feature-symbols from auto-mode-alist as well. + (dolist (y unload-hook-features-list) + (when (and (eq (car-safe y) 'defun) + (not (get (cdr y) 'autoload))) + (setq auto-mode-alist + (rassq-delete-all (cdr y) auto-mode-alist))))) (when (fboundp 'elp-restore-function) ; remove ELP stuff first (dolist (elt unload-hook-features-list) (when (symbolp elt) (elp-restore-function elt)))) (dolist (x unload-hook-features-list) (if (consp x) - (progn - ;; Remove any feature names that this file provided. - (when (eq (car x) 'provide) - (setq features (delq (cdr x) features))) - (when (eq (car x) 'defun) - (let ((fun (cdr x))) - (when (fboundp fun) - (when (fboundp 'ad-unadvise) - (ad-unadvise fun)) - (fmakunbound fun) - (let ((aload (get fun 'autoload))) - (when aload - (fset fun (cons 'autoload aload)))))))) + (cond + ;; Remove any feature names that this file provided. + ((eq (car x) 'provide) + (setq features (delq (cdr x) features))) + ((eq (car x) 'defun) + (let ((fun (cdr x))) + (when (fboundp fun) + (when (fboundp 'ad-unadvise) + (ad-unadvise fun)) + (fmakunbound fun) + (let ((aload (get fun 'autoload))) + (when aload + (fset fun (cons 'autoload aload)))))))) ;; Kill local values as much as possible. (dolist (buf (buffer-list)) (with-current-buffer buf @@ -217,8 +224,7 @@ such as redefining an Emacs function." (unless (local-variable-if-set-p x) (makunbound x)))) ;; Delete the load-history element for this file. - (let ((elt (assoc file load-history))) - (setq load-history (delq elt load-history))))) + (setq load-history (delq (assoc file load-history) load-history)))) (provide 'loadhist) diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index e7c634f420..8ba9408a76 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -662,11 +662,12 @@ The first parenthesized expression should match the MIME-charset name.") ;; Use MATCH-ANCHORED to effectively anchor the regexp left side. `(,cite-chars (,(concat "\\=[ \t]*" - "\\(\\([" cite-prefix "]+[" cite-suffix "]*\\)?" - "\\(" cite-chars "[ \t]*\\)\\)+" + "\\(\\(\\([" cite-prefix "]+[" cite-suffix "]*\\)?" + "\\(" cite-chars "[ \t]*\\)\\)+\\)" "\\(.*\\)") (beginning-of-line) (end-of-line) - (3 font-lock-comment-face nil t))) + (1 font-lock-comment-delimiter-face nil t) + (5 font-lock-comment-face nil t))) '("^\\(X-[a-z0-9-]+\\|In-reply-to\\|Date\\):.*\\(\n[ \t]+.*\\)*$" . font-lock-string-face)))) "Additional expressions to highlight in Rmail mode.") diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el index fb2760b3bd..d0b6d84741 100644 --- a/lisp/mail/sendmail.el +++ b/lisp/mail/sendmail.el @@ -378,11 +378,12 @@ actually occur.") ;; Use MATCH-ANCHORED to effectively anchor the regexp left side. `(,cite-chars (,(concat "\\=[ \t]*" - "\\(\\([" cite-prefix "]+[" cite-suffix "]*\\)?" - "\\(" cite-chars "[ \t]*\\)\\)+" + "\\(\\(\\([" cite-prefix "]+[" cite-suffix "]*\\)?" + "\\(" cite-chars "[ \t]*\\)\\)+\\)" "\\(.*\\)") (beginning-of-line) (end-of-line) - (3 font-lock-comment-face nil t))) + (1 font-lock-comment-delimiter-face nil t) + (5 font-lock-comment-face nil t))) '("^\\(X-[A-Za-z0-9-]+\\|In-reply-to\\):.*\\(\n[ \t]+.*\\)*$" . font-lock-string-face)))) "Additional expressions to highlight in Mail mode.") diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 273d4739b4..ee51e8c349 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -639,14 +639,15 @@ by \"Save Options\" in Custom buffers.") (let ((need-save nil)) ;; These are set with menu-bar-make-mm-toggle, which does not ;; put on a customized-value property. - (dolist (elt '(line-number-mode column-number-mode cua-mode show-paren-mode - transient-mark-mode global-font-lock-mode - blink-cursor-mode)) + (dolist (elt '(line-number-mode column-number-mode size-indication-mode + cua-mode show-paren-mode transient-mark-mode + global-font-lock-mode blink-cursor-mode)) (and (customize-mark-to-save elt) (setq need-save t))) ;; These are set with `customize-set-variable'. (dolist (elt '(scroll-bar-mode - debug-on-quit debug-on-error menu-bar-mode tool-bar-mode + debug-on-quit debug-on-error + tooltip-mode menu-bar-mode tool-bar-mode save-place uniquify-buffer-name-style fringe-mode fringe-indicators case-fold-search display-time-mode auto-compression-mode @@ -691,6 +692,11 @@ by \"Save Options\" in Custom buffers.") "Line Numbers" "Show the current line number in the mode line")) +(define-key menu-bar-showhide-menu [size-indication-mode] + (menu-bar-make-mm-toggle size-indication-mode + "Size Indication" + "Show the size of the buffer in the mode line")) + (define-key menu-bar-showhide-menu [linecolumn-separator] '("--")) @@ -910,6 +916,12 @@ by \"Save Options\" in Custom buffers.") :visible `(display-graphic-p) :help "Select scroll-bar mode")) +(define-key menu-bar-showhide-menu [showhide-tooltip-mode] + (list 'menu-item "Tooltips" 'tooltip-mode + :help "Toggle tooltips on/off" + :visible `(and (display-graphic-p) (fboundp 'x-show-tip)) + :button `(:toggle . tooltip-mode))) + (define-key menu-bar-showhide-menu [menu-bar-mode] '(menu-item "Menu-bar" menu-bar-mode :help "Toggle menu-bar on/off" diff --git a/lisp/midnight.el b/lisp/midnight.el index a81ce37856..83b21dda7e 100644 --- a/lisp/midnight.el +++ b/lisp/midnight.el @@ -48,6 +48,11 @@ :group 'calendar :version "20.3") +(defvar midnight-timer nil + "Timer running the `midnight-hook' `midnight-delay' seconds after midnight. +Use `cancel-timer' to stop it and `midnight-delay-set' to change +the time when it is run.") + (defcustom midnight-mode nil "*Non-nil means run `midnight-hook' at midnight. Setting this variable outside customize has no effect; @@ -204,11 +209,6 @@ The default value is `clean-buffer-list'." (multiple-value-bind (sec min hrs) (decode-time) (- (* 24 60 60) (* 60 60 hrs) (* 60 min) sec))) -(defvar midnight-timer nil - "Timer running the `midnight-hook' `midnight-delay' seconds after midnight. -Use `cancel-timer' to stop it and `midnight-delay-set' to change -the time when it is run.") - ;;;###autoload (defun midnight-delay-set (symb tm) "Modify `midnight-timer' according to `midnight-delay'. diff --git a/lisp/mouse.el b/lisp/mouse.el index a527b040d8..f4f531959b 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -908,7 +908,6 @@ at the same position." (track-mouse (while (progn (setq event (read-event)) - (setq mve (cons event (and (boundp 'mve) mve))) (or (mouse-movement-p event) (memq (car-safe event) '(switch-frame select-window)))) (if (memq (car-safe event) '(switch-frame select-window)) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 129a01f549..0cc70386be 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -710,7 +710,7 @@ FILE should be (ABSOLUTE-FILENAME) or (RELATIVE-FILENAME . DIRNAME) or nil." `(,(car elt) (compilation-directory-properties ,(car elt) ,(cdr elt)) - t)) + t t)) (cdr compilation-directory-matcher))))) ;; Compiler warning/error lines. @@ -733,11 +733,12 @@ FILE should be (ABSOLUTE-FILENAME) or (RELATIVE-FILENAME . DIRNAME) or nil." ;; allowed `line' to be a function that computed the actual ;; error location. Let's do our best. `(,(car item) - (0 (compilation-compat-error-properties - (funcall ',line (cons (match-string ,file) - (cons default-directory - ',(nthcdr 4 item))) - ,(if col `(match-string ,col))))) + (0 (save-match-data + (compilation-compat-error-properties + (funcall ',line (cons (match-string ,file) + (cons default-directory + ',(nthcdr 4 item))) + ,(if col `(match-string ,col)))))) (,file compilation-error-face t)) (unless (or (null (nth 5 item)) (integerp (nth 5 item))) @@ -1589,6 +1590,8 @@ If nil, don't scroll the compilation output window." (point)))) (set-window-point w mk)) +(defvar next-error-highlight-timer) + (defun compilation-goto-locus (msg mk end-mk) "Jump to an error corresponding to MSG at MK. All arguments are markers. If END-MK is non-nil, mark is set there diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el index 14363e4dcc..eb6db05c15 100644 --- a/lisp/progmodes/f90.el +++ b/lisp/progmodes/f90.el @@ -1109,9 +1109,15 @@ Does not check type and subprogram indentation." (let (icol cont (case-fold-search t) (pnt (point))) (save-excursion (if (not (f90-previous-statement)) - ;; First statement in buffer. + ;; If f90-previous-statement returns nil, we must have been + ;; called from on or before the first line of the first statement. (setq icol (if (save-excursion - (f90-next-statement) + ;; f90-previous-statement has moved us over + ;; comment/blank lines, so we need to get + ;; back to the first code statement. + (when (looking-at "[ \t]*\\([!#]\\|$\\)") + (f90-next-statement)) + (skip-chars-forward " \t0-9") (f90-looking-at-program-block-start)) 0 ;; No explicit PROGRAM start statement. diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index ebb7ee6976..9a5d609c52 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -113,6 +113,11 @@ Used to grey out relevant togolbar icons.") (easy-mmode-defmap gud-menu-map '(([help] "Info" . gud-goto-info) + ([tooltips] menu-item "Toggle GUD tooltips" tooltip-toggle-gud-tips + :enable (and (not emacs-basic-display) + (display-graphic-p) + (fboundp 'x-show-tip)) + :button (:toggle . tooltip-gud-tips-p)) ([refresh] "Refresh" . gud-refresh) ([run] menu-item "Run" gud-run :enable (and (not gud-running) diff --git a/lisp/progmodes/inf-lisp.el b/lisp/progmodes/inf-lisp.el index 83a0c9d3e2..06ad2d591a 100644 --- a/lisp/progmodes/inf-lisp.el +++ b/lisp/progmodes/inf-lisp.el @@ -66,12 +66,20 @@ (require 'lisp-mode) +(defgroup inferior-lisp nil + "Run an outside Lisp in an Emacs buffer." + :group 'lisp + :version "22.1") + ;;;###autoload -(defvar inferior-lisp-filter-regexp "\\`\\s *\\(:\\(\\w\\|\\s_\\)\\)?\\s *\\'" +(defcustom inferior-lisp-filter-regexp + "\\`\\s *\\(:\\(\\w\\|\\s_\\)\\)?\\s *\\'" "*What not to save on inferior Lisp's input history. Input matching this regexp is not saved on the input history in Inferior Lisp mode. Default is whitespace followed by 0 or 1 single-letter colon-keyword -\(as in :a, :c, etc.)") +\(as in :a, :c, etc.)" + :type 'regexp + :group 'inferior-lisp) (defvar inferior-lisp-mode-map nil) (unless inferior-lisp-mode-map @@ -111,7 +119,7 @@ mode. Default is whitespace followed by 0 or 1 single-letter colon-keyword ;;;where they are more accessible. C-c <letter> bindings are reserved for the ;;;user, so these bindings are non-standard. If you want them, you should ;;;have this function called by the inferior-lisp-load-hook: -;;; (setq inferior-lisp-load-hook '(inferior-lisp-install-letter-bindings)) +;;; (add-hook 'inferior-lisp-load-hook 'inferior-lisp-install-letter-bindings) ;;;You can modify this function to install just the bindings you want." (defun inferior-lisp-install-letter-bindings () (define-key lisp-mode-map "\C-ce" 'lisp-eval-defun-and-go) @@ -133,23 +141,26 @@ mode. Default is whitespace followed by 0 or 1 single-letter colon-keyword (define-key inferior-lisp-mode-map "\C-cv" 'lisp-show-variable-documentation)) - ;;;###autoload -(defvar inferior-lisp-program "lisp" - "*Program name for invoking an inferior Lisp with for Inferior Lisp mode.") +(defcustom inferior-lisp-program "lisp" + "*Program name for invoking an inferior Lisp in Inferior Lisp mode." + :type 'string + :group 'inferior-lisp) ;;;###autoload -(defvar inferior-lisp-load-command "(load \"%s\")\n" +(defcustom inferior-lisp-load-command "(load \"%s\")\n" "*Format-string for building a Lisp expression to load a file. This format string should use `%s' to substitute a file name and should result in a Lisp expression that will command the inferior Lisp to load that file. The default works acceptably on most Lisps. The string \"(progn (load \\\"%s\\\" :verbose nil :print t) (values))\\n\" produces cosmetically superior output for this application, -but it works only in Common Lisp.") +but it works only in Common Lisp." + :type 'string + :group 'inferior-lisp) ;;;###autoload -(defvar inferior-lisp-prompt "^[^> \n]*>+:? *" +(defcustom inferior-lisp-prompt "^[^> \n]*>+:? *" "Regexp to recognise prompts in the Inferior Lisp mode. Defaults to \"^[^> \\n]*>+:? *\", which works pretty good for Lucid, kcl, and franz. This variable is used to initialize `comint-prompt-regexp' in the @@ -163,7 +174,9 @@ Lucid Common Lisp: \"^\\\\(>\\\\|\\\\(->\\\\)+\\\\) *\" franz: \"^\\\\(->\\\\|<[0-9]*>:\\\\) *\" kcl: \"^>+ *\" -This is a fine thing to set in your .emacs file.") +This is a fine thing to set in your .emacs file or through Custom." + :type 'regexp + :group 'inferior-lisp) (defvar inferior-lisp-buffer nil "*The current inferior-lisp process buffer. @@ -201,8 +214,10 @@ processes, you can change `inferior-lisp-buffer' to another process buffer with \\[set-variable].") ;;;###autoload -(defvar inferior-lisp-mode-hook '() - "*Hook for customising Inferior Lisp mode.") +(defcustom inferior-lisp-mode-hook '() + "*Hook for customising Inferior Lisp mode." + :type 'hook + :group 'inferior-lisp) (put 'inferior-lisp-mode 'mode-class 'special) @@ -427,11 +442,13 @@ With argument, positions cursor at end of buffer." This holds a cons cell of the form `(DIRECTORY . FILE)' describing the last `lisp-load-file' or `lisp-compile-file' command.") -(defvar lisp-source-modes '(lisp-mode) +(defcustom lisp-source-modes '(lisp-mode) "*Used to determine if a buffer contains Lisp source code. If it's loaded into a buffer that is in one of these major modes, it's considered a Lisp source file by `lisp-load-file' and `lisp-compile-file'. -Used by these commands to determine defaults.") +Used by these commands to determine defaults." + :type '(repeat symbol) + :group 'inferior-lisp) (defun lisp-load-file (file-name) "Load a Lisp file into the inferior Lisp process." @@ -573,9 +590,10 @@ See variable `lisp-describe-sym-command'." ;;; Do the user's customisation... ;;;=============================== -(defvar inferior-lisp-load-hook nil - "This hook is run when the library `inf-lisp' is loaded. -This is a good place to put keybindings.") +(defcustom inferior-lisp-load-hook nil + "This hook is run when the library `inf-lisp' is loaded." + :type 'hook + :group 'inferior-lisp) (run-hooks 'inferior-lisp-load-hook) diff --git a/lisp/recentf.el b/lisp/recentf.el index 40a9204267..cf61b688eb 100644 --- a/lisp/recentf.el +++ b/lisp/recentf.el @@ -1137,6 +1137,12 @@ default." ";;; Automatically generated by `recentf' on %s.\n" "Header to be written into the `recentf-save-file'.") +(defconst recentf-save-file-coding-system + (if (coding-system-p 'utf-8-emacs) + 'utf-8-emacs + 'emacs-mule) + "Coding system of the file `recentf-save-file'.") + (defun recentf-save-list () "Save the recent list. Write data into the file specified by `recentf-save-file'." @@ -1144,9 +1150,13 @@ Write data into the file specified by `recentf-save-file'." (condition-case error (with-temp-buffer (erase-buffer) + (set-buffer-file-coding-system recentf-save-file-coding-system) (insert (format recentf-save-file-header (current-time-string))) (recentf-dump-variable 'recentf-list recentf-max-saved-items) (recentf-dump-variable 'recentf-filter-changer-state) + (insert "\n \n;;; Local Variables:\n" + (format ";;; coding: %s\n" recentf-save-file-coding-system) + ";;; End:\n") (write-file (expand-file-name recentf-save-file)) nil) (error @@ -1207,6 +1217,6 @@ that were operated on recently." (provide 'recentf) (run-hooks 'recentf-load-hook) - + ;;; arch-tag: 78f1eec9-0d16-4d19-a4eb-2e4529edb62a ;;; recentf.el ends here diff --git a/lisp/saveplace.el b/lisp/saveplace.el index cb61c8383b..9dc7b858e3 100644 --- a/lisp/saveplace.el +++ b/lisp/saveplace.el @@ -166,7 +166,8 @@ To save places automatically in all files, put this in your `.emacs' file: (let ((cell (assoc buffer-file-name save-place-alist)) (position (if (not (eq major-mode 'hexl-mode)) (point) - (1+ (hexl-current-address))))) + (with-no-warnings + (1+ (hexl-current-address)))))) (if cell (setq save-place-alist (delq cell save-place-alist))) (if (and save-place diff --git a/lisp/startup.el b/lisp/startup.el index 4bd0db5ab4..fbfcdef307 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -999,7 +999,8 @@ opening the first frame (e.g. open a connection to the server).") ;; the session manager and we have a session manager connection. (if (and (boundp 'x-session-previous-id) (stringp x-session-previous-id)) - (emacs-session-restore x-session-previous-id))) + (with-no-warnings + (emacs-session-restore x-session-previous-id)))) (defcustom initial-scratch-message (purecopy "\ ;; This buffer is for notes you don't want to save, and for Lisp evaluation. diff --git a/lisp/subr.el b/lisp/subr.el index a1384ab685..d707fc688a 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2291,7 +2291,8 @@ from `standard-syntax-table' otherwise." table)) (defun syntax-after (pos) - "Return the raw syntax of the char after POS." + "Return the raw syntax of the char after POS. +If POS is outside the buffer's accessible portion, return nil." (unless (or (< pos (point-min)) (>= pos (point-max))) (let ((st (if parse-sexp-lookup-properties (get-char-property pos 'syntax-table)))) @@ -2299,8 +2300,9 @@ from `standard-syntax-table' otherwise." (aref (or st (syntax-table)) (char-after pos)))))) (defun syntax-class (syntax) - "Return the syntax class part of the syntax descriptor SYNTAX." - (logand (car syntax) 255)) + "Return the syntax class part of the syntax descriptor SYNTAX. +If SYNTAX is nil, return nil." + (and syntax (logand (car syntax) 65535))) (defun add-to-invisibility-spec (arg) "Add elements to `buffer-invisibility-spec'. @@ -2388,15 +2390,34 @@ macros." (eq (car-safe object) 'lambda))) (defun assq-delete-all (key alist) - "Delete from ALIST all elements whose car is KEY. + "Delete from ALIST all elements whose car is `eq' to KEY. Return the modified alist. Elements of ALIST that are not conses are ignored." - (let ((tail alist)) - (while tail - (if (and (consp (car tail)) (eq (car (car tail)) key)) - (setq alist (delq (car tail) alist))) - (setq tail (cdr tail))) - alist)) + (while (and (consp (car alist)) + (eq (car (car alist)) key)) + (setq alist (cdr alist))) + (let ((tail alist) tail-cdr) + (while (setq tail-cdr (cdr tail)) + (if (and (consp (car tail-cdr)) + (eq (car (car tail-cdr)) key)) + (setcdr tail (cdr tail-cdr)) + (setq tail tail-cdr)))) + alist) + +(defun rassq-delete-all (value alist) + "Delete from ALIST all elements whose cdr is `eq' to VALUE. +Return the modified alist. +Elements of ALIST that are not conses are ignored." + (while (and (consp (car alist)) + (eq (cdr (car alist)) value)) + (setq alist (cdr alist))) + (let ((tail alist) tail-cdr) + (while (setq tail-cdr (cdr tail)) + (if (and (consp (car tail-cdr)) + (eq (cdr (car tail-cdr)) value)) + (setcdr tail (cdr tail-cdr)) + (setq tail tail-cdr)))) + alist) (defun make-temp-file (prefix &optional dir-flag suffix) "Create a temporary file. diff --git a/lisp/term/mac-win.el b/lisp/term/mac-win.el index 7cdaa2b725..9519dadeed 100644 --- a/lisp/term/mac-win.el +++ b/lisp/term/mac-win.el @@ -74,7 +74,7 @@ (require 'mouse) (require 'scroll-bar) (require 'faces) -;;(require 'select) +(require 'select) (require 'menu-bar) (require 'fontset) (require 'dnd) @@ -1143,23 +1143,232 @@ correspoinding TextEncodingBase value." (define-key special-event-map [language-change] 'mac-handle-language-change) -;;;; Selections and cut buffers - -;; Setup to use the Mac clipboard. The functions mac-cut-function and -;; mac-paste-function are defined in mac.c. -(set-selection-coding-system 'compound-text-mac) - -(setq interprogram-cut-function - '(lambda (str push) - (mac-cut-function - (encode-coding-string str selection-coding-system t) push))) - -(setq interprogram-paste-function - '(lambda () - (let ((clipboard (mac-paste-function))) - (if clipboard - (decode-coding-string clipboard selection-coding-system t))))) - +;;;; Selections and Services menu + +;; Setup to use the Mac clipboard. +(set-selection-coding-system mac-system-coding-system) + +;;; We keep track of the last text selected here, so we can check the +;;; current selection against it, and avoid passing back our own text +;;; from x-get-selection-value. +(defvar x-last-selected-text-clipboard nil + "The value of the CLIPBOARD selection last time we selected or +pasted text.") +(defvar x-last-selected-text-primary nil + "The value of the PRIMARY X selection last time we selected or +pasted text.") + +(defcustom x-select-enable-clipboard t + "*Non-nil means cutting and pasting uses the clipboard. +This is in addition to the primary selection." + :type 'boolean + :group 'killing) + +;;; Make TEXT, a string, the primary X selection. +(defun x-select-text (text &optional push) + (x-set-selection 'PRIMARY text) + (setq x-last-selected-text-primary text) + (when x-select-enable-clipboard + (x-set-selection 'CLIPBOARD text) + (setq x-last-selected-text-clipboard text)) + ) + +(defun x-get-selection (&optional type data-type) + "Return the value of a selection. +The argument TYPE (default `PRIMARY') says which selection, +and the argument DATA-TYPE (default `STRING') says +how to convert the data. + +TYPE may be any symbol \(but nil stands for `PRIMARY'). However, +only a few symbols are commonly used. They conventionally have +all upper-case names. The most often used ones, in addition to +`PRIMARY', are `SECONDARY' and `CLIPBOARD'. + +DATA-TYPE is usually `STRING', but can also be one of the symbols +in `selection-converter-alist', which see." + (let ((data (x-get-selection-internal (or type 'PRIMARY) + (or data-type 'STRING))) + (coding (or next-selection-coding-system + selection-coding-system))) + (when (and (stringp data) + (setq data-type (get-text-property 0 'foreign-selection data))) + (cond ((eq data-type 'public.utf16-plain-text) + (let ((encoded (and (fboundp 'mac-code-convert-string) + (mac-code-convert-string data + 'utf-16 coding)))) + (if encoded + (let ((coding-save last-coding-system-used)) + (setq data (decode-coding-string encoded coding)) + (setq last-coding-system-used coding-save)) + (setq data + (decode-coding-string data 'utf-16))))) + ((eq data-type 'com.apple.traditional-mac-plain-text) + (setq data (decode-coding-string data coding)))) + (put-text-property 0 (length data) 'foreign-selection data-type data)) + data)) + +(defun x-selection-value (type) + (let (text tiff-image) + (setq text (condition-case nil + (x-get-selection type 'public.utf16-plain-text) + (error nil))) + (if (not text) + (setq text (condition-case nil + (x-get-selection type + 'com.apple.traditional-mac-plain-text) + (error nil)))) + (if text + (remove-text-properties 0 (length text) '(foreign-selection nil) text)) + (setq tiff-image (condition-case nil + (x-get-selection type 'public.tiff) + (error nil))) + (when tiff-image + (remove-text-properties 0 (length tiff-image) + '(foreign-selection nil) tiff-image) + (setq tiff-image (create-image tiff-image 'tiff t)) + (or text (setq text " ")) + (put-text-property 0 (length text) 'display tiff-image text)) + text)) + +;;; Return the value of the current selection. +;;; Treat empty strings as if they were unset. +;;; If this function is called twice and finds the same text, +;;; it returns nil the second time. This is so that a single +;;; selection won't be added to the kill ring over and over. +(defun x-get-selection-value () + (let (clip-text primary-text) + (when x-select-enable-clipboard + (setq clip-text (x-selection-value 'CLIPBOARD)) + (if (string= clip-text "") (setq clip-text nil)) + + ;; Check the CLIPBOARD selection for 'newness', is it different + ;; from what we remebered them to be last time we did a + ;; cut/paste operation. + (setq clip-text + (cond;; check clipboard + ((or (not clip-text) (string= clip-text "")) + (setq x-last-selected-text-clipboard nil)) + ((eq clip-text x-last-selected-text-clipboard) nil) + ((string= clip-text x-last-selected-text-clipboard) + ;; Record the newer string, + ;; so subsequent calls can use the `eq' test. + (setq x-last-selected-text-clipboard clip-text) + nil) + (t + (setq x-last-selected-text-clipboard clip-text)))) + ) + + (setq primary-text (x-selection-value 'PRIMARY)) + ;; Check the PRIMARY selection for 'newness', is it different + ;; from what we remebered them to be last time we did a + ;; cut/paste operation. + (setq primary-text + (cond;; check primary selection + ((or (not primary-text) (string= primary-text "")) + (setq x-last-selected-text-primary nil)) + ((eq primary-text x-last-selected-text-primary) nil) + ((string= primary-text x-last-selected-text-primary) + ;; Record the newer string, + ;; so subsequent calls can use the `eq' test. + (setq x-last-selected-text-primary primary-text) + nil) + (t + (setq x-last-selected-text-primary primary-text)))) + + ;; As we have done one selection, clear this now. + (setq next-selection-coding-system nil) + + ;; At this point we have recorded the current values for the + ;; selection from clipboard (if we are supposed to) and primary, + ;; So return the first one that has changed (which is the first + ;; non-null one). + (or clip-text primary-text) + )) + +(put 'CLIPBOARD 'mac-scrap-name "com.apple.scrap.clipboard") +(if (eq system-type 'darwin) + (put 'FIND 'mac-scrap-name "com.apple.scrap.find")) +(put 'com.apple.traditional-mac-plain-text 'mac-ostype "TEXT") +(put 'public.utf16-plain-text 'mac-ostype "utxt") +(put 'public.tiff 'mac-ostype "TIFF") + +(defun mac-select-convert-to-string (selection type value) + (let ((str (cdr (xselect-convert-to-string selection nil value))) + coding) + (setq coding (or next-selection-coding-system selection-coding-system)) + (if coding + (setq coding (coding-system-base coding)) + (setq coding 'raw-text)) + (when str + ;; If TYPE is nil, this is a local request, thus return STR as + ;; is. Otherwise, encode STR. + (if (not type) + str + (let ((inhibit-read-only t)) + (remove-text-properties 0 (length str) '(composition nil) str) + (cond + ((eq type 'public.utf16-plain-text) + (let (s) + (when (and (fboundp 'mac-code-convert-string) + (memq coding (find-coding-systems-string str))) + (setq coding (coding-system-change-eol-conversion coding 'mac)) + (setq s (mac-code-convert-string + (encode-coding-string str coding) + coding 'utf-16))) + (setq str (or s (encode-coding-string str 'utf-16-mac))))) + ((eq type 'com.apple.traditional-mac-plain-text) + (setq coding (coding-system-change-eol-conversion coding 'mac)) + (setq str (encode-coding-string str coding))) + (t + (error "Unknown selection type: %S" type)) + ))) + + (setq next-selection-coding-system nil) + (cons type str)))) + +(setq selection-converter-alist + (nconc + '((public.utf16-plain-text . mac-select-convert-to-string) + (com.apple.traditional-mac-plain-text . mac-select-convert-to-string) + ;; This is not enabled by default because the `Import Image' + ;; menu makes Emacs crash or hang for unknown reasons. + ;; (public.tiff . nil) + ) + selection-converter-alist)) + +(defun mac-services-open-file () + (interactive) + (find-file-existing (x-selection-value mac-services-selection))) + +(defun mac-services-open-selection () + (interactive) + (switch-to-buffer (generate-new-buffer "*untitled*")) + (insert (x-selection-value mac-services-selection)) + (sit-for 0) + (save-buffer) ; It pops up the save dialog. + ) + +(defun mac-services-insert-text () + (interactive) + (let ((text (x-selection-value mac-services-selection))) + (if (not buffer-read-only) + (insert text) + (kill-new text) + (message + (substitute-command-keys + "The text from the Services menu can be accessed with \\[yank]"))))) + +(defvar mac-application-menu-map (make-sparse-keymap)) +(define-key mac-application-menu-map [quit] 'save-buffers-kill-emacs) +(define-key mac-application-menu-map [services perform open-file] + 'mac-services-open-file) +(define-key mac-application-menu-map [services perform open-selection] + 'mac-services-open-selection) +(define-key mac-application-menu-map [services paste] + 'mac-services-insert-text) +(define-key mac-application-menu-map [preferences] 'customize) +(define-key mac-application-menu-map [about] 'display-splash-screen) +(global-set-key [menu-bar application] mac-application-menu-map) ;;; Do the actual Windows setup here; the above code just defines ;;; functions and variables that we use now. @@ -1394,7 +1603,7 @@ correspoinding TextEncodingBase value." '(ascii eight-bit-control eight-bit-graphic)) (set-fontset-font fontset key font))) (get encoder 'translation-table))))) - + (defun create-fontset-from-mac-roman-font (font &optional resolved-font fontset-name) "Create a fontset from a Mac roman font FONT. @@ -1489,12 +1698,25 @@ ascii:-*-Monaco-*-*-*-*-12-*-*-*-*-*-mac-roman") (error "Suspending an Emacs running under Mac makes no sense")) (add-hook 'suspend-hook 'x-win-suspend-error) +;;; Arrange for the kill and yank functions to set and check the clipboard. +(setq interprogram-cut-function 'x-select-text) +(setq interprogram-paste-function 'x-get-selection-value) + + +;;; Turn off window-splitting optimization; Mac is usually fast enough +;;; that this is only annoying. +(setq split-window-keep-point t) + ;; Don't show the frame name; that's redundant. (setq-default mode-line-frame-identification " ") ;; Turn on support for mouse wheels. (mouse-wheel-mode 1) + +;; Enable CLIPBOARD copy/paste through menu bar commands. +(menu-bar-enable-clipboard) + (defun mac-drag-n-drop (event) "Edit the files listed in the drag-n-drop EVENT. Switch to a buffer editing the last file dropped." diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index ab549d47b6..3f4a30dc79 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -828,6 +828,14 @@ says which mode to use." (tex-mode-internal) (tex-guess-mode))) +;; The following three autoloaded aliases appear to conflict with +;; AUCTeX. However, even though AUCTeX uses the mixed case variants +;; for all mode relevant variables and hooks, the invocation function +;; and setting of `major-mode' themselves need to be lowercase for +;; AUCTeX to provide a fully functional user-level replacement. So +;; these aliases should remain as they are, in particular since AUCTeX +;; users are likely to use them. + ;;;###autoload (defalias 'TeX-mode 'tex-mode) ;;;###autoload diff --git a/lisp/tooltip.el b/lisp/tooltip.el index 054f9c9571..840aa3c200 100644 --- a/lisp/tooltip.el +++ b/lisp/tooltip.el @@ -117,7 +117,10 @@ position to pop up the tooltip." :group 'tooltip) (defcustom tooltip-gud-tips-p nil - "*Non-nil means show tooltips in GUD sessions." + "*Non-nil means show tooltips in GUD sessions. + +This allows you to display a variable's value in a tooltip simply by +pointing at it with the mouse." :type 'boolean :tag "GUD" :group 'tooltip) @@ -412,12 +415,22 @@ This event can be examined by forms in TOOLTIP-GUD-DISPLAY.") (message "Dereferencing is now %s." (if tooltip-gud-dereference "on" "off")))) +(defun tooltip-toggle-gud-tips () + "Toggle the display of GUD tooltips." + (interactive) + (setq tooltip-gud-tips-p (not tooltip-gud-tips-p)) + ;; Reconsider for all buffers whether mouse motion events are desired. + (tooltip-change-major-mode) + (when (interactive-p) + (message (format "GUD tooltips %sabled" + (if tooltip-gud-tips-p "en" "dis"))))) + ; This will only display data that comes in one chunk. ; Larger arrays (say 400 elements) are displayed in ; the tootip incompletely and spill over into the gud buffer. ; Switching the process-filter creates timing problems and -; it may be difficult to do better. gdba in gdb-ui.el -; gets round this problem. +; it may be difficult to do better. Using annotations as in +; gdb-ui.el gets round this problem. (defun tooltip-gud-process-output (process output) "Process debugger output and show it in a tooltip window." (set-process-filter process tooltip-gud-original-filter) diff --git a/lisp/vc.el b/lisp/vc.el index ce4cb2d36c..c5929f1da8 100644 --- a/lisp/vc.el +++ b/lisp/vc.el @@ -616,23 +616,23 @@ version control backend imposes itself." ;; Annotate customization (defcustom vc-annotate-color-map - '(( 20. . "#FF0000") - ( 40. . "#FF3800") - ( 60. . "#FF7000") - ( 80. . "#FFA800") - (100. . "#FFE000") - (120. . "#E7FF00") - (140. . "#AFFF00") - (160. . "#77FF00") - (180. . "#3FFF00") - (200. . "#07FF00") - (220. . "#00FF31") - (240. . "#00FF69") - (260. . "#00FFA1") - (280. . "#00FFD9") - (300. . "#00EEFF") - (320. . "#00B6FF") - (340. . "#007EFF")) + '(( 20. . "#FFCC00") + ( 40. . "#FF6666") + ( 60. . "#FF6600") + ( 80. . "#FF3300") + (100. . "#FF00FF") + (120. . "#FF0000") + (140. . "#CCCC00") + (160. . "#CC00CC") + (180. . "#BC8F8F") + (200. . "#99CC00") + (220. . "#999900") + (240. . "#7AC5CD") + (260. . "#66CC00") + (280. . "#33CC33") + (300. . "#00CCFF") + (320. . "#00CC99") + (340. . "#0099FF")) "*Association list of age versus color, for \\[vc-annotate]. Ages are given in units of fractional days. Default is eighteen steps using a twenty day increment." diff --git a/lisp/window.el b/lisp/window.el index b4fd664a43..8c46addf44 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -29,6 +29,15 @@ ;;; Code: +(defvar window-size-fixed nil + "*Non-nil in a buffer means windows displaying the buffer are fixed-size. +If the value is`height', then only the window's height is fixed. +If the value is `width', then only the window's width is fixed. +Any other non-nil value fixes both the width and the height. +Emacs won't change the size of any window displaying that buffer, +unless you explicitly change the size, or Emacs has no other choice.") +(make-variable-buffer-local 'window-size-fixed) + (defmacro save-selected-window (&rest body) "Execute BODY, then select the window that was selected before BODY. Also restore the selected window of each frame as it was at the start diff --git a/lispref/ChangeLog b/lispref/ChangeLog index 2e440e48fa..bf1149ee4a 100644 --- a/lispref/ChangeLog +++ b/lispref/ChangeLog @@ -1,3 +1,34 @@ +2005-04-24 Eli Zaretskii <[email protected]> + + * syntax.texi (Syntax Table Internals): Elaborate documentation of + syntax-after and syntax-class. + + * files.texi (Changing Files): Fix last change's cross-reference. + (Unique File Names): Don't mention "numbers" in the documentation + of make-temp-file and make-temp-name. + +2005-04-23 Richard M. Stallman <[email protected]> + + * files.texi (Changing Files): Document MUSTBENEW arg in copy-file. + +2005-04-22 Nick Roberts <[email protected]> + + * windows.texi (Cyclic Window Ordering): Clarify window-list. + +2005-04-22 Nick Roberts <[email protected]> + + * variables.texi (Variable Aliases): Describe make-obsolete-variable + and define-obsolete-variable-alias. + +2005-04-22 Kim F. Storm <[email protected]> + + * symbols.texi (Symbol Plists): Remove safe-get, as get is now safe. + (Other Plists): Remove safe-plist-get, as plist-get is now safe. + +2005-04-21 Lute Kamstra <[email protected]> + + * lists.texi (Association Lists): Document rassq-delete-all. + 2005-04-19 Richard M. Stallman <[email protected]> * modes.texi (Search-based Fontification): Explain that diff --git a/lispref/files.texi b/lispref/files.texi index 18a98a406c..0b6e7a2832 100644 --- a/lispref/files.texi +++ b/lispref/files.texi @@ -1364,7 +1364,7 @@ with @code{add-name-to-file} and then deleting @var{filename} has the same effect as renaming, aside from momentary intermediate states. @end deffn -@deffn Command copy-file oldname newname &optional ok-if-exists time +@deffn Command copy-file oldname newname &optional ok-if-exists time mustbenew This command copies the file @var{oldname} to @var{newname}. An error is signaled if @var{oldname} does not exist. If @var{newname} names a directory, it copies @var{oldname} into that directory, @@ -1379,6 +1379,10 @@ This function copies the file modes, too. In an interactive call, a prefix argument specifies a non-@code{nil} value for @var{time}. + +The argument @var{mustbenew} controls whether an existing file can be +overwritten. It works like the similarly-named argument of +@code{write-region} (@pxref{Writing to Files, mustbenew}). @end deffn @deffn Command make-symbolic-link filename newname &optional ok-if-exists @@ -2024,10 +2028,13 @@ two different jobs from trying to use the exact same file name. @defun make-temp-file prefix &optional dir-flag suffix @tindex make-temp-file -This function creates a temporary file and returns its name. -The name starts with @var{prefix}; it also contains a number that is -different in each Emacs job. If @var{prefix} is a relative file name, -it is expanded against @code{temporary-file-directory}. +This function creates a temporary file and returns its name. Emacs +creates the temporary file's name by adding to @var{prefix} some +random characters that are different in each Emacs job. The result is +guaranteed to be a newly created empty file. On MS-DOS, this function +can truncate the @var{string} prefix to fit into the 8+3 file-name +limits. If @var{prefix} is a relative file name, it is expanded +against @code{temporary-file-directory}. @example @group @@ -2072,13 +2079,13 @@ you should use @code{make-temp-name} instead: @end example @defun make-temp-name string -This function generates a string that can be used as a unique file name. -The name starts with @var{string}, and contains a number that is -different in each Emacs job. It is like @code{make-temp-file} except -that it just constructs a name, and does not create a file. Another -difference is that @var{string} should be an absolute file name. On -MS-DOS, this function can truncate the @var{string} prefix to fit into -the 8+3 file-name limits. +This function generates a string that can be used as a unique file +name. The name starts with @var{string}, and has several random +characters appended to it, which are different in each Emacs job. It +is like @code{make-temp-file} except that it just constructs a name, +and does not create a file. Another difference is that @var{string} +should be an absolute file name. On MS-DOS, this function can +truncate the @var{string} prefix to fit into the 8+3 file-name limits. @end defun @defvar temporary-file-directory diff --git a/lispref/lists.texi b/lispref/lists.texi index 47ea5b7d54..ab7d496e46 100644 --- a/lispref/lists.texi +++ b/lispref/lists.texi @@ -1667,6 +1667,15 @@ alist @end example @end defun +@defun rassq-delete-all value alist +This function deletes from @var{alist} all the elements whose @sc{cdr} +is @code{eq} to @var{value}. It returns the shortened alist, and +often modifies the original list structure of @var{alist}. +@code{rassq-delete-all} is like @code{assq-delete-all} except that it +compares the @sc{cdr} of each @var{alist} association instead of the +@sc{car}. +@end defun + @ignore arch-tag: 31fb8a4e-4aa8-4a74-a206-aa00451394d4 @end ignore diff --git a/lispref/symbols.texi b/lispref/symbols.texi index 2c81cb9493..9f59ad1f02 100644 --- a/lispref/symbols.texi +++ b/lispref/symbols.texi @@ -496,8 +496,6 @@ This function finds the value of the property named @var{property} in @var{symbol}'s property list. If there is no such property, @code{nil} is returned. Thus, there is no distinction between a value of @code{nil} and the absence of the property. -A @code{wrong-type-argument} error may be signaled if @var{symbol} -has a malformed property list. The name @var{property} is compared with the existing property names using @code{eq}, so any object is a legitimate property. @@ -505,12 +503,6 @@ using @code{eq}, so any object is a legitimate property. See @code{put} for an example. @end defun -@defun safe-get symbol property -This function finds the value of the property named @var{property} in -@var{symbol}'s property list. Unlike @code{get}, it just returns -@code{nil} if @var{symbol} has a malformed property list. -@end defun - @defun put symbol property value This function puts @var{value} onto @var{symbol}'s property list under the property name @var{property}, replacing any previous property value. @@ -536,9 +528,7 @@ that are stored in places other than symbols: @defun plist-get plist property This returns the value of the @var{property} property -stored in the property list @var{plist}. -A @code{wrong-type-argument} error may be signaled if @var{plist} is -not a valid property list. For example, +stored in the property list @var{plist}. For example, @example (plist-get '(foo 4) 'foo) @@ -548,16 +538,12 @@ not a valid property list. For example, (plist-get '(foo 4 bad) 'bar) @result{} @code{wrong-type-argument} error @end example -@end defun -@defun safe-plist-get plist property -This returns the value of the @var{property} property -stored in the property list @var{plist}. Unlike @code{plist-get}, it -accepts a malformed @var{plist} argument and always returns @code{nil} +It accepts a malformed @var{plist} argument and always returns @code{nil} if @var{property} is not found in the @var{plist}. For example, @example -(safe-plist-get '(foo 4 bad) 'bar) +(plist-get '(foo 4 bad) 'bar) @result{} nil @end example @end defun diff --git a/lispref/syntax.texi b/lispref/syntax.texi index 438c1815fe..248ed77c4e 100644 --- a/lispref/syntax.texi +++ b/lispref/syntax.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1998, 1999, 2004 +@c Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1998, 1999, 2004, 2005 @c Free Software Foundation, Inc. @c See the file elisp.texi for copying conditions. @setfilename ../info/syntax @@ -940,7 +940,25 @@ This function returns the internal form @code{(@var{syntax-code} . @defun syntax-after pos This function returns the syntax code of the character in the buffer after position @var{pos}, taking account of syntax properties as well -as the syntax table. +as the syntax table. If @var{pos} is outside the buffer's accessible +portion (@pxref{Narrowing, accessible portion}), this function returns +@code{nil}. +@end defun + +@defun syntax-class syntax +This function returns the syntax class of the syntax code +@var{syntax}. (It masks off the high 16 bits that hold the flags +encoded in the syntax descriptor.) If @var{syntax} is @code{nil}, it +returns @code{nil}; this is so evaluating the expression + +@example +(syntax-class (syntax-after pos)) +@end example + +@noindent +where @code{pos} is outside the buffer's accessible portion, will +yield @code{nil} without throwing errors or producing wrong syntax +class codes. @end defun @node Categories diff --git a/lispref/variables.texi b/lispref/variables.texi index de5fb40618..49a8f0d7a2 100644 --- a/lispref/variables.texi +++ b/lispref/variables.texi @@ -1714,6 +1714,33 @@ of the variable at the end of the chain of aliases. This function returns @var{base-var}. @end defun +Variables aliases are often used prior to replacing an old name for a variable +with a new name. To allow some time for existing code to adapt to this change, +@code{make-obsolete-variable} declares that the old name is obsolete and +therefore that it may be removed at some stage in the future. + +@defmac make-obsolete-variable variable new &optional when +This macro makes the byte-compiler warn that symbol @var{variable} is +obsolete and that symbol @var{new} should be used instead. If +@var{new} is a string, this is the message and there is no replacement +variable. If it is provided, @var{when} should be a string indicating +when the variable was first made obsolete, for example a date or a +release number. +@end defmac + +You can make two variables synonyms and declare one obsolete at the +same time using the macro @code{define-obsolete-variable-alias}. + +@defmac define-obsolete-variable-alias variable new &optional when docstring +This macro defines the symbol @var{variable} as a variable alias for +symbol @var{new} and warns that @var{variable} is obsolete. If it is +provided, @var{when} should be a string indicating when @var{variable} +was first made obsolete. The optional argument @var{docstring} +specifies the documentation string for @var{variable}. If +@var{docstring} is omitted or nil, @var{variable} uses the +documentation string of @var{new} unless it already has one. +@end defmac + @defun indirect-variable variable This function returns the variable at the end of the chain of aliases of @var{variable}. If @var{variable} is not a symbol, or if @var{variable} is diff --git a/lispref/windows.texi b/lispref/windows.texi index 042ede6ed4..752969e458 100644 --- a/lispref/windows.texi +++ b/lispref/windows.texi @@ -665,17 +665,16 @@ for details. @defun window-list &optional frame minibuf window This function returns a list of the windows on @var{frame}, starting -with @var{window}. If @var{frame} is @code{nil} or omitted, the -selected frame is used instead; if @var{window} is @code{nil} or -omitted, the selected window is used instead. - -The value of @var{minibuf} determines if the minibuffer window will be -included in the result list. If @var{minibuf} is @code{t}, the -minibuffer window will be included, even if it isn't active. If -@var{minibuf} is @code{nil} or omitted, the minibuffer window will -only be included in the list if it is active. If @var{minibuf} is -neither @code{nil} nor @code{t}, the minibuffer window is not -included, whether or not it is active. +with @var{window}. If @var{frame} is @code{nil} or omitted, +@code{window-list} uses the selected frame instead; if @var{window} is +@code{nil} or omitted, it uses the selected window. + +The value of @var{minibuf} determines if the minibuffer window is +included in the result list. If @var{minibuf} is @code{t}, the result +always includes the minibuffer window. If @var{minibuf} is @code{nil} +or omitted, that includes the minibuffer window if it is active. If +@var{minibuf} is neither @code{nil} nor @code{t}, the result never +includes the minibuffer window. @end defun @node Buffers and Windows diff --git a/mac/ChangeLog b/mac/ChangeLog index 4d3dba217d..27cd5d98be 100644 --- a/mac/ChangeLog +++ b/mac/ChangeLog @@ -1,3 +1,13 @@ +2005-04-24 YAMAMOTO Mitsuharu <[email protected]> + + * makefile.MPW (MacObjects): Add macselect.c.x. + (macselect.c.x): New target. + (mac.c): Fix dependency. + + * Emacs.app/Contents/Info.plist: Add NSServices key and data. + + * inc/s-mac.h: Define HAVE_PWD_H. + 2005-04-14 YAMAMOTO Mitsuharu <[email protected]> * makefile.MPW (NonCarbonLibs): Add LocalesLib. Delete diff --git a/mac/Emacs.app/Contents/Info.plist b/mac/Emacs.app/Contents/Info.plist index afcf6cc342..7f79e8f6ab 100644 --- a/mac/Emacs.app/Contents/Info.plist +++ b/mac/Emacs.app/Contents/Info.plist @@ -35,5 +35,46 @@ <string>EMAx</string> <key>CFBundleVersion</key> <string>1.1</string> + <key>NSServices</key> + <array> + <dict> + <key>NSKeyEquivalent</key> + <dict/> + <key>NSMenuItem</key> + <dict> + <key>default</key> + <string>Emacs/Open Selected File</string> + </dict> + <key>NSMessage</key> + <string>open-file</string> + <key>NSPortName</key> + <string>Emacs</string> + <key>NSReturnTypes</key> + <array/> + <key>NSSendTypes</key> + <array> + <string>NSStringPboardType</string> + </array> + </dict> + <dict> + <key>NSKeyEquivalent</key> + <dict/> + <key>NSMenuItem</key> + <dict> + <key>default</key> + <string>Emacs/New Buffer Containing Selection</string> + </dict> + <key>NSMessage</key> + <string>open-selection</string> + <key>NSPortName</key> + <string>Emacs</string> + <key>NSReturnTypes</key> + <array/> + <key>NSSendTypes</key> + <array> + <string>NSStringPboardType</string> + </array> + </dict> + </array> </dict> </plist> diff --git a/mac/inc/s-mac.h b/mac/inc/s-mac.h index a9108a67ca..56f4df5941 100644 --- a/mac/inc/s-mac.h +++ b/mac/inc/s-mac.h @@ -96,6 +96,8 @@ Boston, MA 02111-1307, USA. */ /* #define HAVE_PTYS */ +#define HAVE_PWD_H 1 + /* * Define NONSYSTEM_DIR_LIBRARY to make Emacs emulate * The 4.2 opendir, etc., library functions. diff --git a/mac/makefile.MPW b/mac/makefile.MPW index 5e0a6e1d89..2f1d6750a9 100644 --- a/mac/makefile.MPW +++ b/mac/makefile.MPW @@ -133,6 +133,7 @@ MacObjects = � "{Src}mac.c.x" � "{Src}macfns.c.x" � "{Src}macmenu.c.x" � + "{Src}macselect.c.x" � "{Src}macterm.c.x" StdLibraries = � @@ -881,6 +882,14 @@ NonCarbon � "{Includes}sys:types.h" � {DISPEXTERN_H_GROUP} +{Src}macselect.c.x � � + {CONFIG_H_GROUP} � + "{Src}lisp.h" � + "{Src}macterm.h" � + "{Src}macgui.h" � + "{Src}frame.h" � + {BLOCKINPUT_H_GROUP} + {Src}mac.c � � {CONFIG_H_GROUP} � "{Includes}utime.h" � @@ -895,7 +904,14 @@ NonCarbon � "{Src}sysselect.h" � "{Src}systime.h" � "{Includes}sys:time.h" � - "{Includes}utsname.h" + "{Includes}utsname.h" � + "{Src}macterm.h" � + "{Src}macgui.h" � + "{Src}frame.h" � + {BLOCKINPUT_H_GROUP} � + "{Src}charset.h" � + "{Src}coding.h" � + "{Src}ccl.h" {Src}macfns.c � � {CONFIG_H_GROUP} � diff --git a/man/ChangeLog b/man/ChangeLog index bda8236182..a7bcda73d0 100644 --- a/man/ChangeLog +++ b/man/ChangeLog @@ -1,3 +1,9 @@ +2005-04-24 Richard M. Stallman <[email protected]> + + * ack.texi: Delete info about lazy-lock.el and fast-lock.el. + + * faq.texi: Delete info about lazy-lock.el and fast-lock.el. + 2005-04-19 Kim F. Storm <[email protected]> * building.texi (Compilation Mode): Add M-g M-n and M-g M-p bindings. diff --git a/man/ack.texi b/man/ack.texi index 5920bd197e..1a6d24fd81 100644 --- a/man/ack.texi +++ b/man/ack.texi @@ -696,21 +696,9 @@ Brian Marick and Daniel LaLiberte wrote @file{hideif.el}, support for hiding selected code within C @code{#ifdef} clauses. @item -Simon Marshall wrote: - -@itemize @minus -@item -@file{fast-lock.el}, which caches the face data computed by Font Lock mode, -@item -@file{lazy-lock.el}, which delays fontification in Font Lock mode -until text is actually displayed, and -@item -@file{regexp-opt.el}, which generates a regular expression from a list -of strings. -@end itemize - -Simon also extended @file{comint.el}, originally written by Olin -Shivers. +Simon Marshall wrote @file{regexp-opt.el}, which generates a regular +expression from a list of strings. He also extended @file{comint.el}, +originally written by Olin Shivers. @item Bengt Martensson, Mark Shapiro, Mike Newton, Aaron Larson, and Stefan diff --git a/man/faq.texi b/man/faq.texi index dc55c4b89b..641f1f5b30 100644 --- a/man/faq.texi +++ b/man/faq.texi @@ -2549,17 +2549,6 @@ information, see the documentation for @code{font-lock-maximum-decoration} with @kbd{C-h v} (or @kbd{M-x describe-variable @key{RET}}). -@cindex Lazy font-lock -You might also want to investigate @code{fast-lock-mode} and -@code{lazy-lock-mode}, versions of @code{font-lock-mode} that speed up -highlighting. These are the alternatives for @code{jit-lock-mode} in -versions of Emacs before 21.1. The advantage of @code{lazy-lock-mode} -is that it only fontifies buffers when certain conditions are met, such -as after a certain amount of idle time, or after you have finished -scrolling through text. See the documentation for @code{lazy-lock-mode} -by typing @kbd{C-h f @code{lazy-lock-mode}} (@kbd{M-x describe-function -@key{RET} lazy-lock-mode @key{RET}}). - Also see the documentation for the function @code{font-lock-mode}, available by typing @kbd{C-h f font-lock-mode} (@kbd{M-x describe-function @key{RET} font-lock-mode @key{RET}}). diff --git a/nt/ChangeLog b/nt/ChangeLog index f91c59a85c..fd4ee0ab19 100644 --- a/nt/ChangeLog +++ b/nt/ChangeLog @@ -1,3 +1,7 @@ +2005-04-23 David Hunter <[email protected]> (tiny change) + + * config.nt (HAVE_PWD_H): Undef. + 2004-06-07 Juanma Barranquero <[email protected]> * INSTALL: Clarify paragraph about compatibility between image diff --git a/nt/config.nt b/nt/config.nt index 56ec72a56a..a41d6ecac4 100644 --- a/nt/config.nt +++ b/nt/config.nt @@ -139,6 +139,7 @@ Boston, MA 02111-1307, USA. */ #undef HAVE_TERMIOS_H #undef HAVE_LIMITS_H #undef HAVE_STRING_H +#undef HAVE_PWD_H #undef STDC_HEADERS #undef TIME_WITH_SYS_TIME diff --git a/src/ChangeLog b/src/ChangeLog index e2a5fa1fd9..834dcf4ab8 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,152 @@ +2005-04-24 Richard M. Stallman <[email protected]> + + * indent.c (Fvertical_motion): Bind fontification-functions to nil. + +2005-04-24 Eli Zaretskii <[email protected]> + + * regex.c (re_search_2, re_match_2_internal): Convert second arg + of RE_TRANSLATE to int, to shut up GCC warnings. + + * fileio.c (Fcopy_file): Doc fix. + [MSDOS]: Fix call to emacs_open: buffer_file_type not defined and + not needed. + +2005-04-24 YAMAMOTO Mitsuharu <[email protected]> + + * Makefile.in [HAVE_CARBON] (MAC_OBJ): Add macselect.o. + (SOME_MACHINE_OBJECTS): Likewise. + (mac.o): Depend on ccl.h. + (macselect.o): New target. + + * emacs.c (main) [MAC_OS8 || MAC_OSX && HAVE_CARBON]: Call + syms_of_macselect. + + * frame.c (Fdelete_frame) [MAC_OS]: Call x_clear_frame_selections. + + * mac.c [!TARGET_API_MAC_CARBON]: Don't include charset.h or + coding.h. + (QCLIPBOARD): Remove variable. + (syms_of_mac): Don't initialize it. + (Fmac_paste_function, Fmac_cut_function, Fx_selection_exists_p): + Remove functions. + (syms_of_mac): Don't defsubr them. + [TARGET_API_MAC_CARBON] (Qmime_charset, QNFD, QNFKD, QNFC, QNFKC) + (QHFS_plus_D, QHFS_plus_C): New variables. + (syms_of_mac) [TARGET_API_MAC_CARBON]: Initialize them. + [TARGET_API_MAC_CARBON] (get_cfstring_encoding_from_lisp) + (cfstring_create_normalized): New functions. + [TARGET_API_MAC_CARBON] (Fmac_code_convert_string): Likewise. + (syms_of_mac) [TARGET_API_MAC_CARBON]: Defsubr it. + + * macterm.c (handling_window_update, terminate_flag): Remove + variables. + (do_window_update, do_ae_quit_application, XTread_socket): Don't + use them. + (WNE_SLEEP_AT_SUSPEND, WNE_SLEEP_AT_RESUME): Don't define. + [USE_CARBON_EVENTS && MAC_OSX] (mac_handle_service_event) + (init_service_handler): Move to macselect.c. Remove declarations. + [USE_CARBON_EVENTS && MAC_OSX] (init_service_handler): Add extern. + (Qapplication, Qabout): New variables. + (syms_of_mac): Initialize them. + [USE_CARBON_EVENTS && MAC_OSX] (Qpreferences, Qservices, Qpaste) + (Qperform): New variables. + (syms_of_mac) [USE_CARBON_EVENTS && MAC_OSX]: Initialize them. + (do_get_menus) [!TARGET_API_MAC_CARBON]: Don't call AppendResMenu. + (do_menu_choice): Unhighlight menu bar also when menu_id is 0. + (mac_store_application_menu_event, init_menu_bar): New functions. + [USE_CARBON_EVENTS] (mac_handle_command_event) + (init_command_handler): New functions. + (mac_handle_window_event): Return noErr on window update event. + (do_ae_quit_application): Call mac_store_application_menu_event. + (mac_initialize) [USE_CARBON_EVENTS]: Call init_command_handler + and init_menu_bar. + + * macterm.h (x_clear_frame_selections): Add extern. + + * macselect.c: New file for selection processing on Mac OS. + +2005-04-23 Richard M. Stallman <[email protected]> + + * fileio.c (Fcopy_file): New arg MUSTBENEW. + (Frename_file): Pass new arg to Fcopy_file. + + * window.c (window_size_fixed): Variable deleted. + (syms_of_window): Initialize window-size-fixed to nil. + But don't DEFVAR window_size_fixed. + +2005-04-23 Andreas Schwab <[email protected]> + + * m/macppc.h (LD_SWITCH_MACHINE) [LINUX]: Don't define. + (START_FILES, LIB_STANDARD) [LINUX && _ARCH_PPC64]: Override to + use lib64 instead of lib. + (_LP64) [_ARCH_PPC64]: Define if not defined. + +2005-04-23 David Hunter <[email protected]> (tiny change) + + * s/ms-w32.h (HAVE_PWD_H): Define. + +2005-04-22 Kenichi Handa <[email protected]> + + * fns.c (copy_sub_char_table): Explicitly copy the default value + of the sub-chartable. + + * fontset.c (fontset_set): When a sub-chartable is created, + explicitly sets the defalt value. + +2005-04-22 Kim F. Storm <[email protected]> + + * fns.c (Fplist_get): Replace by Fsafe_plist_get. + (Fsafe_plist_get): Rename to Fplist_get. + (Fsafe_get): Remove, as Fget now uses safe Fplist_get. + (defsubr): Remove defsubr for Fsafe_plist_get and Fsafe_get. + + * lisp.h (Fsafe_plist_get, Fsafe_get): Remove EXFUN. + + * xdisp.c (store_mode_line_string, produce_stretch_glyph) + (note_mode_line_or_margin_highlight, note_mouse_highlight): + Use Fplist_get instead of Fsafe_plist_get. + + * xfaces.c (resolve_face_name): Use Fget instead of Fsafe_get. + +2005-04-21 Miles Bader <[email protected]> + + * xdisp.c (dump_glyph_row): Don't display overlay_arrow_p field. + +2005-04-20 Thien-Thi Nguyen <[email protected]> + + * sysdep.c: Remove reference to defunct vms-pwd.h. + * dired.c: Likewise. Also, for pwd.h, use HAVE_PWD_H, not !VMS. + * editfns.c, fileio.c, filelock.c, sysdep.c, xrdb.c: Likewise. + + * config.in: Regenerate. + +2005-04-20 Kenichi Handa <[email protected]> + + * lisp.h (CHAR_TABLE_DEFAULT_SLOT_ASCII): New macro. + (CHAR_TABLE_DEFAULT_SLOT_8_BIT_CONTROL): New macro. + (CHAR_TABLE_DEFAULT_SLOT_8_BIT_GRAPHIC): New macro. + + * alloc.c (make_sub_char_table): Argument changed to initial + value of the slots. + + * data.c (Faref): Handle special slots used as default values of + ascii, eight-bit-control, eight-bit-control. Don't ignore a + default value set for a group of characters. + (Faset): Signal an error if IDXVAL is not a valid character code. + Make a sub-chartable with correct initial value. + + * fns.c (Fset_char_table_range): Don't set slots used as default + values for ascii, eight-bit-control, eight-bit-graphic. Don't + call Faref with charset-id. + (Fset_char_table_default): Document how to treat normal character + argument. Handle special slots used as default values of ascii, + eight-bit-control, eight-bit-control. Make a sub chartable if + necessary. + +2005-04-20 Kenichi Handa <[email protected]> + + * search.c (boyer_moore): Fix previous change. + 2005-04-19 Kim F. Storm <[email protected]> * xdisp.c (setup_for_ellipsis): Reset saved_face_id to use default @@ -2728,7 +2877,7 @@ * doc.c: New variable Vbuild_files. (Fsnarf_documentation): If Vbuild_files is nil, populate it with - file names from buildobh.lst. Only attach docstrings from files + file names from buildobj.lst. Only attach docstrings from files that are in Vbuild_files. (syms_of_doc): Defvar Vbuild_files. diff --git a/src/Makefile.in b/src/Makefile.in index 874d2b8430..a7013ce4de 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -570,7 +570,7 @@ CYGWIN_OBJ = sheap.o #ifdef HAVE_CARBON mac = $(dot)$(dot)/mac/ -MAC_OBJ = mac.o macterm.o macfns.o macmenu.o fontset.o fringe.o image.o +MAC_OBJ = mac.o macterm.o macfns.o macmenu.o macselect.o fontset.o fringe.o image.o emacsapp = $(PWD)/$(mac)Emacs.app/ emacsappsrc = ${srcdir}/../mac/Emacs.app/ #endif @@ -597,7 +597,7 @@ obj= dispnew.o frame.o scroll.o xdisp.o $(XMENU_OBJ) window.o \ in case they are needed there. */ SOME_MACHINE_OBJECTS = sunfns.o dosfns.o msdos.o \ xterm.o xfns.o xmenu.o xselect.o xrdb.o xsmfns.o fringe.o image.o \ - mac.o macterm.o macfns.o macmenu.o fontset.o \ + mac.o macterm.o macfns.o macmenu.o macselect.o fontset.o \ w32.o w32bdf.o w32console.o w32fns.o w32heap.o w32inevt.o \ w32menu.o w32proc.o w32reg.o w32select.o w32term.o w32xfns.o @@ -1243,7 +1243,7 @@ abbrev.o buffer.o callint.o cmds.o dispnew.o editfns.o fileio.o frame.o \ scroll.o sysdep.o term.o widget.o window.o xdisp.o xfaces.o xfns.o xmenu.o \ xterm.o xselect.o sound.o: macgui.h mac.o: mac.c process.h sysselect.h blockinput.h atimer.h systime.h charset.h \ - coding.h $(config_h) + coding.h ccl.h $(config_h) macfns.o: macfns.c charset.h macterm.h macgui.h frame.h window.h buffer.h \ dispextern.h macgui.h fontset.h $(INTERVAL_SRC) keyboard.h blockinput.h \ atimer.h systime.h epaths.h termhooks.h coding.h systime.h $(config_h) @@ -1253,6 +1253,7 @@ macterm.o: blockinput.h atimer.h systime.h syssignal.h macterm.h macgui.h \ frame.h charset.h ccl.h dispextern.h fontset.h termhooks.h termopts.h \ termchar.h gnu.h disptab.h buffer.h window.h keyboard.h $(INTERVAL_SRC) \ process.h coding.h $(config_h) +macselect.o: blockinput.h macterm.h macgui.h frame.h $(config_h) ${emacsapp}Contents/Resources/English.lproj: mkdir -p $@ diff --git a/src/alloc.c b/src/alloc.c index c29c4c8e7f..43db28e08a 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3015,18 +3015,18 @@ The property's value should be an integer between 0 and 10. */) } -/* Return a newly created sub char table with default value DEFALT. +/* Return a newly created sub char table with slots initialized by INIT. Since a sub char table does not appear as a top level Emacs Lisp object, we don't need a Lisp interface to make it. */ Lisp_Object -make_sub_char_table (defalt) - Lisp_Object defalt; +make_sub_char_table (init) + Lisp_Object init; { Lisp_Object vector - = Fmake_vector (make_number (SUB_CHAR_TABLE_STANDARD_SLOTS), Qnil); + = Fmake_vector (make_number (SUB_CHAR_TABLE_STANDARD_SLOTS), init); XCHAR_TABLE (vector)->top = Qnil; - XCHAR_TABLE (vector)->defalt = defalt; + XCHAR_TABLE (vector)->defalt = Qnil; XSETCHAR_TABLE (vector, XCHAR_TABLE (vector)); return vector; } diff --git a/src/coding.c b/src/coding.c index a1dd77872f..b914574bbc 100644 --- a/src/coding.c +++ b/src/coding.c @@ -6671,7 +6671,7 @@ highest priority. */) STRING_MULTIBYTE (string)); } -/* Subroutine for Fsafe_coding_systems_region_internal. +/* Subroutine for Ffind_coding_systems_region_internal. Return a list of coding systems that safely encode the multibyte text between P and PEND. SAFE_CODINGS, if non-nil, is an alist of diff --git a/src/config.in b/src/config.in index d3dab7ffab..dc66c234d0 100644 --- a/src/config.in +++ b/src/config.in @@ -451,6 +451,9 @@ Boston, MA 02111-1307, USA. */ /* Define to 1 if you have the <pty.h> header file. */ #undef HAVE_PTY_H +/* Define to 1 if you have the <pwd.h> header file. */ +#undef HAVE_PWD_H + /* Define to 1 if you have the `random' function. */ #undef HAVE_RANDOM @@ -779,9 +782,9 @@ Boston, MA 02111-1307, USA. */ /* If using the C implementation of alloca, define if you know the direction of stack growth for your system; otherwise it will be automatically deduced at run-time. - STACK_DIRECTION > 0 => grows toward higher addresses - STACK_DIRECTION < 0 => grows toward lower addresses - STACK_DIRECTION = 0 => direction of growth unknown */ + STACK_DIRECTION > 0 => grows toward higher addresses + STACK_DIRECTION < 0 => grows toward lower addresses + STACK_DIRECTION = 0 => direction of growth unknown */ #undef STACK_DIRECTION /* Define to 1 if you have the ANSI C header files. */ diff --git a/src/data.c b/src/data.c index 25691a4678..f628532031 100644 --- a/src/data.c +++ b/src/data.c @@ -1979,10 +1979,20 @@ or a byte-code object. IDX starts at 0. */) args_out_of_range (array, idx); if (idxval < CHAR_TABLE_ORDINARY_SLOTS) { + if (! SINGLE_BYTE_CHAR_P (idxval)) + args_out_of_range (array, idx); /* For ASCII and 8-bit European characters, the element is stored in the top table. */ val = XCHAR_TABLE (array)->contents[idxval]; if (NILP (val)) + { + int default_slot + = (idxval < 0x80 ? CHAR_TABLE_DEFAULT_SLOT_ASCII + : idxval < 0xA0 ? CHAR_TABLE_DEFAULT_SLOT_8_BIT_CONTROL + : CHAR_TABLE_DEFAULT_SLOT_8_BIT_GRAPHIC); + val = XCHAR_TABLE (array)->contents[default_slot]; + } + if (NILP (val)) val = XCHAR_TABLE (array)->defalt; while (NILP (val)) /* Follow parents until we find some value. */ { @@ -1999,6 +2009,7 @@ or a byte-code object. IDX starts at 0. */) { int code[4], i; Lisp_Object sub_table; + Lisp_Object current_default; SPLIT_CHAR (idxval, code[0], code[1], code[2]); if (code[1] < 32) code[1] = -1; @@ -2012,16 +2023,21 @@ or a byte-code object. IDX starts at 0. */) code[3] = -1; /* anchor */ try_parent_char_table: + current_default = XCHAR_TABLE (array)->defalt; sub_table = array; for (i = 0; code[i] >= 0; i++) { val = XCHAR_TABLE (sub_table)->contents[code[i]]; if (SUB_CHAR_TABLE_P (val)) - sub_table = val; + { + sub_table = val; + if (! NILP (XCHAR_TABLE (sub_table)->defalt)) + current_default = XCHAR_TABLE (sub_table)->defalt; + } else { if (NILP (val)) - val = XCHAR_TABLE (sub_table)->defalt; + val = current_default; if (NILP (val)) { array = XCHAR_TABLE (array)->parent; @@ -2031,9 +2047,12 @@ or a byte-code object. IDX starts at 0. */) return val; } } - /* Here, VAL is a sub char table. We try the default value - and parent. */ - val = XCHAR_TABLE (val)->defalt; + /* Reaching here means IDXVAL is a generic character in + which each character or a group has independent value. + Essentially it's nonsense to get a value for such a + generic character, but for backward compatibility, we try + the default value and parent. */ + val = current_default; if (NILP (val)) { array = XCHAR_TABLE (array)->parent; @@ -2102,7 +2121,11 @@ bool-vector. IDX starts at 0. */) if (idxval < 0) args_out_of_range (array, idx); if (idxval < CHAR_TABLE_ORDINARY_SLOTS) - XCHAR_TABLE (array)->contents[idxval] = newelt; + { + if (! SINGLE_BYTE_CHAR_P (idxval)) + args_out_of_range (array, idx); + XCHAR_TABLE (array)->contents[idxval] = newelt; + } else { int code[4], i; @@ -2125,12 +2148,9 @@ bool-vector. IDX starts at 0. */) Lisp_Object temp; /* VAL is a leaf. Create a sub char table with the - default value VAL or XCHAR_TABLE (array)->defalt - and look into it. */ + initial value VAL and look into it. */ - temp = make_sub_char_table (NILP (val) - ? XCHAR_TABLE (array)->defalt - : val); + temp = make_sub_char_table (val); XCHAR_TABLE (array)->contents[code[i]] = temp; array = temp; } diff --git a/src/dired.c b/src/dired.c index 62bf4beb38..87b48ba2d7 100644 --- a/src/dired.c +++ b/src/dired.c @@ -26,10 +26,10 @@ Boston, MA 02111-1307, USA. */ #include <sys/types.h> #include <sys/stat.h> -#ifdef VMS -#include "vms-pwd.h" -#else +#ifdef HAVE_PWD_H #include <pwd.h> +#endif +#ifndef VMS #include <grp.h> #endif diff --git a/src/editfns.c b/src/editfns.c index f77b9cafc8..ddf080a035 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -24,9 +24,7 @@ Boston, MA 02111-1307, USA. */ #include <sys/types.h> #include <stdio.h> -#ifdef VMS -#include "vms-pwd.h" -#else +#ifdef HAVE_PWD_H #include <pwd.h> #endif diff --git a/src/emacs.c b/src/emacs.c index c368c57a11..1a6f323ed0 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1318,6 +1318,7 @@ main (argc, argv syms_of_fontset (); syms_of_macterm (); syms_of_macmenu (); + syms_of_macselect (); syms_of_data (); syms_of_search (); syms_of_frame (); @@ -1632,6 +1633,7 @@ main (argc, argv syms_of_macterm (); syms_of_macfns (); syms_of_macmenu (); + syms_of_macselect (); syms_of_fontset (); #endif /* MAC_OSX && HAVE_CARBON */ diff --git a/src/fileio.c b/src/fileio.c index e1da0fc691..340a8a36cf 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -45,9 +45,7 @@ Boston, MA 02111-1307, USA. */ # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG) #endif -#ifdef VMS -#include "vms-pwd.h" -#else +#ifdef HAVE_PWD_H #include <pwd.h> #endif @@ -2392,7 +2390,7 @@ barf_or_query_if_file_exists (absname, querystring, interactive, statptr, quick) return; } -DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 4, +DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 5, "fCopy file: \nGCopy %s to file: \np\nP", doc: /* Copy FILE to NEWNAME. Both args must be strings. If NEWNAME names a directory, copy FILE there. @@ -2401,11 +2399,20 @@ unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil. A number as third arg means request confirmation if NEWNAME already exists. This is what happens in interactive use with M-x. Always sets the file modes of the output file to match the input file. + Fourth arg KEEP-TIME non-nil means give the output file the same last-modified time as the old one. (This works on only some systems.) -A prefix arg makes KEEP-TIME non-nil. */) - (file, newname, ok_if_already_exists, keep_time) - Lisp_Object file, newname, ok_if_already_exists, keep_time; + +A prefix arg makes KEEP-TIME non-nil. + +The optional fifth arg MUSTBENEW, if non-nil, insists on a check +for an existing file with the same name. If MUSTBENEW is `excl', +that means to get an error if the file already exists; never overwrite. +If MUSTBENEW is neither nil nor `excl', that means ask for +confirmation before overwriting, but do go ahead and overwrite the file +if the user confirms. */) + (file, newname, ok_if_already_exists, keep_time, mustbenew) + Lisp_Object file, newname, ok_if_already_exists, keep_time, mustbenew; { int ifd, ofd, n; char buf[16 * 1024]; @@ -2421,6 +2428,9 @@ A prefix arg makes KEEP-TIME non-nil. */) CHECK_STRING (file); CHECK_STRING (newname); + if (!NILP (mustbenew) && !EQ (mustbenew, Qexcl)) + barf_or_query_if_file_exists (newname, "overwrite", 1, 0, 1); + if (!NILP (Ffile_directory_p (newname))) newname = Fexpand_file_name (Ffile_name_nondirectory (file), newname); else @@ -2521,9 +2531,15 @@ A prefix arg makes KEEP-TIME non-nil. */) #else #ifdef MSDOS /* System's default file type was set to binary by _fmode in emacs.c. */ - ofd = creat (SDATA (encoded_newname), S_IREAD | S_IWRITE); -#else /* not MSDOS */ - ofd = creat (SDATA (encoded_newname), 0666); + ofd = emacs_open (SDATA (encoded_newname), + O_WRONLY | O_TRUNC | O_CREAT + | (EQ (mustbenew, Qexcl) ? O_EXCL : 0), + S_IREAD | S_IWRITE); +#else /* not MSDOS */ + ofd = emacs_open (SDATA (encoded_newname), + O_WRONLY | O_TRUNC | O_CREAT + | (EQ (mustbenew, Qexcl) ? O_EXCL : 0), + 0666); #endif /* not MSDOS */ #endif /* VMS */ if (ofd < 0) @@ -2753,7 +2769,8 @@ This is what happens in interactive use with M-x. */) Fcopy_file (file, newname, /* We have already prompted if it was an integer, so don't have copy-file prompt again. */ - NILP (ok_if_already_exists) ? Qnil : Qt, Qt); + NILP (ok_if_already_exists) ? Qnil : Qt, + Qt, Qnil); Fdelete_file (file); } else diff --git a/src/filelock.c b/src/filelock.c index 84540f7933..5ddec8616f 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -26,11 +26,9 @@ Boston, MA 02111-1307, USA. */ #include <signal.h> #include <stdio.h> -#ifdef VMS -#include "vms-pwd.h" -#else +#ifdef HAVE_PWD_H #include <pwd.h> -#endif /* not VMS */ +#endif #include <sys/file.h> #ifdef HAVE_FCNTL_H @@ -186,8 +186,7 @@ To get the number of bytes, use `string-bytes'. */) return val; } -/* This does not check for quits. That is safe - since it must terminate. */ +/* This does not check for quits. That is safe since it must terminate. */ DEFUN ("safe-length", Fsafe_length, Ssafe_length, 1, 1, 0, doc: /* Return the length of a list, but avoid error or infinite loop. @@ -463,9 +462,10 @@ static Lisp_Object copy_sub_char_table (arg) Lisp_Object arg; { - Lisp_Object copy = make_sub_char_table (XCHAR_TABLE (arg)->defalt); + Lisp_Object copy = make_sub_char_table (Qnil); int i; + XCHAR_TABLE (copy)->defalt = XCHAR_TABLE (arg)->defalt; /* Copy all the contents. */ bcopy (XCHAR_TABLE (arg)->contents, XCHAR_TABLE (copy)->contents, SUB_CHAR_TABLE_ORDINARY_SLOTS * sizeof (Lisp_Object)); @@ -1981,6 +1981,7 @@ merge (org_l1, org_l2, pred) } +#if 0 /* Unsafe version. */ DEFUN ("plist-get", Fplist_get, Splist_get, 2, 2, 0, doc: /* Extract a value from a property list. PLIST is a property list, which is a list of the form @@ -2011,14 +2012,16 @@ one of the properties on the list. */) return Qnil; } +#endif + +/* This does not check for quits. That is safe since it must terminate. */ -DEFUN ("safe-plist-get", Fsafe_plist_get, Ssafe_plist_get, 2, 2, 0, +DEFUN ("plist-get", Fplist_get, Splist_get, 2, 2, 0, doc: /* Extract a value from a property list. PLIST is a property list, which is a list of the form \(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value -corresponding to the given PROP, or nil if PROP is not -one of the properties on the list. -This function never signals an error. */) +corresponding to the given PROP, or nil if PROP is not one of the +properties on the list. This function never signals an error. */) (plist, prop) Lisp_Object plist; Lisp_Object prop; @@ -2051,18 +2054,6 @@ This is the last value stored with `(put SYMBOL PROPNAME VALUE)'. */) return Fplist_get (XSYMBOL (symbol)->plist, propname); } -DEFUN ("safe-get", Fsafe_get, Ssafe_get, 2, 2, 0, - doc: /* Return the value of SYMBOL's PROPNAME property. -This is the last value stored with `(put SYMBOL PROPNAME VALUE)'. -This function never signals an error. */) - (symbol, propname) - Lisp_Object symbol, propname; -{ - if (!SYMBOLP (symbol)) - return Qnil; - return Fsafe_plist_get (XSYMBOL (symbol)->plist, propname); -} - DEFUN ("plist-put", Fplist_put, Splist_put, 3, 3, 0, doc: /* Change value in PLIST of PROP to VAL. PLIST is a property list, which is a list of the form @@ -2578,7 +2569,14 @@ character set, or a character code. Return VALUE. */) if (EQ (range, Qt)) for (i = 0; i < CHAR_TABLE_ORDINARY_SLOTS; i++) - XCHAR_TABLE (char_table)->contents[i] = value; + { + /* Don't set these special slots used for default values of + ascii, eight-bit-control, and eight-bit-graphic. */ + if (i != CHAR_TABLE_DEFAULT_SLOT_ASCII + && i != CHAR_TABLE_DEFAULT_SLOT_8_BIT_CONTROL + && i != CHAR_TABLE_DEFAULT_SLOT_8_BIT_GRAPHIC) + XCHAR_TABLE (char_table)->contents[i] = value; + } else if (EQ (range, Qnil)) XCHAR_TABLE (char_table)->defalt = value; else if (SYMBOLP (range)) @@ -2609,19 +2607,12 @@ character set, or a character code. Return VALUE. */) Faset (char_table, range, value); else if (VECTORP (range)) { - if (XVECTOR (range)->size == 1) - return Faset (char_table, - make_number (XINT (XVECTOR (range)->contents[0]) + 128), - value); - else - { - int size = XVECTOR (range)->size; - Lisp_Object *val = XVECTOR (range)->contents; - Lisp_Object ch = Fmake_char_internal (size <= 0 ? Qnil : val[0], - size <= 1 ? Qnil : val[1], - size <= 2 ? Qnil : val[2]); - return Faset (char_table, ch, value); - } + int size = XVECTOR (range)->size; + Lisp_Object *val = XVECTOR (range)->contents; + Lisp_Object ch = Fmake_char_internal (size <= 0 ? Qnil : val[0], + size <= 1 ? Qnil : val[1], + size <= 2 ? Qnil : val[2]); + Faset (char_table, ch, value); } else error ("Invalid RANGE argument to `set-char-table-range'"); @@ -2633,6 +2624,8 @@ DEFUN ("set-char-table-default", Fset_char_table_default, Sset_char_table_default, 3, 3, 0, doc: /* Set the default value in CHAR-TABLE for generic character CH to VALUE. The generic character specifies the group of characters. +If CH is a normal character, set the default value for a group of +characters to which CH belongs. See also the documentation of `make-char'. */) (char_table, ch, value) Lisp_Object char_table, ch, value; @@ -2652,27 +2645,34 @@ See also the documentation of `make-char'. */) if (! CHARSET_VALID_P (charset)) invalid_character (c); - if (charset == CHARSET_ASCII) - return (XCHAR_TABLE (char_table)->defalt = value); + if (SINGLE_BYTE_CHAR_P (c)) + { + /* We use special slots for the default values of single byte + characters. */ + int default_slot + = (c < 0x80 ? CHAR_TABLE_DEFAULT_SLOT_ASCII + : c < 0xA0 ? CHAR_TABLE_DEFAULT_SLOT_8_BIT_CONTROL + : CHAR_TABLE_DEFAULT_SLOT_8_BIT_GRAPHIC); + + return (XCHAR_TABLE (char_table)->contents[default_slot] = value); + } /* Even if C is not a generic char, we had better behave as if a generic char is specified. */ if (!CHARSET_DEFINED_P (charset) || CHARSET_DIMENSION (charset) == 1) code1 = 0; temp = XCHAR_TABLE (char_table)->contents[charset + 128]; + if (! SUB_CHAR_TABLE_P (temp)) + { + temp = make_sub_char_table (temp); + XCHAR_TABLE (char_table)->contents[charset + 128] = temp; + } if (!code1) { - if (SUB_CHAR_TABLE_P (temp)) - XCHAR_TABLE (temp)->defalt = value; - else - XCHAR_TABLE (char_table)->contents[charset + 128] = value; + XCHAR_TABLE (temp)->defalt = value; return value; } - if (SUB_CHAR_TABLE_P (temp)) - char_table = temp; - else - char_table = (XCHAR_TABLE (char_table)->contents[charset + 128] - = make_sub_char_table (temp)); + char_table = temp; temp = XCHAR_TABLE (char_table)->contents[code1]; if (SUB_CHAR_TABLE_P (temp)) XCHAR_TABLE (temp)->defalt = value; @@ -5802,9 +5802,7 @@ used if both `use-dialog-box' and this variable are non-nil. */); defsubr (&Sreverse); defsubr (&Ssort); defsubr (&Splist_get); - defsubr (&Ssafe_plist_get); defsubr (&Sget); - defsubr (&Ssafe_get); defsubr (&Splist_put); defsubr (&Sput); defsubr (&Slax_plist_get); diff --git a/src/fontset.c b/src/fontset.c index c427b22e37..ee6ef213af 100644 --- a/src/fontset.c +++ b/src/fontset.c @@ -354,7 +354,11 @@ fontset_set (fontset, c, newelt) for (i = 0; code[i] > 0; i++) { if (!SUB_CHAR_TABLE_P (*elt)) - *elt = make_sub_char_table (*elt); + { + Lisp_Object val = *elt; + *elt = make_sub_char_table (val); + XCHAR_TABLE (*elt)->defalt = val; + } elt = &XCHAR_TABLE (*elt)->contents[code[i]]; } if (SUB_CHAR_TABLE_P (*elt)) diff --git a/src/frame.c b/src/frame.c index 40be721078..d0d4b3491e 100644 --- a/src/frame.c +++ b/src/frame.c @@ -1473,6 +1473,10 @@ The functions are run with one arg, the frame to be deleted. */) if (FRAME_X_P (f)) x_clear_frame_selections (f); #endif +#ifdef MAC_OS + if (FRAME_MAC_P (f)) + x_clear_frame_selections (f); +#endif /* Free glyphs. This function must be called before the window tree of the diff --git a/src/indent.c b/src/indent.c index 39602c60d1..d6709d56ee 100644 --- a/src/indent.c +++ b/src/indent.c @@ -67,6 +67,8 @@ static double position_indentation P_ ((int)); int current_column_bol_cache; +extern Lisp_Object Qfontification_functions; + /* Get the display table to use for the current buffer. */ struct Lisp_Char_Table * @@ -2049,6 +2051,7 @@ whether or not it is currently displayed in some window. */) struct window *w; Lisp_Object old_buffer; struct gcpro gcpro1; + int count = SPECPDL_INDEX (); CHECK_NUMBER (lines); if (! NILP (window)) @@ -2066,6 +2069,9 @@ whether or not it is currently displayed in some window. */) XSETBUFFER (w->buffer, current_buffer); } + /* Don't fontify text that we just move across. */ + specbind (Qfontification_functions, Qnil); + if (noninteractive) { struct position pos; @@ -2111,6 +2117,7 @@ whether or not it is currently displayed in some window. */) if (BUFFERP (old_buffer)) w->buffer = old_buffer; + unbind_to (count, Qnil); RETURN_UNGCPRO (make_number (it.vpos)); } diff --git a/src/lisp.h b/src/lisp.h index c3ae08b8d7..58923377f2 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -720,6 +720,14 @@ struct Lisp_Vector indexed by (charset-id + 128). */ #define CHAR_TABLE_ORDINARY_SLOTS 384 +/* These are the slot of the default values for single byte + characters. As 0x9A is never be a charset-id, it is safe to use + that slot for ASCII. 0x9E and 0x80 are charset-ids of + eight-bit-control and eight-bit-graphic respectively. */ +#define CHAR_TABLE_DEFAULT_SLOT_ASCII (0x9A + 128) +#define CHAR_TABLE_DEFAULT_SLOT_8_BIT_CONTROL (0x9E + 128) +#define CHAR_TABLE_DEFAULT_SLOT_8_BIT_GRAPHIC (0x80 + 128) + /* This is the number of slots that apply to characters of ASCII and 8-bit Europeans only. */ #define CHAR_TABLE_SINGLE_BYTE_SLOTS 256 @@ -2322,7 +2330,6 @@ EXFUN (Fsort, 2); EXFUN (Freverse, 1); EXFUN (Fnreverse, 1); EXFUN (Fget, 2); -EXFUN (Fsafe_get, 2); EXFUN (Fput, 3); EXFUN (Fequal, 2); EXFUN (Ffillarray, 2); @@ -2345,7 +2352,6 @@ extern Lisp_Object string_to_multibyte P_ ((Lisp_Object)); extern Lisp_Object string_make_unibyte P_ ((Lisp_Object)); EXFUN (Fcopy_alist, 1); EXFUN (Fplist_get, 2); -EXFUN (Fsafe_plist_get, 2); EXFUN (Fplist_put, 3); EXFUN (Fplist_member, 2); EXFUN (Fset_char_table_parent, 2); diff --git a/src/m/macppc.h b/src/m/macppc.h index 21ba90ad10..c068fca32a 100644 --- a/src/m/macppc.h +++ b/src/m/macppc.h @@ -86,11 +86,16 @@ Boston, MA 02111-1307, USA. */ #ifdef LINUX #define LINKER $(CC) -nostdlib -#define LD_SWITCH_MACHINE -Xlinker -m -Xlinker elf32ppc /* s/gnu-linux.h defines this to `-z nocombreloc' which does not work here because prefix-args is not used. */ #undef LD_SWITCH_SYSTEM_TEMACS #define LD_SWITCH_MACHINE_TEMACS -Xlinker -znocombreloc +#ifdef _ARCH_PPC64 +#undef START_FILES +#define START_FILES pre-crt0.o /usr/lib64/crt1.o /usr/lib64/crti.o +#undef LIB_STANDARD +#define LIB_STANDARD -lgcc -lc -lgcc /usr/lib64/crtn.o +#endif #endif #if 0 /* This breaks things on PPC GNU/Linux ecept for Yellowdog, @@ -105,5 +110,11 @@ Boston, MA 02111-1307, USA. */ #endif #endif /* 0 */ +#ifdef _ARCH_PPC64 +#ifndef _LP64 +#define _LP64 +#endif +#endif + /* arch-tag: 41913e4e-e7d1-4023-aadb-210cc31712ed (do not change this comment) */ @@ -31,12 +31,13 @@ Boston, MA 02111-1307, USA. */ #include "sysselect.h" #include "systime.h" #include "blockinput.h" -#include "charset.h" -#include "coding.h" #include "macterm.h" -#ifndef HAVE_CARBON +#if TARGET_API_MAC_CARBON +#include "charset.h" +#include "coding.h" +#else /* not TARGET_API_MAC_CARBON */ #include <Files.h> #include <MacTypes.h> #include <TextUtils.h> @@ -52,7 +53,7 @@ Boston, MA 02111-1307, USA. */ #include <Processes.h> #include <EPPC.h> #include <MacLocales.h> -#endif /* not HAVE_CARBON */ +#endif /* not TARGET_API_MAC_CARBON */ #include <utime.h> #include <dirent.h> @@ -68,8 +69,6 @@ Boston, MA 02111-1307, USA. */ #include <unistd.h> #endif -Lisp_Object QCLIPBOARD; - /* The system script code. */ static int mac_system_script_code; @@ -331,7 +330,7 @@ cfdata_to_lisp (data) { CFIndex len = CFDataGetLength (data); Lisp_Object result = make_uninit_string (len); - + CFDataGetBytes (data, CFRangeMake (0, len), SDATA (result)); return result; @@ -894,7 +893,7 @@ xrm_q_put_resource (database, quarks, value) if (i < 0) { max_nid++; - XSETINT (node_id, max_nid); + XSETINT (node_id, max_nid); hash_put (h, key, node_id, hash_code); } else @@ -3515,169 +3514,9 @@ DEFUN ("posix-file-name-to-mac", Fposix_file_name_to_mac, } -/* set interprogram-paste-function to mac-paste-function in mac-win.el - to enable Emacs to obtain the contents of the Mac clipboard. */ -DEFUN ("mac-paste-function", Fmac_paste_function, Smac_paste_function, 0, 0, 0, - doc: /* Return the contents of the Mac clipboard as a string. */) - () -{ -#if TARGET_API_MAC_CARBON - OSStatus err; - ScrapRef scrap; - ScrapFlavorFlags sff; - Size s; - int i; - char *data; - - BLOCK_INPUT; - err = GetCurrentScrap (&scrap); - if (err == noErr) - err = GetScrapFlavorFlags (scrap, kScrapFlavorTypeText, &sff); - if (err == noErr) - err = GetScrapFlavorSize (scrap, kScrapFlavorTypeText, &s); - if (err == noErr && (data = (char*) alloca (s))) - err = GetScrapFlavorData (scrap, kScrapFlavorTypeText, &s, data); - UNBLOCK_INPUT; - if (err != noErr || s == 0) - return Qnil; - - /* Emacs expects clipboard contents have Unix-style eol's */ - for (i = 0; i < s; i++) - if (data[i] == '\r') - data[i] = '\n'; - - return make_string (data, s); -#else /* not TARGET_API_MAC_CARBON */ - Lisp_Object value; - Handle my_handle; - long scrap_offset, rc, i; - - my_handle = NewHandle (0); /* allocate 0-length data area */ - - rc = GetScrap (my_handle, 'TEXT', &scrap_offset); - if (rc < 0) - return Qnil; - - HLock (my_handle); - - /* Emacs expects clipboard contents have Unix-style eol's */ - for (i = 0; i < rc; i++) - if ((*my_handle)[i] == '\r') - (*my_handle)[i] = '\n'; - - value = make_string (*my_handle, rc); - - HUnlock (my_handle); - - DisposeHandle (my_handle); - - return value; -#endif /* not TARGET_API_MAC_CARBON */ -} - - -/* set interprogram-cut-function to mac-cut-function in mac-win.el - to enable Emacs to write the top of the kill-ring to the Mac clipboard. */ -DEFUN ("mac-cut-function", Fmac_cut_function, Smac_cut_function, 1, 2, 0, - doc: /* Put the value of the string parameter to the Mac clipboard. */) - (value, push) - Lisp_Object value, push; -{ - char *buf; - int len, i; - - /* fixme: ignore the push flag for now */ - - CHECK_STRING (value); - - len = SCHARS (value); - buf = (char *) alloca (len+1); - bcopy (SDATA (value), buf, len); - buf[len] = '\0'; - - /* convert to Mac-style eol's before sending to clipboard */ - for (i = 0; i < len; i++) - if (buf[i] == '\n') - buf[i] = '\r'; - -#if TARGET_API_MAC_CARBON - { - ScrapRef scrap; - - BLOCK_INPUT; - ClearCurrentScrap (); - if (GetCurrentScrap (&scrap) != noErr) - { - UNBLOCK_INPUT; - error ("cannot get current scrap"); - } - - if (PutScrapFlavor (scrap, kScrapFlavorTypeText, kScrapFlavorMaskNone, len, - buf) != noErr) - { - UNBLOCK_INPUT; - error ("cannot put to scrap"); - } - UNBLOCK_INPUT; - } -#else /* not TARGET_API_MAC_CARBON */ - ZeroScrap (); - PutScrap (len, 'TEXT', buf); -#endif /* not TARGET_API_MAC_CARBON */ - - return Qnil; -} - - -DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p, - 0, 1, 0, - doc: /* Whether there is an owner for the given X Selection. -The arg should be the name of the selection in question, typically one of -the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'. -\(Those are literal upper-case symbol names, since that's what X expects.) -For convenience, the symbol nil is the same as `PRIMARY', -and t is the same as `SECONDARY'. */) - (selection) - Lisp_Object selection; -{ - CHECK_SYMBOL (selection); - - /* Return nil for PRIMARY and SECONDARY selections; for CLIPBOARD, check - if the clipboard currently has valid text format contents. */ - - if (EQ (selection, QCLIPBOARD)) - { - Lisp_Object val = Qnil; - -#if TARGET_API_MAC_CARBON - ScrapRef scrap; - ScrapFlavorFlags sff; - - BLOCK_INPUT; - if (GetCurrentScrap (&scrap) == noErr) - if (GetScrapFlavorFlags (scrap, kScrapFlavorTypeText, &sff) == noErr) - val = Qt; - UNBLOCK_INPUT; -#else /* not TARGET_API_MAC_CARBON */ - Handle my_handle; - long rc, scrap_offset; - - my_handle = NewHandle (0); - - rc = GetScrap (my_handle, 'TEXT', &scrap_offset); - if (rc >= 0) - val = Qt; - - DisposeHandle (my_handle); -#endif /* not TARGET_API_MAC_CARBON */ - - return val; - } - return Qnil; -} - #if TARGET_API_MAC_CARBON -static Lisp_Object Qxml; +static Lisp_Object Qxml, Qmime_charset; +static Lisp_Object QNFD, QNFKD, QNFC, QNFKC, QHFS_plus_D, QHFS_plus_C; DEFUN ("mac-get-preference", Fmac_get_preference, Smac_get_preference, 1, 4, 0, doc: /* Return the application preference value for KEY. @@ -3792,6 +3631,218 @@ otherwise. */) return result; } + + +static CFStringEncoding +get_cfstring_encoding_from_lisp (obj) + Lisp_Object obj; +{ + CFStringRef iana_name; + CFStringEncoding encoding = kCFStringEncodingInvalidId; + + if (INTEGERP (obj)) + return XINT (obj); + + if (SYMBOLP (obj) && !NILP (obj) && !NILP (Fcoding_system_p (obj))) + { + Lisp_Object coding_spec, plist; + + coding_spec = Fget (obj, Qcoding_system); + plist = XVECTOR (coding_spec)->contents[3]; + obj = Fplist_get (XVECTOR (coding_spec)->contents[3], Qmime_charset); + } + + if (SYMBOLP (obj)) + obj = SYMBOL_NAME (obj); + + if (STRINGP (obj)) + { + iana_name = cfstring_create_with_string (obj); + if (iana_name) + { + encoding = CFStringConvertIANACharSetNameToEncoding (iana_name); + CFRelease (iana_name); + } + } + + return encoding; +} + +#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020 +static CFStringRef +cfstring_create_normalized (str, symbol) + CFStringRef str; + Lisp_Object symbol; +{ + int form = -1; + TextEncodingVariant variant; + float initial_mag = 0.0; + CFStringRef result = NULL; + + if (EQ (symbol, QNFD)) + form = kCFStringNormalizationFormD; + else if (EQ (symbol, QNFKD)) + form = kCFStringNormalizationFormKD; + else if (EQ (symbol, QNFC)) + form = kCFStringNormalizationFormC; + else if (EQ (symbol, QNFKC)) + form = kCFStringNormalizationFormKC; + else if (EQ (symbol, QHFS_plus_D)) + { + variant = kUnicodeHFSPlusDecompVariant; + initial_mag = 1.5; + } + else if (EQ (symbol, QHFS_plus_C)) + { + variant = kUnicodeHFSPlusCompVariant; + initial_mag = 1.0; + } + + if (form >= 0) + { + CFMutableStringRef mut_str = CFStringCreateMutableCopy (NULL, 0, str); + + if (mut_str) + { + CFStringNormalize (mut_str, form); + result = mut_str; + } + } + else if (initial_mag > 0.0) + { + UnicodeToTextInfo uni = NULL; + UnicodeMapping map; + CFIndex length; + UniChar *in_text, *buffer = NULL, *out_buf = NULL; + OSErr err = noErr; + ByteCount out_read, out_size, out_len; + + map.unicodeEncoding = CreateTextEncoding (kTextEncodingUnicodeDefault, + kUnicodeNoSubset, + kTextEncodingDefaultFormat); + map.otherEncoding = CreateTextEncoding (kTextEncodingUnicodeDefault, + variant, + kTextEncodingDefaultFormat); + map.mappingVersion = kUnicodeUseLatestMapping; + + length = CFStringGetLength (str); + out_size = (int)((float)length * initial_mag) * sizeof (UniChar); + if (out_size < 32) + out_size = 32; + + in_text = (UniChar *)CFStringGetCharactersPtr (str); + if (in_text == NULL) + { + buffer = xmalloc (sizeof (UniChar) * length); + if (buffer) + { + CFStringGetCharacters (str, CFRangeMake (0, length), buffer); + in_text = buffer; + } + } + + if (in_text) + err = CreateUnicodeToTextInfo(&map, &uni); + while (err == noErr) + { + out_buf = xmalloc (out_size); + if (out_buf == NULL) + err = mFulErr; + else + err = ConvertFromUnicodeToText (uni, length * sizeof (UniChar), + in_text, + kUnicodeDefaultDirectionMask, + 0, NULL, NULL, NULL, + out_size, &out_read, &out_len, + out_buf); + if (err == noErr && out_read < length * sizeof (UniChar)) + { + xfree (out_buf); + out_size += length; + } + else + break; + } + if (err == noErr) + result = CFStringCreateWithCharacters (NULL, out_buf, + out_len / sizeof (UniChar)); + if (uni) + DisposeUnicodeToTextInfo (&uni); + if (out_buf) + xfree (out_buf); + if (buffer) + xfree (buffer); + } + else + { + result = str; + CFRetain (result); + } + + return result; +} +#endif + +DEFUN ("mac-code-convert-string", Fmac_code_convert_string, Smac_code_convert_string, 3, 4, 0, + doc: /* Convert STRING from SOURCE encoding to TARGET encoding. +The conversion is performed using the converter provided by the system. +Each encoding is specified by either a coding system symbol, a mime +charset string, or an integer as a CFStringEncoding value. +On Mac OS X 10.2 and later, you can do Unicode Normalization by +specifying the optional argument NORMALIZATION-FORM with a symbol NFD, +NFKD, NFC, NFKC, HFS+D, or HFS+C. +On successful conversion, returns the result string, else returns +nil. */) + (string, source, target, normalization_form) + Lisp_Object string, source, target, normalization_form; +{ + Lisp_Object result = Qnil; + CFStringEncoding src_encoding, tgt_encoding; + CFStringRef str = NULL; + CFDataRef data = NULL; + + CHECK_STRING (string); + if (!INTEGERP (source) && !STRINGP (source)) + CHECK_SYMBOL (source); + if (!INTEGERP (target) && !STRINGP (target)) + CHECK_SYMBOL (target); + CHECK_SYMBOL (normalization_form); + + BLOCK_INPUT; + + src_encoding = get_cfstring_encoding_from_lisp (source); + tgt_encoding = get_cfstring_encoding_from_lisp (target); + + string = string_make_unibyte (string); + if (src_encoding != kCFStringEncodingInvalidId + && tgt_encoding != kCFStringEncodingInvalidId) + str = CFStringCreateWithBytes (NULL, SDATA (string), SBYTES (string), + src_encoding, true); +#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020 + if (str) + { + CFStringRef saved_str = str; + + str = cfstring_create_normalized (saved_str, normalization_form); + CFRelease (saved_str); + } +#endif + if (str) + { + data = CFStringCreateExternalRepresentation (NULL, str, + tgt_encoding, '\0'); + CFRelease (str); + } + if (data) + { + result = cfdata_to_lisp (data); + CFRelease (data); + } + + UNBLOCK_INPUT; + + return result; +} #endif /* TARGET_API_MAC_CARBON */ @@ -4232,9 +4283,6 @@ mac_get_system_locale () void syms_of_mac () { - QCLIPBOARD = intern ("CLIPBOARD"); - staticpro (&QCLIPBOARD); - #if TARGET_API_MAC_CARBON Qstring = intern ("string"); staticpro (&Qstring); Qnumber = intern ("number"); staticpro (&Qnumber); @@ -4246,13 +4294,21 @@ syms_of_mac () Qxml = intern ("xml"); staticpro (&Qxml); + + Qmime_charset = intern ("mime-charset"); + staticpro (&Qmime_charset); + + QNFD = intern ("NFD"); staticpro (&QNFD); + QNFKD = intern ("NFKD"); staticpro (&QNFKD); + QNFC = intern ("NFC"); staticpro (&QNFC); + QNFKC = intern ("NFKC"); staticpro (&QNFKC); + QHFS_plus_D = intern ("HFS+D"); staticpro (&QHFS_plus_D); + QHFS_plus_C = intern ("HFS+C"); staticpro (&QHFS_plus_C); #endif - defsubr (&Smac_paste_function); - defsubr (&Smac_cut_function); - defsubr (&Sx_selection_exists_p); #if TARGET_API_MAC_CARBON defsubr (&Smac_get_preference); + defsubr (&Smac_code_convert_string); #endif defsubr (&Smac_clear_font_name_table); diff --git a/src/macselect.c b/src/macselect.c new file mode 100644 index 0000000000..49246f7edd --- /dev/null +++ b/src/macselect.c @@ -0,0 +1,1121 @@ +/* Selection processing for Emacs on Mac OS. + Copyright (C) 2005 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include <config.h> + +#include "lisp.h" +#include "macterm.h" +#include "blockinput.h" + +#if !TARGET_API_MAC_CARBON +#include <Endian.h> +typedef int ScrapRef; +typedef ResType ScrapFlavorType; +#endif /* !TARGET_API_MAC_CARBON */ + +static OSErr get_scrap_from_symbol P_ ((Lisp_Object, int, ScrapRef *)); +static ScrapFlavorType get_flavor_type_from_symbol P_ ((Lisp_Object)); +static int valid_scrap_target_type_p P_ ((Lisp_Object)); +static OSErr clear_scrap P_ ((ScrapRef *)); +static OSErr put_scrap_string P_ ((ScrapRef, Lisp_Object, Lisp_Object)); +static OSErr put_scrap_private_timestamp P_ ((ScrapRef, unsigned long)); +static ScrapFlavorType scrap_has_target_type P_ ((ScrapRef, Lisp_Object)); +static Lisp_Object get_scrap_string P_ ((ScrapRef, Lisp_Object)); +static OSErr get_scrap_private_timestamp P_ ((ScrapRef, unsigned long *)); +static Lisp_Object get_scrap_target_type_list P_ ((ScrapRef)); +static void x_own_selection P_ ((Lisp_Object, Lisp_Object)); +static Lisp_Object x_get_local_selection P_ ((Lisp_Object, Lisp_Object, int)); +static Lisp_Object x_get_foreign_selection P_ ((Lisp_Object, + Lisp_Object, + Lisp_Object)); +EXFUN (Fx_selection_owner_p, 1); +#ifdef MAC_OSX +static OSStatus mac_handle_service_event P_ ((EventHandlerCallRef, + EventRef, void *)); +void init_service_handler P_ ((void)); +#endif + +Lisp_Object QPRIMARY, QSECONDARY, QTIMESTAMP, QTARGETS; + +static Lisp_Object Vx_lost_selection_functions; +/* Coding system for communicating with other programs via scrap. */ +static Lisp_Object Vselection_coding_system; + +/* Coding system for the next communicating with other programs. */ +static Lisp_Object Vnext_selection_coding_system; + +static Lisp_Object Qforeign_selection; + +/* The timestamp of the last input event Emacs received from the + window server. */ +/* Defined in keyboard.c. */ +extern unsigned long last_event_timestamp; + +/* This is an association list whose elements are of the form + ( SELECTION-NAME SELECTION-VALUE SELECTION-TIMESTAMP FRAME) + SELECTION-NAME is a lisp symbol. + SELECTION-VALUE is the value that emacs owns for that selection. + It may be any kind of Lisp object. + SELECTION-TIMESTAMP is the time at which emacs began owning this selection, + as a cons of two 16-bit numbers (making a 32 bit time.) + FRAME is the frame for which we made the selection. + If there is an entry in this alist, and the data for the flavor + type SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP in the corresponding scrap + (if exists) coincides with SELECTION-TIMESTAMP, then it can be + assumed that Emacs owns that selection. + The only (eq) parts of this list that are visible from Lisp are the + selection-values. */ +static Lisp_Object Vselection_alist; + +#define SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP 'Etsp' + +/* This is an alist whose CARs are selection-types and whose CDRs are + the names of Lisp functions to call to convert the given Emacs + selection value to a string representing the given selection type. + This is for Lisp-level extension of the emacs selection + handling. */ +static Lisp_Object Vselection_converter_alist; + +/* A selection name (represented as a Lisp symbol) can be associated + with a named scrap via `mac-scrap-name' property. Likewise for a + selection type with a scrap flavor type via `mac-ostype'. */ +static Lisp_Object Qmac_scrap_name, Qmac_ostype; + +/* Selection name for communication via Services menu. */ +static Lisp_Object Vmac_services_selection; + +/* Get a reference to the scrap corresponding to the symbol SYM. The + reference is set to *SCRAP, and it becomes NULL if there's no + corresponding scrap. Clear the scrap if CLEAR_P is non-zero. */ + +static OSErr +get_scrap_from_symbol (sym, clear_p, scrap) + Lisp_Object sym; + int clear_p; + ScrapRef *scrap; +{ + OSErr err = noErr; + Lisp_Object str = Fget (sym, Qmac_scrap_name); + + if (!STRINGP (str)) + *scrap = NULL; + else + { +#if TARGET_API_MAC_CARBON +#ifdef MAC_OSX + CFStringRef scrap_name = cfstring_create_with_string (str); + OptionBits options = (clear_p ? kScrapClearNamedScrap + : kScrapGetNamedScrap); + + err = GetScrapByName (scrap_name, options, scrap); + CFRelease (scrap_name); +#else /* !MAC_OSX */ + if (clear_p) + err = ClearCurrentScrap (); + if (err == noErr) + err = GetCurrentScrap (scrap); +#endif /* !MAC_OSX */ +#else /* !TARGET_API_MAC_CARBON */ + if (clear_p) + err = ZeroScrap (); + if (err == noErr) + *scrap = 1; +#endif /* !TARGET_API_MAC_CARBON */ + } + + return err; +} + +/* Get a scrap flavor type from the symbol SYM. Return 0 if no + corresponding flavor type. */ + +static ScrapFlavorType +get_flavor_type_from_symbol (sym) + Lisp_Object sym; +{ + ScrapFlavorType val; + Lisp_Object str = Fget (sym, Qmac_ostype); + + if (STRINGP (str) && SBYTES (str) == 4) + return EndianU32_BtoN (*((UInt32 *) SDATA (str))); + + return 0; +} + +/* Check if the symbol SYM has a corresponding scrap flavor type. */ + +static int +valid_scrap_target_type_p (sym) + Lisp_Object sym; +{ + return get_flavor_type_from_symbol (sym) != 0; +} + +/* Clear the scrap whose reference is *SCRAP. */ + +static INLINE OSErr +clear_scrap (scrap) + ScrapRef *scrap; +{ +#if TARGET_API_MAC_CARBON +#ifdef MAC_OSX + return ClearScrap (scrap); +#else + return ClearCurrentScrap (); +#endif +#else /* !TARGET_API_MAC_CARBON */ + return ZeroScrap (); +#endif /* !TARGET_API_MAC_CARBON */ +} + +/* Put Lisp String STR to the scrap SCRAP. The target type is + specified by TYPE. */ + +static OSErr +put_scrap_string (scrap, type, str) + ScrapRef scrap; + Lisp_Object type, str; +{ + ScrapFlavorType flavor_type = get_flavor_type_from_symbol (type); + + if (flavor_type == 0) + return noTypeErr; + +#if TARGET_API_MAC_CARBON + return PutScrapFlavor (scrap, flavor_type, kScrapFlavorMaskNone, + SBYTES (str), SDATA (str)); +#else /* !TARGET_API_MAC_CARBON */ + return PutScrap (SBYTES (str), flavor_type, SDATA (str)); +#endif /* !TARGET_API_MAC_CARBON */ +} + +/* Put TIMESTAMP to the scrap SCRAP. The timestamp is used for + checking if the scrap is owned by the process. */ + +static INLINE OSErr +put_scrap_private_timestamp (scrap, timestamp) + ScrapRef scrap; + unsigned long timestamp; +{ +#if TARGET_API_MAC_CARBON + return PutScrapFlavor (scrap, SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP, + kScrapFlavorMaskSenderOnly, + sizeof (timestamp), ×tamp); +#else /* !TARGET_API_MAC_CARBON */ + return PutScrap (sizeof (timestamp), SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP, + ×tamp); +#endif /* !TARGET_API_MAC_CARBON */ +} + +/* Check if data for the target type TYPE is available in SCRAP. */ + +static ScrapFlavorType +scrap_has_target_type (scrap, type) + ScrapRef scrap; + Lisp_Object type; +{ + OSErr err; + ScrapFlavorType flavor_type = get_flavor_type_from_symbol (type); + + if (flavor_type) + { +#if TARGET_API_MAC_CARBON + ScrapFlavorFlags flags; + + err = GetScrapFlavorFlags (scrap, flavor_type, &flags); + if (err != noErr) + flavor_type = 0; +#else /* !TARGET_API_MAC_CARBON */ + SInt32 size, offset; + + size = GetScrap (NULL, flavor_type, &offset); + if (size < 0) + flavor_type = 0; +#endif /* !TARGET_API_MAC_CARBON */ + } + + return flavor_type; +} + +/* Get data for the target type TYPE from SCRAP and create a Lisp + string. Return nil if failed to get data. */ + +static Lisp_Object +get_scrap_string (scrap, type) + ScrapRef scrap; + Lisp_Object type; +{ + OSErr err; + Lisp_Object result = Qnil; + ScrapFlavorType flavor_type = get_flavor_type_from_symbol (type); +#if TARGET_API_MAC_CARBON + Size size; + + if (flavor_type) + { + err = GetScrapFlavorSize (scrap, flavor_type, &size); + if (err == noErr) + { + do + { + result = make_uninit_string (size); + err = GetScrapFlavorData (scrap, flavor_type, + &size, SDATA (result)); + if (err != noErr) + result = Qnil; + else if (size < SBYTES (result)) + result = make_unibyte_string (SDATA (result), size); + } + while (STRINGP (result) && size > SBYTES (result)); + } + } +#else + Handle handle; + SInt32 size, offset; + + if (flavor_type) + size = GetScrap (NULL, flavor_type, &offset); + if (size >= 0) + { + handle = NewHandle (size); + HLock (handle); + size = GetScrap (handle, flavor_type, &offset); + if (size >= 0) + result = make_unibyte_string (*handle, size); + DisposeHandle (handle); + } +#endif + + return result; +} + +/* Get timestamp from the scrap SCRAP and set to *TIMPSTAMP. */ + +static OSErr +get_scrap_private_timestamp (scrap, timestamp) + ScrapRef scrap; + unsigned long *timestamp; +{ + OSErr err = noErr; +#if TARGET_API_MAC_CARBON + ScrapFlavorFlags flags; + + err = GetScrapFlavorFlags (scrap, SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP, &flags); + if (err == noErr) + if (!(flags & kScrapFlavorMaskSenderOnly)) + err = noTypeErr; + else + { + Size size = sizeof (*timestamp); + + err = GetScrapFlavorData (scrap, SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP, + &size, timestamp); + if (err == noErr && size != sizeof (*timestamp)) + err = noTypeErr; + } +#else /* !TARGET_API_MAC_CARBON */ + Handle handle; + SInt32 size, offset; + + size = GetScrap (NULL, SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP, &offset); + if (size == sizeof (*timestamp)) + { + handle = NewHandle (size); + HLock (handle); + size = GetScrap (handle, SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP, &offset); + if (size == sizeof (*timestamp)) + *timestamp = *((unsigned long *) *handle); + DisposeHandle (handle); + } + if (size != sizeof (*timestamp)) + err = noTypeErr; +#endif /* !TARGET_API_MAC_CARBON */ + + return err; +} + +/* Get the list of target types in SCRAP. The return value is a list + of target type symbols possibly followed by scrap flavor type + strings. */ + +static Lisp_Object +get_scrap_target_type_list (scrap) + ScrapRef scrap; +{ + Lisp_Object result = Qnil, rest, target_type; +#if TARGET_API_MAC_CARBON + OSErr err; + UInt32 count, i, type; + ScrapFlavorInfo *flavor_info = NULL; + Lisp_Object strings = Qnil; + + err = GetScrapFlavorCount (scrap, &count); + if (err == noErr) + flavor_info = xmalloc (sizeof (ScrapFlavorInfo) * count); + if (err == noErr && flavor_info) + { + err = GetScrapFlavorInfoList (scrap, &count, flavor_info); + if (err != noErr) + { + xfree (flavor_info); + flavor_info = NULL; + } + } +#endif + for (rest = Vselection_converter_alist; CONSP (rest); rest = XCDR (rest)) + { + ScrapFlavorType flavor_type = 0; + + if (CONSP (XCAR (rest)) && SYMBOLP (target_type = XCAR (XCAR (rest))) + && (flavor_type = scrap_has_target_type (scrap, target_type))) + { + result = Fcons (target_type, result); +#if TARGET_API_MAC_CARBON + for (i = 0; i < count; i++) + if (flavor_info[i].flavorType == flavor_type) + { + flavor_info[i].flavorType = 0; + break; + } +#endif + } + } +#if TARGET_API_MAC_CARBON + if (flavor_info) + { + for (i = 0; i < count; i++) + if (flavor_info[i].flavorType) + { + type = EndianU32_NtoB (flavor_info[i].flavorType); + strings = Fcons (make_unibyte_string ((char *) &type, 4), strings); + } + result = nconc2 (result, strings); + xfree (flavor_info); + } +#endif + + return result; +} + +/* Do protocol to assert ourself as a selection owner. + Update the Vselection_alist so that we can reply to later requests for + our selection. */ + +static void +x_own_selection (selection_name, selection_value) + Lisp_Object selection_name, selection_value; +{ + OSErr err; + ScrapRef scrap; + struct gcpro gcpro1, gcpro2; + Lisp_Object rest, handler_fn, value, type; + int count; + + CHECK_SYMBOL (selection_name); + + GCPRO2 (selection_name, selection_value); + + BLOCK_INPUT; + + err = get_scrap_from_symbol (selection_name, 1, &scrap); + if (err == noErr && scrap) + { + /* Don't allow a quit within the converter. + When the user types C-g, he would be surprised + if by luck it came during a converter. */ + count = SPECPDL_INDEX (); + specbind (Qinhibit_quit, Qt); + + for (rest = Vselection_converter_alist; CONSP (rest); rest = XCDR (rest)) + { + if (!(CONSP (XCAR (rest)) + && SYMBOLP (type = XCAR (XCAR (rest))) + && valid_scrap_target_type_p (type) + && SYMBOLP (handler_fn = XCDR (XCAR (rest))))) + continue; + + if (!NILP (handler_fn)) + value = call3 (handler_fn, selection_name, + type, selection_value); + + if (CONSP (value) + && EQ (XCAR (value), type) + && STRINGP (XCDR (value))) + err = put_scrap_string (scrap, type, XCDR (value)); + } + + unbind_to (count, Qnil); + + if (err == noErr) + err = put_scrap_private_timestamp (scrap, last_event_timestamp); + } + + UNBLOCK_INPUT; + + UNGCPRO; + + if (scrap && err != noErr) + error ("Can't set selection"); + + /* Now update the local cache */ + { + Lisp_Object selection_time; + Lisp_Object selection_data; + Lisp_Object prev_value; + + selection_time = long_to_cons (last_event_timestamp); + selection_data = Fcons (selection_name, + Fcons (selection_value, + Fcons (selection_time, + Fcons (selected_frame, Qnil)))); + prev_value = assq_no_quit (selection_name, Vselection_alist); + + Vselection_alist = Fcons (selection_data, Vselection_alist); + + /* If we already owned the selection, remove the old selection data. + Perhaps we should destructively modify it instead. + Don't use Fdelq as that may QUIT. */ + if (!NILP (prev_value)) + { + Lisp_Object rest; /* we know it's not the CAR, so it's easy. */ + for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest)) + if (EQ (prev_value, Fcar (XCDR (rest)))) + { + XSETCDR (rest, Fcdr (XCDR (rest))); + break; + } + } + } +} + +/* Given a selection-name and desired type, look up our local copy of + the selection value and convert it to the type. + The value is nil or a string. + This function is used both for remote requests (LOCAL_REQUEST is zero) + and for local x-get-selection-internal (LOCAL_REQUEST is nonzero). + + This calls random Lisp code, and may signal or gc. */ + +static Lisp_Object +x_get_local_selection (selection_symbol, target_type, local_request) + Lisp_Object selection_symbol, target_type; + int local_request; +{ + Lisp_Object local_value; + Lisp_Object handler_fn, value, type, check; + int count; + + if (NILP (Fx_selection_owner_p (selection_symbol))) + return Qnil; + + local_value = assq_no_quit (selection_symbol, Vselection_alist); + + /* TIMESTAMP is a special case 'cause that's easiest. */ + if (EQ (target_type, QTIMESTAMP)) + { + handler_fn = Qnil; + value = XCAR (XCDR (XCDR (local_value))); + } +#if 0 + else if (EQ (target_type, QDELETE)) + { + handler_fn = Qnil; + Fx_disown_selection_internal + (selection_symbol, + XCAR (XCDR (XCDR (local_value)))); + value = QNULL; + } +#endif + else + { + /* Don't allow a quit within the converter. + When the user types C-g, he would be surprised + if by luck it came during a converter. */ + count = SPECPDL_INDEX (); + specbind (Qinhibit_quit, Qt); + + CHECK_SYMBOL (target_type); + handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist)); + /* gcpro is not needed here since nothing but HANDLER_FN + is live, and that ought to be a symbol. */ + + if (!NILP (handler_fn)) + value = call3 (handler_fn, + selection_symbol, (local_request ? Qnil : target_type), + XCAR (XCDR (local_value))); + else + value = Qnil; + unbind_to (count, Qnil); + } + + /* Make sure this value is of a type that we could transmit + to another X client. */ + + check = value; + if (CONSP (value) + && SYMBOLP (XCAR (value))) + type = XCAR (value), + check = XCDR (value); + + if (STRINGP (check) + || VECTORP (check) + || SYMBOLP (check) + || INTEGERP (check) + || NILP (value)) + return value; + /* Check for a value that cons_to_long could handle. */ + else if (CONSP (check) + && INTEGERP (XCAR (check)) + && (INTEGERP (XCDR (check)) + || + (CONSP (XCDR (check)) + && INTEGERP (XCAR (XCDR (check))) + && NILP (XCDR (XCDR (check)))))) + return value; + else + return + Fsignal (Qerror, + Fcons (build_string ("invalid data returned by selection-conversion function"), + Fcons (handler_fn, Fcons (value, Qnil)))); +} + + +/* Clear all selections that were made from frame F. + We do this when about to delete a frame. */ + +void +x_clear_frame_selections (f) + FRAME_PTR f; +{ + Lisp_Object frame; + Lisp_Object rest; + + XSETFRAME (frame, f); + + /* Otherwise, we're really honest and truly being told to drop it. + Don't use Fdelq as that may QUIT;. */ + + /* Delete elements from the beginning of Vselection_alist. */ + while (!NILP (Vselection_alist) + && EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist))))))) + { + /* Let random Lisp code notice that the selection has been stolen. */ + Lisp_Object hooks, selection_symbol; + + hooks = Vx_lost_selection_functions; + selection_symbol = Fcar (Fcar (Vselection_alist)); + + if (!EQ (hooks, Qunbound)) + { + for (; CONSP (hooks); hooks = Fcdr (hooks)) + call1 (Fcar (hooks), selection_symbol); +#if 0 /* This can crash when deleting a frame + from x_connection_closed. Anyway, it seems unnecessary; + something else should cause a redisplay. */ + redisplay_preserve_echo_area (21); +#endif + } + + Vselection_alist = Fcdr (Vselection_alist); + } + + /* Delete elements after the beginning of Vselection_alist. */ + for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest)) + if (EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCDR (rest)))))))) + { + /* Let random Lisp code notice that the selection has been stolen. */ + Lisp_Object hooks, selection_symbol; + + hooks = Vx_lost_selection_functions; + selection_symbol = Fcar (Fcar (XCDR (rest))); + + if (!EQ (hooks, Qunbound)) + { + for (; CONSP (hooks); hooks = Fcdr (hooks)) + call1 (Fcar (hooks), selection_symbol); +#if 0 /* See above */ + redisplay_preserve_echo_area (22); +#endif + } + XSETCDR (rest, Fcdr (XCDR (rest))); + break; + } +} + +/* Do protocol to read selection-data from the server. + Converts this to Lisp data and returns it. */ + +static Lisp_Object +x_get_foreign_selection (selection_symbol, target_type, time_stamp) + Lisp_Object selection_symbol, target_type, time_stamp; +{ + OSErr err; + ScrapRef scrap; + Lisp_Object result = Qnil; + + BLOCK_INPUT; + + err = get_scrap_from_symbol (selection_symbol, 0, &scrap); + if (err == noErr && scrap) + if (EQ (target_type, QTARGETS)) + { + result = get_scrap_target_type_list (scrap); + result = Fvconcat (1, &result); + } + else + { + result = get_scrap_string (scrap, target_type); + if (STRINGP (result)) + Fput_text_property (make_number (0), make_number (SBYTES (result)), + Qforeign_selection, target_type, result); + } + + UNBLOCK_INPUT; + + return result; +} + + +DEFUN ("x-own-selection-internal", Fx_own_selection_internal, + Sx_own_selection_internal, 2, 2, 0, + doc: /* Assert a selection of the given TYPE with the given VALUE. +TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'. +VALUE is typically a string, or a cons of two markers, but may be +anything that the functions on `selection-converter-alist' know about. */) + (selection_name, selection_value) + Lisp_Object selection_name, selection_value; +{ + check_mac (); + CHECK_SYMBOL (selection_name); + if (NILP (selection_value)) error ("selection-value may not be nil"); + x_own_selection (selection_name, selection_value); + return selection_value; +} + + +/* Request the selection value from the owner. If we are the owner, + simply return our selection value. If we are not the owner, this + will block until all of the data has arrived. */ + +DEFUN ("x-get-selection-internal", Fx_get_selection_internal, + Sx_get_selection_internal, 2, 3, 0, + doc: /* Return text selected from some Mac window. +SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'. +TYPE is the type of data desired, typically `STRING'. +TIME_STAMP is ignored on Mac. */) + (selection_symbol, target_type, time_stamp) + Lisp_Object selection_symbol, target_type, time_stamp; +{ + Lisp_Object val = Qnil; + struct gcpro gcpro1, gcpro2; + GCPRO2 (target_type, val); /* we store newly consed data into these */ + check_mac (); + CHECK_SYMBOL (selection_symbol); + CHECK_SYMBOL (target_type); + + val = x_get_local_selection (selection_symbol, target_type, 1); + + if (NILP (val)) + { + val = x_get_foreign_selection (selection_symbol, target_type, time_stamp); + goto DONE; + } + + if (CONSP (val) + && SYMBOLP (XCAR (val))) + { + val = XCDR (val); + if (CONSP (val) && NILP (XCDR (val))) + val = XCAR (val); + } + DONE: + UNGCPRO; + return val; +} + +DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal, + Sx_disown_selection_internal, 1, 2, 0, + doc: /* If we own the selection SELECTION, disown it. +Disowning it means there is no such selection. */) + (selection, time) + Lisp_Object selection; + Lisp_Object time; +{ + OSErr err; + ScrapRef scrap; + Lisp_Object local_selection_data; + + check_mac (); + CHECK_SYMBOL (selection); + + if (NILP (Fx_selection_owner_p (selection))) + return Qnil; /* Don't disown the selection when we're not the owner. */ + + local_selection_data = assq_no_quit (selection, Vselection_alist); + + /* Don't use Fdelq as that may QUIT;. */ + + if (EQ (local_selection_data, Fcar (Vselection_alist))) + Vselection_alist = Fcdr (Vselection_alist); + else + { + Lisp_Object rest; + for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest)) + if (EQ (local_selection_data, Fcar (XCDR (rest)))) + { + XSETCDR (rest, Fcdr (XCDR (rest))); + break; + } + } + + /* Let random lisp code notice that the selection has been stolen. */ + + { + Lisp_Object rest; + rest = Vx_lost_selection_functions; + if (!EQ (rest, Qunbound)) + { + for (; CONSP (rest); rest = Fcdr (rest)) + call1 (Fcar (rest), selection); + prepare_menu_bars (); + redisplay_preserve_echo_area (20); + } + } + + BLOCK_INPUT; + + err = get_scrap_from_symbol (selection, 0, &scrap); + if (err == noErr && scrap) + clear_scrap (&scrap); + + UNBLOCK_INPUT; + + return Qt; +} + + +DEFUN ("x-selection-owner-p", Fx_selection_owner_p, Sx_selection_owner_p, + 0, 1, 0, + doc: /* Whether the current Emacs process owns the given Selection. +The arg should be the name of the selection in question, typically one of +the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'. +For convenience, the symbol nil is the same as `PRIMARY', +and t is the same as `SECONDARY'. */) + (selection) + Lisp_Object selection; +{ + OSErr err; + ScrapRef scrap; + Lisp_Object result = Qnil, local_selection_data; + + check_mac (); + CHECK_SYMBOL (selection); + if (EQ (selection, Qnil)) selection = QPRIMARY; + if (EQ (selection, Qt)) selection = QSECONDARY; + + local_selection_data = assq_no_quit (selection, Vselection_alist); + + if (NILP (local_selection_data)) + return Qnil; + + BLOCK_INPUT; + + err = get_scrap_from_symbol (selection, 0, &scrap); + if (err == noErr && scrap) + { + unsigned long timestamp; + + err = get_scrap_private_timestamp (scrap, ×tamp); + if (err == noErr + && (timestamp + == cons_to_long (XCAR (XCDR (XCDR (local_selection_data)))))) + result = Qt; + } + else + result = Qt; + + UNBLOCK_INPUT; + + return result; +} + +DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p, + 0, 1, 0, + doc: /* Whether there is an owner for the given Selection. +The arg should be the name of the selection in question, typically one of +the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'. +For convenience, the symbol nil is the same as `PRIMARY', +and t is the same as `SECONDARY'. */) + (selection) + Lisp_Object selection; +{ + OSErr err; + ScrapRef scrap; + Lisp_Object result = Qnil, rest; + + /* It should be safe to call this before we have an Mac frame. */ + if (! FRAME_MAC_P (SELECTED_FRAME ())) + return Qnil; + + CHECK_SYMBOL (selection); + if (!NILP (Fx_selection_owner_p (selection))) + return Qt; + if (EQ (selection, Qnil)) selection = QPRIMARY; + if (EQ (selection, Qt)) selection = QSECONDARY; + + BLOCK_INPUT; + + err = get_scrap_from_symbol (selection, 0, &scrap); + if (err == noErr && scrap) + for (rest = Vselection_converter_alist; CONSP (rest); rest = XCDR (rest)) + { + if (CONSP (XCAR (rest)) && SYMBOLP (XCAR (XCAR (rest))) + && scrap_has_target_type (scrap, XCAR (XCAR (rest)))) + { + result = Qt; + break; + } + } + + UNBLOCK_INPUT; + + return result; +} + + +#ifdef MAC_OSX +void +init_service_handler () +{ + EventTypeSpec specs[] = {{kEventClassService, kEventServiceGetTypes}, + {kEventClassService, kEventServiceCopy}, + {kEventClassService, kEventServicePaste}, + {kEventClassService, kEventServicePerform}}; + InstallApplicationEventHandler (NewEventHandlerUPP (mac_handle_service_event), + GetEventTypeCount (specs), specs, NULL, NULL); +} + +extern void mac_store_services_event P_ ((EventRef)); + +static OSStatus +mac_handle_service_event (call_ref, event, data) + EventHandlerCallRef call_ref; + EventRef event; + void *data; +{ + OSStatus err = noErr; + ScrapRef cur_scrap; + + /* Check if Vmac_services_selection is a valid selection that has a + corresponding scrap. */ + if (!SYMBOLP (Vmac_services_selection)) + err = eventNotHandledErr; + else + err = get_scrap_from_symbol (Vmac_services_selection, 0, &cur_scrap); + if (!(err == noErr && cur_scrap)) + return eventNotHandledErr; + + switch (GetEventKind (event)) + { + case kEventServiceGetTypes: + { + CFMutableArrayRef copy_types, paste_types; + CFStringRef type; + Lisp_Object rest; + ScrapFlavorType flavor_type; + + /* Set paste types. */ + err = GetEventParameter (event, kEventParamServicePasteTypes, + typeCFMutableArrayRef, NULL, + sizeof (CFMutableArrayRef), NULL, + &paste_types); + if (err == noErr) + for (rest = Vselection_converter_alist; CONSP (rest); + rest = XCDR (rest)) + if (CONSP (XCAR (rest)) && SYMBOLP (XCAR (XCAR (rest))) + && (flavor_type = + get_flavor_type_from_symbol (XCAR (XCAR (rest))))) + { + type = CreateTypeStringWithOSType (flavor_type); + if (type) + { + CFArrayAppendValue (paste_types, type); + CFRelease (type); + } + } + + /* Set copy types. */ + err = GetEventParameter (event, kEventParamServiceCopyTypes, + typeCFMutableArrayRef, NULL, + sizeof (CFMutableArrayRef), NULL, + ©_types); + if (err == noErr + && !NILP (Fx_selection_owner_p (Vmac_services_selection))) + for (rest = get_scrap_target_type_list (cur_scrap); + CONSP (rest) && SYMBOLP (XCAR (rest)); rest = XCDR (rest)) + { + flavor_type = get_flavor_type_from_symbol (XCAR (rest)); + if (flavor_type) + { + type = CreateTypeStringWithOSType (flavor_type); + if (type) + { + CFArrayAppendValue (copy_types, type); + CFRelease (type); + } + } + } + } + break; + + case kEventServiceCopy: + { + ScrapRef specific_scrap; + Lisp_Object rest, data; + + err = GetEventParameter (event, kEventParamScrapRef, + typeScrapRef, NULL, + sizeof (ScrapRef), NULL, &specific_scrap); + if (err == noErr + && !NILP (Fx_selection_owner_p (Vmac_services_selection))) + for (rest = get_scrap_target_type_list (cur_scrap); + CONSP (rest) && SYMBOLP (XCAR (rest)); rest = XCDR (rest)) + { + data = get_scrap_string (cur_scrap, XCAR (rest)); + if (STRINGP (data)) + err = put_scrap_string (specific_scrap, XCAR (rest), data); + } + else + err = eventNotHandledErr; + } + break; + + case kEventServicePaste: + case kEventServicePerform: + { + ScrapRef specific_scrap; + Lisp_Object rest, data; + int data_exists_p = 0; + + err = GetEventParameter (event, kEventParamScrapRef, typeScrapRef, + NULL, sizeof (ScrapRef), NULL, + &specific_scrap); + if (err == noErr) + err = clear_scrap (&cur_scrap); + if (err == noErr) + for (rest = Vselection_converter_alist; CONSP (rest); + rest = XCDR (rest)) + { + if (! (CONSP (XCAR (rest)) && SYMBOLP (XCAR (XCAR (rest))))) + continue; + data = get_scrap_string (specific_scrap, XCAR (XCAR (rest))); + if (STRINGP (data)) + { + err = put_scrap_string (cur_scrap, XCAR (XCAR (rest)), + data); + if (err != noErr) + break; + data_exists_p = 1; + } + } + if (err == noErr) + if (data_exists_p) + mac_store_application_menu_event (event); + else + err = eventNotHandledErr; + } + break; + } + + return err; +} +#endif + + +void +syms_of_macselect () +{ + defsubr (&Sx_get_selection_internal); + defsubr (&Sx_own_selection_internal); + defsubr (&Sx_disown_selection_internal); + defsubr (&Sx_selection_owner_p); + defsubr (&Sx_selection_exists_p); + + Vselection_alist = Qnil; + staticpro (&Vselection_alist); + + DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist, + doc: /* An alist associating selection-types with functions. +These functions are called to convert the selection, with three args: +the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD'); +a desired type to which the selection should be converted; +and the local selection value (whatever was given to `x-own-selection'). + +The function should return the value to send to the Scrap Manager +\(a string). A return value of nil +means that the conversion could not be done. +A return value which is the symbol `NULL' +means that a side-effect was executed, +and there is no meaningful selection value. */); + Vselection_converter_alist = Qnil; + + DEFVAR_LISP ("x-lost-selection-functions", &Vx_lost_selection_functions, + doc: /* A list of functions to be called when Emacs loses a selection. +\(This happens when a Lisp program explicitly clears the selection.) +The functions are called with one argument, the selection type +\(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */); + Vx_lost_selection_functions = Qnil; + + DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system, + doc: /* Coding system for communicating with other programs. +When sending or receiving text via cut_buffer, selection, and clipboard, +the text is encoded or decoded by this coding system. +The default value is determined by the system script code. */); + Vselection_coding_system = Qnil; + + DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system, + doc: /* Coding system for the next communication with other programs. +Usually, `selection-coding-system' is used for communicating with +other programs. But, if this variable is set, it is used for the +next communication only. After the communication, this variable is +set to nil. */); + Vnext_selection_coding_system = Qnil; + + DEFVAR_LISP ("mac-services-selection", &Vmac_services_selection, + doc: /* Selection name for communication via Services menu. */); + Vmac_services_selection = intern ("CLIPBOARD"); + + QPRIMARY = intern ("PRIMARY"); staticpro (&QPRIMARY); + QSECONDARY = intern ("SECONDARY"); staticpro (&QSECONDARY); + QTIMESTAMP = intern ("TIMESTAMP"); staticpro (&QTIMESTAMP); + QTARGETS = intern ("TARGETS"); staticpro (&QTARGETS); + + Qforeign_selection = intern ("foreign-selection"); + staticpro (&Qforeign_selection); + + Qmac_scrap_name = intern ("mac-scrap-name"); + staticpro (&Qmac_scrap_name); + + Qmac_ostype = intern ("mac-ostype"); + staticpro (&Qmac_ostype); +} + +/* arch-tag: f3c91ad8-99e0-4bd6-9eef-251b2f848732 + (do not change this comment) */ diff --git a/src/macterm.c b/src/macterm.c index 1c7893e8d0..aeb990a80e 100644 --- a/src/macterm.c +++ b/src/macterm.c @@ -7088,14 +7088,11 @@ x_find_ccl_program (fontp) #define MIN_DOC_SIZE 64 #define MAX_DOC_SIZE 32767 +#if 0 /* sleep time for WaitNextEvent */ #define WNE_SLEEP_AT_SUSPEND 10 #define WNE_SLEEP_AT_RESUME 1 -/* true when cannot handle any Mac OS events */ -static int handling_window_update = 0; - -#if 0 /* the flag appl_is_suspended is used both for determining the sleep time to be passed to WaitNextEvent and whether the cursor should be drawn when updating the display. The cursor is turned off when @@ -7113,8 +7110,6 @@ static long app_sleep_time = WNE_SLEEP_AT_RESUME; #define ABOUT_ALERT_ID 128 #define RAM_TOO_LARGE_ALERT_ID 129 -Boolean terminate_flag = false; - /* Contains the string "reverse", which is a constant for mouse button emu.*/ Lisp_Object Qreverse; @@ -7170,11 +7165,11 @@ static DragTrackingHandlerUPP mac_do_track_dragUPP = NULL; static DragReceiveHandlerUPP mac_do_receive_dragUPP = NULL; #endif +static Lisp_Object Qapplication, Qabout; #if USE_CARBON_EVENTS #ifdef MAC_OSX -/* Preliminary Support for the OSX Services Menu */ -static OSStatus mac_handle_service_event (EventHandlerCallRef,EventRef,void*); -static void init_service_handler (); +extern void init_service_handler (); +static Lisp_Object Qpreferences, Qservices, Qpaste, Qperform; #endif /* Window Event Handler */ static pascal OSStatus mac_handle_window_event (EventHandlerCallRef, @@ -7332,11 +7327,13 @@ do_get_menus (void) SetMenuBar (menubar_handle); DrawMenuBar (); +#if !TARGET_API_MAC_CARBON menu_handle = GetMenuHandle (M_APPLE); if(menu_handle != NULL) AppendResMenu (menu_handle,'DRVR'); else abort (); +#endif } @@ -7408,8 +7405,6 @@ do_window_update (WindowPtr win) { Rect r; - handling_window_update = 1; - #if TARGET_API_MAC_CARBON { RgnHandle region = NewRgn (); @@ -7425,8 +7420,6 @@ do_window_update (WindowPtr win) expose_frame (f, r.left, r.top, r.right - r.left, r.bottom - r.top); UpdateControls (win, win->visRgn); #endif - - handling_window_update = 0; } } @@ -7495,11 +7488,11 @@ do_menu_choice (SInt32 menu_choice) menu_id = HiWord (menu_choice); menu_item = LoWord (menu_choice); - if (menu_id == 0) - return; - switch (menu_id) { + case 0: + break; + case M_APPLE: do_apple_menu (menu_item); break; @@ -7749,105 +7742,157 @@ init_required_apple_events () abort (); } -#if USE_CARBON_EVENTS -#ifdef MAC_OSX void -init_service_handler () +mac_store_application_menu_event (event) +#if USE_CARBON_EVENTS + EventRef event; +#else + UInt32 event; +#endif { - EventTypeSpec specs[] = {{kEventClassService, kEventServiceGetTypes}, - {kEventClassService, kEventServiceCopy}, - {kEventClassService, kEventServicePaste}}; - InstallApplicationEventHandler (NewEventHandlerUPP (mac_handle_service_event), - 3, specs, NULL, NULL); -} + struct input_event buf; + Lisp_Object frame, entry; -/* - MAC_TODO: Check to see if this is called by AEProcessDesc... - */ -OSStatus -mac_handle_service_event (EventHandlerCallRef callRef, - EventRef event, void *data) -{ - OSStatus err = noErr; - switch (GetEventKind (event)) - { - case kEventServiceGetTypes: - { - CFMutableArrayRef copyTypes, pasteTypes; - CFStringRef type; - Boolean selection = true; - /* - GetEventParameter(event, kEventParamServicePasteTypes, - typeCFMutableArrayRef, NULL, - sizeof (CFMutableArrayRef), NULL, &pasteTypes); - */ - GetEventParameter(event, kEventParamServiceCopyTypes, - typeCFMutableArrayRef, NULL, - sizeof (CFMutableArrayRef), NULL, ©Types); - type = CreateTypeStringWithOSType (kScrapFlavorTypeText); - if (type) { - CFArrayAppendValue (copyTypes, type); - //CFArrayAppendValue (pasteTypes, type); - CFRelease (type); - } - } - case kEventServiceCopy: - { - ScrapRef currentScrap, specificScrap; - char * buf = ""; - Size byteCount = 0; + EVENT_INIT (buf); - GetCurrentScrap (¤tScrap); + XSETFRAME (frame, mac_focus_frame (&one_mac_display_info)); + buf.kind = MENU_BAR_EVENT; + buf.frame_or_window = frame; + buf.arg = frame; + kbd_buffer_store_event (&buf); - err = GetScrapFlavorSize (currentScrap, kScrapFlavorTypeText, &byteCount); - if (err == noErr) + buf.arg = Qapplication; + kbd_buffer_store_event (&buf); + +#if USE_CARBON_EVENTS + switch (GetEventClass (event)) + { +#ifdef MAC_OSX + case kEventClassService: + buf.arg = Qservices; + kbd_buffer_store_event (&buf); + switch (GetEventKind (event)) + { + case kEventServicePaste: + entry = Qpaste; + break; + + case kEventServicePerform: { - void *buffer = xmalloc (byteCount); - if (buffer != NULL) - { - GetEventParameter (event, kEventParamScrapRef, typeScrapRef, NULL, - sizeof (ScrapRef), NULL, &specificScrap); - - err = GetScrapFlavorData (currentScrap, kScrapFlavorTypeText, - &byteCount, buffer); - if (err == noErr) - PutScrapFlavor (specificScrap, kScrapFlavorTypeText, - kScrapFlavorMaskNone, byteCount, buffer); - xfree (buffer); - } + OSErr err; + CFStringRef message; + + err = GetEventParameter (event, kEventParamServiceMessageName, + typeCFStringRef, NULL, + sizeof (CFStringRef), NULL, &message); + buf.arg = Qperform; + kbd_buffer_store_event (&buf); + if (err == noErr && message) + entry = intern (SDATA (cfstring_to_lisp (message))); + else + entry = Qnil; } - err = noErr; - } - case kEventServicePaste: + break; + + default: + abort (); + } + break; +#endif /* MAC_OSX */ + case kEventClassCommand: { - /* - // Get the current location - Size byteCount; - ScrapRef specificScrap; - GetEventParameter(event, kEventParamScrapRef, typeScrapRef, NULL, - sizeof(ScrapRef), NULL, &specificScrap); - err = GetScrapFlavorSize(specificScrap, kScrapFlavorTypeText, &byteCount); - if (err == noErr) { - void * buffer = xmalloc(byteCount); - if (buffer != NULL ) { - err = GetScrapFlavorData(specificScrap, kScrapFlavorTypeText, - &byteCount, buffer); - if (err == noErr) { - // Actually place in the buffer - BLOCK_INPUT; - // Get the current "selection" string here - UNBLOCK_INPUT; - } + HICommand command; + + GetEventParameter(event, kEventParamDirectObject, typeHICommand, + NULL, sizeof (HICommand), NULL, &command); + switch (command.commandID) + { + case kHICommandAbout: + entry = Qabout; + break; +#ifdef MAC_OSX + case kHICommandPreferences: + entry = Qpreferences; + break; +#endif /* MAC_OSX */ + case kHICommandQuit: + entry = Qquit; + break; + default: + abort (); } - xfree(buffer); - } - */ } + break; + + default: + abort (); + } +#else /* USE_CARBON_EVENTS */ + switch (event) + { + case kHICommandAbout: + entry = Qabout; + break; + case kHICommandQuit: + entry = Qquit; + break; + default: + abort (); } - return err; -} #endif + buf.arg = entry; + kbd_buffer_store_event (&buf); +} + +#if USE_CARBON_EVENTS +static pascal OSStatus +mac_handle_command_event (next_handler, event, data) + EventHandlerCallRef next_handler; + EventRef event; + void *data; +{ + HICommand command; + OSErr result; + + GetEventParameter(event, kEventParamDirectObject, typeHICommand, NULL, + sizeof (HICommand), NULL, &command); + + switch (command.commandID) + { + case kHICommandAbout: +#ifdef MAC_OSX + case kHICommandPreferences: +#endif /* MAC_OSX */ + result = CallNextEventHandler (next_handler, event); + if (result != eventNotHandledErr) + return result; + + mac_store_application_menu_event (event); + return noErr; + + default: + break; + } + + return eventNotHandledErr; +} + +static OSErr +init_command_handler (window) + WindowPtr window; +{ + OSErr err = noErr; + EventTypeSpec specs[] = {{kEventClassCommand, kEventCommandProcess}}; + static EventHandlerUPP handle_command_eventUPP = NULL; + + if (handle_command_eventUPP == NULL) + handle_command_eventUPP = NewEventHandlerUPP (mac_handle_command_event); + return InstallApplicationEventHandler (handle_command_eventUPP, + GetEventTypeCount (specs), specs, + NULL, NULL); +} + static pascal OSStatus mac_handle_window_event (next_handler, event, data) EventHandlerCallRef next_handler; @@ -7870,7 +7915,7 @@ mac_handle_window_event (next_handler, event, data) return result; do_window_update (wp); - break; + return noErr; case kEventWindowBoundsChanging: result = CallNextEventHandler (next_handler, event); @@ -8249,14 +8294,30 @@ do_ae_print_documents (const AppleEvent *pAE, AppleEvent *reply, long refcon) static pascal OSErr do_ae_quit_application (AppleEvent* message, AppleEvent *reply, long refcon) { - /* FixMe: Do we need an unwind-protect or something here? And what - do we do about unsaved files. Currently just forces quit rather - than doing recursive callback to get user input. */ +#if USE_CARBON_EVENTS + OSErr err; + EventRef event = NULL; + static const HICommand quit_command = {kEventAttributeNone, kHICommandQuit}; - terminate_flag = true; + err = CreateEvent (NULL, kEventClassCommand, kEventCommandProcess, 0, + kEventAttributeUserEvent, &event); + if (err == noErr) + err = SetEventParameter (event, kEventParamDirectObject, typeHICommand, + sizeof (HICommand), &quit_command); + if (err == noErr) + mac_store_application_menu_event (event); + if (event) + ReleaseEvent (event); + + if (err == noErr) + return noErr; + else + return errAEEventNotHandled; +#else + mac_store_application_menu_event (kHICommandQuit); - /* Fkill_emacs doesn't return. We have to return. (TI) */ return noErr; +#endif } @@ -8456,20 +8517,6 @@ XTread_socket (sd, expected, hold_quit) /* So people can tell when we have read the available input. */ input_signal_count++; - /* Don't poll for events to process (specifically updateEvt) if - window update currently already in progress. A call to redisplay - (in do_window_update) can be preempted by another call to - redisplay, causing blank regions to be left on the screen and the - cursor to be left at strange places. */ - if (handling_window_update) - { - UNBLOCK_INPUT; - return 0; - } - - if (terminate_flag) - Fkill_emacs (make_number (1)); - #if USE_CARBON_EVENTS toolbox_dispatcher = GetEventDispatcherTarget (); @@ -9562,9 +9609,41 @@ mac_check_for_quit_char () kbd_buffer_store_event (&e); } } - #endif /* MAC_OSX */ +static void +init_menu_bar () +{ +#ifdef MAC_OSX + OSErr err; + MenuRef menu; + MenuItemIndex menu_index; + + err = GetIndMenuItemWithCommandID (NULL, kHICommandQuit, 1, + &menu, &menu_index); + if (err == noErr) + SetMenuItemCommandKey (menu, menu_index, false, 0); +#if USE_CARBON_EVENTS + EnableMenuCommand (NULL, kHICommandPreferences); + err = GetIndMenuItemWithCommandID (NULL, kHICommandPreferences, 1, + &menu, &menu_index); + if (err == noErr) + { + SetMenuItemCommandKey (menu, menu_index, false, 0); + InsertMenuItemTextWithCFString (menu, NULL, + 0, kMenuItemAttrSeparator, 0); + InsertMenuItemTextWithCFString (menu, CFSTR ("About Emacs"), + 0, 0, kHICommandAbout); + } +#endif /* USE_CARBON_EVENTS */ +#else /* !MAC_OSX */ +#if USE_CARBON_EVENTS + SetMenuItemCommandID (GetMenuHandle (M_APPLE), I_ABOUT, kHICommandAbout); +#endif +#endif +} + + /* Set up use of X before we make the first connection. */ extern frame_parm_handler mac_frame_parm_handlers[]; @@ -9682,13 +9761,17 @@ mac_initialize () #if TARGET_API_MAC_CARBON init_required_apple_events (); -#if USE_CARBON_EVENTS && defined (MAC_OSX) +#if USE_CARBON_EVENTS +#ifdef MAC_OSX init_service_handler (); init_quit_char_handler (); -#endif +#endif /* MAC_OSX */ - DisableMenuCommand (NULL, kHICommandQuit); + init_command_handler (); + + init_menu_bar (); +#endif /* USE_CARBON_EVENTS */ #ifdef MAC_OSX if (!inhibit_window_system) @@ -9715,6 +9798,16 @@ syms_of_macterm () Qsuper = intern ("super"); Fput (Qsuper, Qmodifier_value, make_number (super_modifier)); + Qapplication = intern ("application"); staticpro (&Qapplication); + Qabout = intern ("about"); staticpro (&Qabout); + +#if USE_CARBON_EVENTS && defined (MAC_OSX) + Qpreferences = intern ("preferences"); staticpro (&Qpreferences); + Qservices = intern ("services"); staticpro (&Qservices); + Qpaste = intern ("paste"); staticpro (&Qpaste); + Qperform = intern ("perform"); staticpro (&Qperform); +#endif + #ifdef MAC_OSX Fprovide (intern ("mac-carbon"), Qnil); #endif diff --git a/src/macterm.h b/src/macterm.h index 705e5d7ac3..5c724aac7b 100644 --- a/src/macterm.h +++ b/src/macterm.h @@ -617,6 +617,10 @@ extern void remove_window_handler P_ ((WindowPtr)); #define FONT_TYPE_FOR_UNIBYTE(font, ch) 0 #define FONT_TYPE_FOR_MULTIBYTE(font, ch) 0 +/* Defined in macselect.c */ + +extern void x_clear_frame_selections P_ ((struct frame *)); + /* Defined in mac.c. */ extern OSErr posix_pathname_to_fsspec P_ ((const char *, FSSpec *)); diff --git a/src/regex.c b/src/regex.c index a223f17076..44feee4cdd 100644 --- a/src/regex.c +++ b/src/regex.c @@ -4290,12 +4290,19 @@ re_search_2 (bufp, str1, size1, str2, size2, startpos, range, regs, stop) d += buf_charlen; } else - while (range > lim - && !fastmap[RE_TRANSLATE (translate, *d)]) - { - d++; - range--; - } + { + /* Convert *d to integer to shut up GCC's + whining about comparison that is always + true. */ + int di = *d; + + while (range > lim + && !fastmap[RE_TRANSLATE (translate, di)]) + { + di = *(++d); + range--; + } + } } else while (range > lim && !fastmap[*d]) @@ -5244,8 +5251,13 @@ re_match_2_internal (bufp, string1, size1, string2, size2, pos, regs, stop) else do { + /* Avoid compiler whining about comparison being + always true. */ + int di; + PREFETCH (); - if (RE_TRANSLATE (translate, *d) != *p++) + di = *d; + if (RE_TRANSLATE (translate, di) != *p++) { d = dfail; goto fail; diff --git a/src/s/ms-w32.h b/src/s/ms-w32.h index 503c8547c6..709b32f145 100644 --- a/src/s/ms-w32.h +++ b/src/s/ms-w32.h @@ -230,6 +230,7 @@ Boston, MA 02111-1307, USA. */ #undef HAVE_TERMIOS_H #define HAVE_LIMITS_H 1 #define HAVE_STRING_H 1 +#define HAVE_PWD_H 1 #define STDC_HEADERS 1 #define TIME_WITH_SYS_TIME 1 diff --git a/src/search.c b/src/search.c index d86a7cca7b..73ec3a78e5 100644 --- a/src/search.c +++ b/src/search.c @@ -1692,22 +1692,31 @@ boyer_moore (n, base_pat, len, len_byte, trt, inverse_trt, i = infinity; if (! NILP (trt)) { - /* If the byte currently looking at is a head of a character - to check case-equivalents, set CH to that character. An - ASCII character and a non-ASCII character matching with - CHARSET_BASE are to be checked. */ + /* If the byte currently looking at is the last of a + character to check case-equivalents, set CH to that + character. An ASCII character and a non-ASCII character + matching with CHARSET_BASE are to be checked. */ int ch = -1; if (ASCII_BYTE_P (*ptr) || ! multibyte) ch = *ptr; - else if (charset_base && CHAR_HEAD_P (*ptr)) + else if (charset_base + && (pat_end - ptr) == 1 || CHAR_HEAD_P (ptr[1])) { - ch = STRING_CHAR (ptr, pat_end - ptr); + unsigned char *charstart = ptr - 1; + + while (! (CHAR_HEAD_P (*charstart))) + charstart--; + ch = STRING_CHAR (charstart, ptr - charstart + 1); if (charset_base != (ch & ~CHAR_FIELD3_MASK)) ch = -1; } - j = *ptr; + if (ch > 0400) + j = ((unsigned char) ch) | 0200; + else + j = *ptr; + if (i == infinity) stride_for_teases = BM_tab[j]; @@ -1717,12 +1726,8 @@ boyer_moore (n, base_pat, len, len_byte, trt, inverse_trt, if (ch >= 0) { int starting_ch = ch; - int starting_j; + int starting_j = j; - if (ch > 0400) - starting_j = ((unsigned char) ch) | 0200; - else - starting_j = (unsigned char) ch; while (1) { TRANSLATE (ch, inverse_trt, ch); diff --git a/src/sysdep.c b/src/sysdep.c index ccef0e2947..706f0e1305 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -3911,7 +3911,6 @@ rmdir (dpath) /* Functions for VMS */ #ifdef VMS -#include "vms-pwd.h" #include <acldef.h> #include <chpdef.h> #include <jpidef.h> diff --git a/src/window.c b/src/window.c index 86c16ff571..ed177693e5 100644 --- a/src/window.c +++ b/src/window.c @@ -81,10 +81,6 @@ static int foreach_window_1 P_ ((struct window *, void *)); static Lisp_Object window_list_1 P_ ((Lisp_Object, Lisp_Object, Lisp_Object)); -/* The value of `window-size-fixed'. */ - -int window_size_fixed; - /* This is the window in which the terminal's cursor should be left when nothing is being done with it. This must always be a leaf window, and its buffer is selected by @@ -6671,6 +6667,7 @@ syms_of_window () { Qwindow_size_fixed = intern ("window-size-fixed"); staticpro (&Qwindow_size_fixed); + Fset (Qwindow_size_fixed, Qnil); staticpro (&Qwindow_configuration_change_hook); Qwindow_configuration_change_hook @@ -6879,16 +6876,6 @@ scroll as specified. */); The selected frame is the one whose configuration has changed. */); Vwindow_configuration_change_hook = Qnil; - DEFVAR_BOOL ("window-size-fixed", &window_size_fixed, - doc: /* Non-nil in a buffer means windows displaying the buffer are fixed-size. -If the value is`height', then only the window's height is fixed. -If the value is `width', then only the window's width is fixed. -Any other non-nil value fixes both the width and the height. -Emacs won't change the size of any window displaying that buffer, -unless you explicitly change the size, or Emacs has no other choice. */); - Fmake_variable_buffer_local (Qwindow_size_fixed); - window_size_fixed = 0; - defsubr (&Sselected_window); defsubr (&Sminibuffer_window); defsubr (&Swindow_minibuffer_p); diff --git a/src/xdisp.c b/src/xdisp.c index 736b60f9a9..fee87273d1 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -14156,10 +14156,10 @@ dump_glyph_row (row, vpos, glyphs) { if (glyphs != 1) { - fprintf (stderr, "Row Start End Used oEI><O\\CTZFesm X Y W H V A P\n"); - fprintf (stderr, "=======================================================================\n"); + fprintf (stderr, "Row Start End Used oEI><\\CTZFesm X Y W H V A P\n"); + fprintf (stderr, "======================================================================\n"); - fprintf (stderr, "%3d %5d %5d %4d %1.1d%1.1d%1.1d%1.1d%1.1d\ + fprintf (stderr, "%3d %5d %5d %4d %1.1d%1.1d%1.1d%1.1d\ %1.1d%1.1d%1.1d%1.1d%1.1d%1.1d%1.1d%1.1d %4d %4d %4d %4d %4d %4d %4d\n", vpos, MATRIX_ROW_START_CHARPOS (row), @@ -14169,7 +14169,6 @@ dump_glyph_row (row, vpos, glyphs) row->enabled_p, row->truncated_on_left_p, row->truncated_on_right_p, - row->overlay_arrow_p, row->continued_p, MATRIX_ROW_CONTINUATION_LINE_P (row), row->displays_text_p, @@ -16089,7 +16088,7 @@ store_mode_line_string (string, lisp_string, copy_string, field_width, precision props = mode_line_string_face_prop; else if (!NILP (mode_line_string_face)) { - Lisp_Object face = Fsafe_plist_get (props, Qface); + Lisp_Object face = Fplist_get (props, Qface); props = Fcopy_sequence (props); if (NILP (face)) face = mode_line_string_face; @@ -16114,7 +16113,7 @@ store_mode_line_string (string, lisp_string, copy_string, field_width, precision Lisp_Object face; if (NILP (props)) props = Ftext_properties_at (make_number (0), lisp_string); - face = Fsafe_plist_get (props, Qface); + face = Fplist_get (props, Qface); if (NILP (face)) face = mode_line_string_face; else @@ -18917,14 +18916,14 @@ produce_stretch_glyph (it) plist = XCDR (it->object); /* Compute the width of the stretch. */ - if ((prop = Fsafe_plist_get (plist, QCwidth), !NILP (prop)) + if ((prop = Fplist_get (plist, QCwidth), !NILP (prop)) && calc_pixel_width_or_height (&tem, it, prop, font, 1, 0)) { /* Absolute width `:width WIDTH' specified and valid. */ zero_width_ok_p = 1; width = (int)tem; } - else if (prop = Fsafe_plist_get (plist, QCrelative_width), + else if (prop = Fplist_get (plist, QCrelative_width), NUMVAL (prop) > 0) { /* Relative width `:relative-width FACTOR' specified and valid. @@ -18948,7 +18947,7 @@ produce_stretch_glyph (it) x_produce_glyphs (&it2); width = NUMVAL (prop) * it2.pixel_width; } - else if ((prop = Fsafe_plist_get (plist, QCalign_to), !NILP (prop)) + else if ((prop = Fplist_get (plist, QCalign_to), !NILP (prop)) && calc_pixel_width_or_height (&tem, it, prop, font, 1, &align_to)) { if (it->glyph_row == NULL || !it->glyph_row->mode_line_p) @@ -18968,13 +18967,13 @@ produce_stretch_glyph (it) width = 1; /* Compute height. */ - if ((prop = Fsafe_plist_get (plist, QCheight), !NILP (prop)) + if ((prop = Fplist_get (plist, QCheight), !NILP (prop)) && calc_pixel_width_or_height (&tem, it, prop, font, 0, 0)) { height = (int)tem; zero_height_ok_p = 1; } - else if (prop = Fsafe_plist_get (plist, QCrelative_height), + else if (prop = Fplist_get (plist, QCrelative_height), NUMVAL (prop) > 0) height = FONT_HEIGHT (font) * NUMVAL (prop); else @@ -18986,7 +18985,7 @@ produce_stretch_glyph (it) /* Compute percentage of height used for ascent. If `:ascent ASCENT' is present and valid, use that. Otherwise, derive the ascent from the font in use. */ - if (prop = Fsafe_plist_get (plist, QCascent), + if (prop = Fplist_get (plist, QCascent), NUMVAL (prop) > 0 && NUMVAL (prop) <= 100) ascent = height * NUMVAL (prop) / 100.0; else if (!NILP (prop) @@ -21243,7 +21242,7 @@ note_mode_line_or_margin_highlight (w, x, y, area) if (IMAGEP (object)) { Lisp_Object image_map, hotspot; - if ((image_map = Fsafe_plist_get (XCDR (object), QCmap), + if ((image_map = Fplist_get (XCDR (object), QCmap), !NILP (image_map)) && (hotspot = find_hot_spot (image_map, dx, dy), CONSP (hotspot)) @@ -21259,10 +21258,10 @@ note_mode_line_or_margin_highlight (w, x, y, area) if (CONSP (hotspot) && (plist = XCAR (hotspot), CONSP (plist))) { - pointer = Fsafe_plist_get (plist, Qpointer); + pointer = Fplist_get (plist, Qpointer); if (NILP (pointer)) pointer = Qhand; - help = Fsafe_plist_get (plist, Qhelp_echo); + help = Fplist_get (plist, Qhelp_echo); if (!NILP (help)) { help_echo_string = help; @@ -21274,7 +21273,7 @@ note_mode_line_or_margin_highlight (w, x, y, area) } } if (NILP (pointer)) - pointer = Fsafe_plist_get (XCDR (object), QCpointer); + pointer = Fplist_get (XCDR (object), QCpointer); } if (STRINGP (string)) @@ -21427,7 +21426,7 @@ note_mouse_highlight (f, x, y) if (img != NULL && IMAGEP (img->spec)) { Lisp_Object image_map, hotspot; - if ((image_map = Fsafe_plist_get (XCDR (img->spec), QCmap), + if ((image_map = Fplist_get (XCDR (img->spec), QCmap), !NILP (image_map)) && (hotspot = find_hot_spot (image_map, glyph->slice.x + dx, @@ -21445,10 +21444,10 @@ note_mouse_highlight (f, x, y) if (CONSP (hotspot) && (plist = XCAR (hotspot), CONSP (plist))) { - pointer = Fsafe_plist_get (plist, Qpointer); + pointer = Fplist_get (plist, Qpointer); if (NILP (pointer)) pointer = Qhand; - help_echo_string = Fsafe_plist_get (plist, Qhelp_echo); + help_echo_string = Fplist_get (plist, Qhelp_echo); if (!NILP (help_echo_string)) { help_echo_window = window; @@ -21458,7 +21457,7 @@ note_mouse_highlight (f, x, y) } } if (NILP (pointer)) - pointer = Fsafe_plist_get (XCDR (img->spec), QCpointer); + pointer = Fplist_get (XCDR (img->spec), QCpointer); } } diff --git a/src/xfaces.c b/src/xfaces.c index 099ad673dd..1960e72b71 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -3235,7 +3235,7 @@ resolve_face_name (face_name) while (SYMBOLP (face_name)) { - aliased = Fsafe_get (face_name, Qface_alias); + aliased = Fget (face_name, Qface_alias); if (NILP (aliased)) break; if (--alias_loop_max == 0) diff --git a/src/xrdb.c b/src/xrdb.c index 852fa2b808..957227b794 100644 --- a/src/xrdb.c +++ b/src/xrdb.c @@ -53,9 +53,7 @@ Boston, MA 02111-1307, USA. */ #include <X11/X.h> #include <X11/Xutil.h> #include <X11/Xresource.h> -#ifdef VMS -#include "vms-pwd.h" -#else +#ifdef HAVE_PWD_H #include <pwd.h> #endif #include <sys/stat.h> |