Mercurial > emacs
changeset 83238:223c12363c0c
Merged in changes from CVS trunk.
Patches applied:
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-747
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-748
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-749
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-750
Merge from gnus--rel--5.10
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-751
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-752
Update from CVS
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-78
Merge from emacs--cvs-trunk--0
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-79
Update from CVS
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-80
Update from CVS
git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-278
| author | Karoly Lorentey <lorentey@elte.hu> |
|---|---|
| date | Thu, 06 Jan 2005 15:00:09 +0000 |
| parents | 4ee39d9428b0 (current diff) e6d896f96885 (diff) |
| children | 025da3ba778e |
| files | etc/TODO lisp/ChangeLog lisp/faces.el lisp/files.el lisp/loadup.el lisp/simple.el lisp/subr.el lisp/type-break.el mac/makefile.MPW man/ChangeLog oldXMenu/Activate.c src/alloc.c src/buffer.c src/coding.c src/dispextern.h src/emacs.c src/fileio.c src/frame.c src/keyboard.c src/lisp.h src/lread.c src/macterm.c src/macterm.h src/process.c src/xdisp.c src/xfaces.c src/xfns.c src/xmenu.c |
| diffstat | 93 files changed, 3631 insertions(+), 1908 deletions(-) [+] |
line wrap: on
line diff
--- a/etc/NEWS Thu Dec 23 16:43:51 2004 +0000 +++ b/etc/NEWS Thu Jan 06 15:00:09 2005 +0000 @@ -98,6 +98,11 @@ * Changes in Emacs 21.4 +** calculator.el now has radix grouping mode. In this mode a +separator character is used between every few digits, making it +easier to indicate byte boundries etc. See the documentation of +the `calculator-radix-grouping-mode' custom variable. + ** You can now follow links by clicking Mouse-1 on the link. Traditionally, Emacs uses a Mouse-1 click to set point and a Mouse-2 @@ -981,6 +986,9 @@ ESC, like they do for Gtk+, Mac and W32. --- +** Dialogs and menus pop down when pressing C-g. + +--- ** The menu item "Open File..." has been split into two items, "New File..." and "Open File...". "Open File..." now opens only existing files. This is to support existing GUI file selection dialogs better. @@ -2143,6 +2151,11 @@ "checkout", "update" or "commit". That means using cvs diff options -rBASE -rHEAD. +** New variable `hs-set-up-overlay' allows customization of the overlay +used to effect hiding for hideshow minor mode. Integration with isearch +handles the overlay property `display' specially, preserving it during +temporary overlay showing in the course of an isearch operation. + * New modes and packages in Emacs 21.4 @@ -2390,6 +2403,15 @@ * Lisp Changes in Emacs 21.4 ++++ +** If a buffer sets buffer-save-without-query to non-nil, +save-some-buffers will always save that buffer without asking +(if it's modified). + ++++ +** The function symbol-file tells you which file defined +a certain function or variable. + ** Lisp code can now test if a given buffer position is inside a clickable link with the new function `mouse-on-link-p'. This is the function used by the new `mouse-1-click-follows-link' functionality. @@ -3100,6 +3122,10 @@ current file redefined it). +++ +** `load-history' now records (defun . FUNNAME) when a function is +defined. For a variable, it records just the variable name. + ++++ ** New Lisp library testcover.el works with edebug to help you determine whether you've tested all your Lisp code. Function testcover-start instruments all functions in a given file. Then test your code. Function
--- a/etc/TODO Thu Dec 23 16:43:51 2004 +0000 +++ b/etc/TODO Thu Jan 06 15:00:09 2005 +0000 @@ -15,6 +15,8 @@ ought to be possible to omit text which is invisible (due to a text-property, overlay, or selective display) from the kill-ring. +** battery.el display-battery should be replaced with a minor mode. + ** Redefine define-generic-mode as a macro, so the compiler sees the definitions it generates.
--- a/lib-src/ChangeLog Thu Dec 23 16:43:51 2004 +0000 +++ b/lib-src/ChangeLog Thu Jan 06 15:00:09 2005 +0000 @@ -1,3 +1,8 @@ +2004-12-26 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * make-docfile.c: Include stdlib.h even if WINDOWSNT is not + defined. + 2004-12-15 Andreas Schwab <schwab@suse.de> * etags.c (main): Fix typo in conversion of LONG_OPTIONS from
--- a/lib-src/make-docfile.c Thu Dec 23 16:43:51 2004 +0000 +++ b/lib-src/make-docfile.c Thu Jan 06 15:00:09 2005 +0000 @@ -43,11 +43,11 @@ #undef chdir #include <stdio.h> +#include <stdlib.h> #ifdef MSDOS #include <fcntl.h> #endif /* MSDOS */ #ifdef WINDOWSNT -#include <stdlib.h> #include <fcntl.h> #include <direct.h> #endif /* WINDOWSNT */
--- a/lisp/ChangeLog Thu Dec 23 16:43:51 2004 +0000 +++ b/lisp/ChangeLog Thu Jan 06 15:00:09 2005 +0000 @@ -1,3 +1,154 @@ +2004-12-27 Richard M. Stallman <rms@gnu.org> + + * simple.el (undo): Fix previous change. + +2004-12-27 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * term/mac-win.el: Sync with x-win.el. Rearrange the contents. + Call mac-clear-font-name-table if invoked on Mac OS 8/9. Call + x-open-connection on Mac OS X. + +2004-12-27 Richard M. Stallman <rms@gnu.org> + + * files.el (buffer-save-without-query): New var (buffer-local). + (save-some-buffers): Save those buffers first, w/o asking. + + * files.el (insert-directory-ls-version): New variable. + (insert-directory): When ls returns an error, test the version + number to decide what the return code means. + With --dired output format, detect and distinguish lines + that are really error messages. + (insert-directory-adj-pos): New function. + + * bookmark.el (bookmark-jump): Nice error if BOOKMARK is nil. + + * battery.el (battery-mode-line-format): Remove initial spaces. + + * uniquify.el (uniquify-rationalize-file-buffer-names): + Delete interactive spec. + + * type-break.el (type-break-mode): Set buffer-save-without-query. + Remove code that tried to set save-some-buffers-always. + (type-break-file-keystroke-count): Bind deactivate-mark. + + * mouse.el (mouse-drag-region): Bind mouse-autoselect-window. + + * simple.el (next-error-buffer-p): New arg AVOID-CURRENT. + Test that the buffer is live, and maybe reject current buffer too. + Clarify. + (next-error-find-buffer): Rewrite for clarity. + + * loadup.el: Don't use buffer-disable-undo; do it directly. + + * help-fns.el (describe-function-1): Call symbol-file with `defun'. + (describe-variable): Call symbol-file with `defvar'. + + * subr.el (messages-buffer-max-lines): Alias for message-log-max. + (symbol-file): Rewritten to handle new load-history format. + Now takes an arg TYPE to specify looking for a particular + type of definition only. + + * emacs-lisp/debug.el (debugger-make-xrefs): + Call symbol-file with `defun'. + + * emacs-lisp/find-func.el (find-function-noselect): + Call symbol-file with `defun'. + (find-variable-noselect): Call symbol-file with `defvar'. + + * eshell/esh-cmd.el (eshell-find-alias-function): + Call symbol-file with `defun'. + + * eshell/esh-test.el (eshell-test-goto-func): + Call symbol-file with `defun'. + + * mail/rmail.el (rmail-resend): + Let MAIL-ALIAS-FILE arg override mail-personal-alias-file. + + * net/goto-addr.el (goto-address-mail-regexp): Allow = in username. + + * progmodes/compile.el (compilation-find-buffer): Rename arg. + + * textmodes/texinfmt.el (texinfo-format-buffer-1): + Call buffer-disable-undo. + + * simple.el (undo-list-saved): New variable (buffer-local). + (undo): Set and test it. + (buffer-disable-undo): Moved here from buffer.c. + Clear out undo-list-saved. + + * international/mule.el (decode-coding-inserted-region): + Set buffer-undo-list in a correct and optimal way. + + * progmodes/cperl-mode.el (cperl-find-bad-style): Use with-no-warnings. + (cperl-font-lock-unfontify-region-function): No need to save and + restore info, since font-lock.el does it for us. + + * ansi-color.el (save-buffer-state): Definition deleted. + (ansi-color-unfontify-region): Don't use save-buffer-state. + +2004-12-27 Dave Love <fx@gnu.org> + + * wid-edit.el (function): Use restricted-sexp as parent. + +2004-12-27 Kevin Ryde <user42@zip.com.au> + + * simple.el (next-matching-history-element): Use same + `interactive' form as previous-matching-history-element. + + * ffap.el (ffap-string-at-point-mode-alist): Add "*" to url chars, + it can appear unencoded and has been seen from yahoo. + +2004-12-27 Sergey Poznyakoff <gray@Mirddin.farlep.net> + + * mail/smtpmail.el (smtpmail-try-auth-methods): Send AUTH CRAM-MD5 + in upper case. Reported by Wojciech Polak <polak@gnu.org>. + +2004-12-27 Kenichi Handa <handa@m17n.org> + + * international/utf-8.el (utf-translate-cjk-load-tables): Bind + coding-system-for-read to nil while loading subst-*. + +2004-12-26 Jay Belanger <belanger@truman.edu> + + * calc/calc-store.el (calc-read-var-name): Remove "var-" from + default input. + +2004-12-26 Luc Teirlinck <teirllm@auburn.edu> + + * buff-menu.el (Buffer-menu-revert-function): Clear out undo info + before reverting and disable undo recording while reverting. + +2004-12-26 Thien-Thi Nguyen <ttn@gnu.org> + + * progmodes/hideshow.el (hs-set-up-overlay): New user var. + (hs-make-overlay): New function. + (hs-isearch-show-temporary): Handle `display' overlay prop specially. + (hs-flag-region): Delete function. + (hs-hide-comment-region): No longer use `hs-flag-region'. + Instead, use `hs-discard-overlays' and `hs-make-overlay'. + (hs-hide-block-at-point): Likewise. + (hs-hide-level-recursive): Use `hs-discard-overlays'. + (hs-hide-all, hs-show-all): Likewise. + (hs-show-block): Likewise. + Also, use overlay prop `hs-b-offset', not `hs-ofs'. + +2004-12-24 Thien-Thi Nguyen <ttn@gnu.org> + + * progmodes/hideshow.el: Require `cl' when compiling. + Remove XEmacs and Emacs 19 compatibility. + Use `dolist' and `add-to-list' for load-time actions. + (hs-discard-overlays): Use `dolist'. + (hs-show-block): Likewise. + +2004-12-23 Dan Nicolaescu <dann@ics.uci.edu> + + * faces.el (mode-line, mode-line-inactive): Use min-colors. + +2004-12-23 Thien-Thi Nguyen <ttn@gnu.org> + + * progmodes/hideshow.el (hs-inside-comment-p): Fix omission bug: + When extending backwards, move outside the current comment first. + 2004-12-22 Kenichi Handa <handa@m17n.org> * international/quail.el (quail-start-translation): Fix prompt @@ -23,21 +174,33 @@ (undo-outer-limit-function): Use undo-outer-limit-truncate. 2004-12-21 Eli Barzilay <eli@barzilay.org> - + * calculator.el: (calculator-radix-grouping-mode) (calculator-radix-grouping-digits) (calculator-radix-grouping-separator): New defcustoms for the new radix grouping mode functionality. - (calculator-mode-hook): Now used in electric mode too. + (calculator-mode-hook): Now used in electric mode too, + (calculator): Call it. (calculator-mode-map): Some new keys. (calculator-message): New function. Some new calls. - (calculator-string-to-number): New function, + (calculator-op, calculator-set-register): Use it. + (calculator-string-to-number): New function, mostly moved and + updated code from calculator-curnum-value. (calculator-curnum-value): Use it. - (calculator-rotate-displayer, calculator-rotate-displayer-back) - (calculator-displayer-prev, calculator-displayer-next): - Change digit group size when in radix mode. - (calculator-number-to-string): Renamed from calculator-num-to-string. - Now deals with digit grouping in radix mode. + (calculator-paste): Use it, and update grabbing the + current-kill. + (calculator-rotate-displayer) + (calculator-rotate-displayer-back): Toggle digit grouping when + in radix mode, use calculator-message. + (calculator-displayer-prev, calculator-displayer-next): Change + digit group size when in radix mode. + (calculator-number-to-string): Renamed from + calculator-num-to-string. Now deals with digit grouping in + radix mode. + (calculator-update-display, calculator-put-value): Use the new + name. + (calculator-fact): Return a floating point number. + (calculator-mode): Doc fix. 2004-12-20 Glenn Morris <gmorris@ast.cam.ac.uk>
--- a/lisp/ansi-color.el Thu Dec 23 16:43:51 2004 +0000 +++ b/lisp/ansi-color.el Thu Jan 06 15:00:09 2005 +0000 @@ -220,23 +220,6 @@ ;; Alternative font-lock-unfontify-region-function for Emacs only - -(eval-when-compile - ;; We use this to preserve or protect things when modifying text - ;; properties. Stolen from lazy-lock and font-lock. Ugly!!! - ;; Probably most of this is not needed? - (defmacro save-buffer-state (varlist &rest body) - "Bind variables according to VARLIST and eval BODY restoring buffer state." - `(let* (,@(append varlist - '((modified (buffer-modified-p)) (buffer-undo-list t) - (inhibit-read-only t) (inhibit-point-motion-hooks t) - before-change-functions after-change-functions - deactivate-mark buffer-file-name buffer-file-truename))) - ,@body - (when (and (not modified) (buffer-modified-p)) - (set-buffer-modified-p nil)))) - (put 'save-buffer-state 'lisp-indent-function 1)) - (defun ansi-color-unfontify-region (beg end &rest xemacs-stuff) "Replacement function for `font-lock-default-unfontify-region'. @@ -259,21 +242,20 @@ \(function (lambda () \(setq font-lock-unfontify-region-function 'ansi-color-unfontify-region))))" - ;; save-buffer-state is a macro in font-lock.el! - (save-buffer-state nil - (when (boundp 'font-lock-syntactic-keywords) - (remove-text-properties beg end '(syntax-table nil))) - ;; instead of just using (remove-text-properties beg end '(face - ;; nil)), we find regions with a non-nil face test-property, skip - ;; positions with the ansi-color property set, and remove the - ;; remaining face test-properties. - (while (setq beg (text-property-not-all beg end 'face nil)) - (setq beg (or (text-property-not-all beg end 'ansi-color t) end)) - (when (get-text-property beg 'face) - (let ((end-face (or (text-property-any beg end 'face nil) - end))) - (remove-text-properties beg end-face '(face nil)) - (setq beg end-face)))))) + ;; Simplified now that font-lock-unfontify-region uses save-buffer-state. + (when (boundp 'font-lock-syntactic-keywords) + (remove-text-properties beg end '(syntax-table nil))) + ;; instead of just using (remove-text-properties beg end '(face + ;; nil)), we find regions with a non-nil face test-property, skip + ;; positions with the ansi-color property set, and remove the + ;; remaining face test-properties. + (while (setq beg (text-property-not-all beg end 'face nil)) + (setq beg (or (text-property-not-all beg end 'ansi-color t) end)) + (when (get-text-property beg 'face) + (let ((end-face (or (text-property-any beg end 'face nil) + end))) + (remove-text-properties beg end-face '(face nil)) + (setq beg end-face))))) ;; Working with strings
--- a/lisp/battery.el Thu Dec 23 16:43:51 2004 +0000 +++ b/lisp/battery.el Thu Jan 06 15:00:09 2005 +0000 @@ -73,12 +73,13 @@ (defvar battery-mode-line-string nil "String to display in the mode line.") +;;;###autoload (put 'battery-mode-line-string 'risky-local-variable t) (defcustom battery-mode-line-format (cond ((eq battery-status-function 'battery-linux-proc-apm) - " [%b%p%%]") + "[%b%p%%]") ((eq battery-status-function 'battery-linux-proc-acpi) - " [%b%p%%,%d°C]")) + "[%b%p%%,%d°C]")) "*Control string formatting the string to display in the mode line. Ordinary characters in the control string are printed as-is, while conversion specifications introduced by a `%' character in the control @@ -128,13 +129,14 @@ (defun battery-update () "Update battery status information in the mode line." - (setq battery-mode-line-string (propertize (if (and battery-mode-line-format - battery-status-function) - (battery-format - battery-mode-line-format - (funcall battery-status-function)) - "") - 'help-echo "Battery status information")) + (setq battery-mode-line-string + (propertize (if (and battery-mode-line-format + battery-status-function) + (battery-format + battery-mode-line-format + (funcall battery-status-function)) + "") + 'help-echo "Battery status information")) (force-mode-line-update))
--- a/lisp/bookmark.el Thu Dec 23 16:43:51 2004 +0000 +++ b/lisp/bookmark.el Thu Jan 06 15:00:09 2005 +0000 @@ -1049,6 +1049,8 @@ (interactive (list (bookmark-completing-read "Jump to bookmark" bookmark-current-bookmark))) + (unless bookmark + (error "No bookmark specified")) (bookmark-maybe-historicize-string bookmark) (let ((cell (bookmark-jump-noselect bookmark))) (and cell
--- a/lisp/buff-menu.el Thu Dec 23 16:43:51 2004 +0000 +++ b/lisp/buff-menu.el Thu Jan 06 15:00:09 2005 +0000 @@ -198,11 +198,15 @@ (revert-buffer)) (defun Buffer-menu-revert-function (ignore1 ignore2) + (or (eq buffer-undo-list t) + (setq buffer-undo-list nil)) ;; We can not use save-excursion here. The buffer gets erased. (let ((ocol (current-column)) (oline (progn (move-to-column 4) (get-text-property (point) 'buffer))) - (prop (point-min))) + (prop (point-min)) + ;; do not make undo records for the reversion. + (buffer-undo-list t)) (list-buffers-noselect Buffer-menu-files-only) (while (setq prop (next-single-property-change prop 'buffer)) (when (eq (get-text-property prop 'buffer) oline)
--- a/lisp/calc/calc-store.el Thu Dec 23 16:43:51 2004 +0000 +++ b/lisp/calc/calc-store.el Thu Jan 06 15:00:09 2005 +0000 @@ -174,13 +174,17 @@ (defun calc-read-var-name (prompt &optional calc-store-opers) (setq calc-given-value nil calc-aborted-prefix nil) - (let ((var (let ((minibuffer-completion-table obarray) - (minibuffer-completion-predicate 'boundp) - (minibuffer-completion-confirm t)) - (read-from-minibuffer prompt "var-" calc-var-name-map nil)))) + (let ((var (concat + "var-" + (let ((minibuffer-completion-table + (mapcar (lambda (x) (substring x 4)) + (all-completions "var-" obarray))) + (minibuffer-completion-predicate + (lambda (x) (boundp (intern (concat "var-" x))))) + (minibuffer-completion-confirm t)) + (read-from-minibuffer prompt nil calc-var-name-map nil))))) (setq calc-aborted-prefix "") - (and (not (equal var "")) - (not (equal var "var-")) + (and (not (equal var "var-")) (if (string-match "\\`\\([-a-zA-Z0-9]+\\) *:?=" var) (if (null calc-given-value-flag) (error "Assignment is not allowed in this command")
--- a/lisp/emacs-lisp/debug.el Thu Dec 23 16:43:51 2004 +0000 +++ b/lisp/emacs-lisp/debug.el Thu Jan 06 15:00:09 2005 +0000 @@ -352,7 +352,7 @@ (end (progn (skip-syntax-forward "w_") (point))) (sym (intern-soft (buffer-substring-no-properties beg end))) - (file (and sym (symbol-file sym)))) + (file (and sym (symbol-file sym 'defun)))) (when file (goto-char beg) ;; help-xref-button needs to operate on something matched
--- a/lisp/emacs-lisp/find-func.el Thu Dec 23 16:43:51 2004 +0000 +++ b/lisp/emacs-lisp/find-func.el Thu Jan 06 15:00:09 2005 +0000 @@ -242,7 +242,7 @@ (let ((library (cond ((eq (car-safe def) 'autoload) (nth 1 def)) - ((symbol-file function))))) + ((symbol-file function 'defun))))) (find-function-search-for-symbol function nil library)))) (defalias 'function-at-point 'function-called-at-point) @@ -347,8 +347,7 @@ `find-function-source-path', if non nil, otherwise in `load-path'." (if (not variable) (error "You didn't specify a variable")) - ;; Fixme: I think `symbol-file' should be fixed instead. -- fx - (let ((library (or file (symbol-file (cons 'defvar variable))))) + (let ((library (or file (symbol-file variable 'defvar)))) (find-function-search-for-symbol variable 'variable library))) ;;;###autoload
--- a/lisp/eshell/esh-cmd.el Thu Dec 23 16:43:51 2004 +0000 +++ b/lisp/eshell/esh-cmd.el Thu Jan 06 15:00:09 2005 +0000 @@ -1285,7 +1285,7 @@ (defun eshell-find-alias-function (name) "Check whether a function called `eshell/NAME' exists." (let* ((sym (intern-soft (concat "eshell/" name))) - (file (symbol-file sym))) + (file (symbol-file sym 'defun))) ;; If the function exists, but is defined in an eshell module ;; that's not currently enabled, don't report it as found (if (and file
--- a/lisp/eshell/esh-test.el Thu Dec 23 16:43:51 2004 +0000 +++ b/lisp/eshell/esh-test.el Thu Jan 06 15:00:09 2005 +0000 @@ -125,7 +125,7 @@ (let ((fsym (get-text-property (point) 'test-func))) (when fsym (let* ((def (symbol-function fsym)) - (library (locate-library (symbol-file fsym))) + (library (locate-library (symbol-file fsym 'defun))) (name (substring (symbol-name fsym) (length "eshell-test--"))) (inhibit-redisplay t))
--- a/lisp/faces.el Thu Dec 23 16:43:51 2004 +0000 +++ b/lisp/faces.el Thu Jan 06 15:00:09 2005 +0000 @@ -1813,7 +1813,7 @@ (defface mode-line - '((((type x w32 mac) (class color)) + '((((class color) (min-colors 88)) :box (:line-width -1 :style released-button) :background "grey75" :foreground "black") (t @@ -1826,11 +1826,11 @@ (defface mode-line-inactive '((default :inherit mode-line) - (((type x w32 mac) (background light) (class color)) + (((class color) (min-colors 88) (background light)) :weight light :box (:line-width -1 :color "grey75" :style nil) :foreground "grey20" :background "grey90") - (((type x w32 mac) (background dark) (class color)) + (((class color) (min-colors 88) (background dark) ) :weight light :box (:line-width -1 :color "grey40" :style nil) :foreground "grey80" :background "grey30"))
--- a/lisp/ffap.el Thu Dec 23 16:43:51 2004 +0000 +++ b/lisp/ffap.el Thu Jan 06 15:00:09 2005 +0000 @@ -962,7 +962,7 @@ ;; * no commas (good for latex) (file "--:$+<>@-Z_a-z~*?" "<@" "@>;.,!:") ;; An url, or maybe a email/news message-id: - (url "--:=&?$+@-Z_a-z~#,%;" "^A-Za-z0-9" ":;.,!?") + (url "--:=&?$+@-Z_a-z~#,%;*" "^A-Za-z0-9" ":;.,!?") ;; Find a string that does *not* contain a colon: (nocolon "--9$+<>@-Z_a-z~" "<@" "@>;.,!?") ;; A machine:
--- a/lisp/files.el Thu Dec 23 16:43:51 2004 +0000 +++ b/lisp/files.el Thu Jan 06 15:00:09 2005 +0000 @@ -1200,7 +1200,8 @@ "Return the buffer visiting file FILENAME (a string). This is like `get-file-buffer', except that it checks for any buffer visiting the same file, possibly under a different name. -If PREDICATE is non-nil, only a buffer satisfying it can be returned. +If PREDICATE is non-nil, only buffers satisfying it are eligible, +and others are ignored. If there is no such live buffer, return nil." (let ((predicate (or predicate #'identity)) (truename (abbreviate-file-name (file-truename filename)))) @@ -3363,6 +3364,10 @@ "ACTION-ALIST argument used in call to `map-y-or-n-p'.") (put 'save-some-buffers-action-alist 'risky-local-variable t) +(defvar buffer-save-without-query nil + "Non-nil means `save-some-buffers' should save this buffer without asking.") +(make-variable-buffer-local 'buffer-save-without-query) + (defun save-some-buffers (&optional arg pred) "Save some modified file-visiting buffers. Asks user about each one. You can answer `y' to save, `n' not to save, `C-r' to look at the @@ -3380,8 +3385,18 @@ change the additional actions you can take on files." (interactive "P") (save-window-excursion - (let* ((queried nil) - (files-done + (let* (queried some-automatic + files-done abbrevs-done) + (dolist (buffer (buffer-list)) + ;; First save any buffers that we're supposed to save unconditionally. + ;; That way the following code won't ask about them. + (with-current-buffer buffer + (when (and buffer-save-without-query (buffer-modified-p)) + (setq some-automatic t) + (save-buffer)))) + ;; Ask about those buffers that merit it, + ;; and record the number thus saved. + (setq files-done (map-y-or-n-p (function (lambda (buffer) @@ -3410,19 +3425,22 @@ (buffer-list) '("buffer" "buffers" "save") save-some-buffers-action-alist)) - (abbrevs-done - (and save-abbrevs abbrevs-changed - (progn - (if (or arg - (eq save-abbrevs 'silently) - (y-or-n-p (format "Save abbrevs in %s? " - abbrev-file-name))) - (write-abbrev-file nil)) - ;; Don't keep bothering user if he says no. - (setq abbrevs-changed nil) - t)))) + ;; Maybe to save abbrevs, and record whether + ;; we either saved them or asked to. + (and save-abbrevs abbrevs-changed + (progn + (if (or arg + (eq save-abbrevs 'silently) + (y-or-n-p (format "Save abbrevs in %s? " + abbrev-file-name))) + (write-abbrev-file nil)) + ;; Don't keep bothering user if he says no. + (setq abbrevs-changed nil) + (setq abbrevs-done t))) (or queried (> files-done 0) abbrevs-done - (message "(No files need saving)"))))) + (message (if some-automatic + "(Some special files were saved without asking)" + "(No files need saving)")))))) (defun not-modified (&optional arg) "Mark current buffer as unmodified, not needing to be saved. @@ -4309,6 +4327,8 @@ (buffer-substring (point) end))))))))) +(defvar insert-directory-ls-version 'unknown) + ;; insert-directory ;; - must insert _exactly_one_line_ describing FILE if WILDCARD and ;; FULL-DIRECTORY-P is nil. @@ -4418,6 +4438,56 @@ (concat (file-name-as-directory file) ".") file)))))))) + ;; If we got "//DIRED//" in the output, it means we got a real + ;; directory listing, even if `ls' returned nonzero. + ;; So ignore any errors. + (when (if (stringp switches) + (string-match "--dired\\>" switches) + (member "--dired" switches)) + (save-excursion + (forward-line -2) + (when (looking-at "//SUBDIRED//") + (forward-line -1)) + (if (looking-at "//DIRED//") + (setq result 0)))) + + (when (and (not (eq 0 result)) + (eq insert-directory-ls-version 'unknown)) + ;; The first time ls returns an error, + ;; find the version numbers of ls, + ;; and set insert-directory-ls-version + ;; to > if it is more than 5.2.1, < if it is less, nil if it + ;; is equal or if the info cannot be obtained. + ;; (That can mean it isn't GNU ls.) + (let ((version-out + (with-temp-buffer + (call-process "ls" nil t nil "--version") + (buffer-string)))) + (if (string-match "ls (.*utils) \\([0-9.]*\\)$" version-out) + (let* ((version (match-string 1 version-out)) + (split (split-string version "[.]")) + (numbers (mapcar 'string-to-int split)) + (min '(5 2 1)) + comparison) + (while (and (not comparison) (or numbers min)) + (cond ((null min) + (setq comparison '>)) + ((null numbers) + (setq comparison '<)) + ((> (car numbers) (car min)) + (setq comparison '>)) + ((< (car numbers) (car min)) + (setq comparison '<)) + (t + (setq numbers (cdr numbers) + min (cdr min))))) + (setq insert-directory-ls-version (or comparison '=))) + (setq insert-directory-ls-version nil)))) + + ;; For GNU ls versions 5.2.2 and up, ignore minor errors. + (when (and (eq 1 result) (eq insert-directory-ls-version '>)) + (setq result 0)) + ;; If `insert-directory-program' failed, signal an error. (unless (eq 0 result) ;; Delete the error message it may have output. @@ -4444,23 +4514,39 @@ (when (looking-at "//SUBDIRED//") (delete-region (point) (progn (forward-line 1) (point))) (forward-line -1)) - (if (looking-at "//DIRED//") - (let ((end (line-end-position))) - (forward-word 1) - (forward-char 3) - (while (< (point) end) - (let ((start (+ beg (read (current-buffer)))) - (end (+ beg (read (current-buffer))))) - (if (memq (char-after end) '(?\n ?\ )) - ;; End is followed by \n or by " -> ". - (put-text-property start end 'dired-filename t) - ;; It seems that we can't trust ls's output as to - ;; byte positions of filenames. - (put-text-property beg (point) 'dired-filename nil) - (end-of-line)))) - (goto-char end) - (beginning-of-line) - (delete-region (point) (progn (forward-line 2) (point)))) + (when (looking-at "//DIRED//") + (let ((end (line-end-position)) + (linebeg (point)) + error-lines) + ;; Find all the lines that are error messages, + ;; and record the bounds of each one. + (goto-char (point-min)) + (while (< (point) linebeg) + (or (eql (following-char) ?\s) + (push (list (point) (line-end-position)) error-lines)) + (forward-line 1)) + (setq error-lines (nreverse error-lines)) + ;; Now read the numeric positions of file names. + (goto-char linebeg) + (forward-word 1) + (forward-char 3) + (while (< (point) end) + (let ((start (insert-directory-adj-pos + (+ beg (read (current-buffer))) + error-lines)) + (end (insert-directory-adj-pos + (+ beg (read (current-buffer))) + error-lines))) + (if (memq (char-after end) '(?\n ?\ )) + ;; End is followed by \n or by " -> ". + (put-text-property start end 'dired-filename t) + ;; It seems that we can't trust ls's output as to + ;; byte positions of filenames. + (put-text-property beg (point) 'dired-filename nil) + (end-of-line)))) + (goto-char end) + (beginning-of-line) + (delete-region (point) (progn (forward-line 2) (point)))) (forward-line 1) (if (looking-at "//DIRED-OPTIONS//") (delete-region (point) (progn (forward-line 1) (point))) @@ -4512,6 +4598,18 @@ (end-of-line) (insert " available " available))))))))))) +(defun insert-directory-adj-pos (pos error-lines) + "Convert `ls --dired' file name position value POS to a buffer position. +File name position values returned in ls --dired output +count only stdout; they don't count the error messages sent to stderr. +So this function converts to them to real buffer positions. +ERROR-LINES is a list of buffer positions of error message lines, +of the form (START END)." + (while (and error-lines (< (caar error-lines) pos)) + (setq pos (+ pos (- (nth 1 (car error-lines)) (nth 0 (car error-lines))))) + (pop error-lines)) + pos) + (defun insert-directory-safely (file switches &optional wildcard full-directory-p) "Insert directory listing for FILE, formatted according to SWITCHES.
--- a/lisp/gnus/ChangeLog Thu Dec 23 16:43:51 2004 +0000 +++ b/lisp/gnus/ChangeLog Thu Jan 06 15:00:09 2005 +0000 @@ -4,6 +4,35 @@ * gnus-sum.el (gnus-summary-mode-map): Likewise. +2004-12-22 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-spec.el (gnus-spec-tab): Make a Lisp form which works + correctly even if there are wide characters. + +2004-12-21 Katsumi Yamaoka <yamaoka@jpl.org> + + * rfc2231.el (rfc2231-parse-string): Decode encoded value after + concatenating segments rather than before concatenating them. + Suggested by ARISAWA Akihiro <ari@mbf.ocn.ne.jp>. + +2004-12-17 Katsumi Yamaoka <yamaoka@jpl.org> + + * mm-util.el (mm-xemacs-find-mime-charset): New macro. + +2004-12-17 Aidan Kehoe <kehoea@parhasard.net> + + * mm-util.el (mm-xemacs-find-mime-charset-1): New function used to + unify Latin characters in XEmacs. + (mm-find-mime-charset-region): Use it. + +2004-12-17 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-util.el (gnus-delete-directory): New function. + + * gnus-agent.el (gnus-agent-delete-group): Use it. + + * gnus-cache.el (gnus-cache-delete-group): Use it. + 2004-12-08 Stefan Monnier <monnier@iro.umontreal.ca> * gnus-art.el (gnus-narrow-to-page): Don't hardcode point-min.
--- a/lisp/gnus/gnus-agent.el Thu Dec 23 16:43:51 2004 +0000 +++ b/lisp/gnus/gnus-agent.el Thu Jan 06 15:00:09 2005 +0000 @@ -891,7 +891,7 @@ (path (directory-file-name (let (gnus-command-method command-method) (gnus-agent-group-pathname group))))) - (gnus-delete-file path) + (gnus-delete-directory path) (let* ((real-group (gnus-group-real-name group))) (gnus-agent-save-group-info command-method real-group nil)
--- a/lisp/gnus/gnus-cache.el Thu Dec 23 16:43:51 2004 +0000 +++ b/lisp/gnus/gnus-cache.el Thu Jan 06 15:00:09 2005 +0000 @@ -754,7 +754,7 @@ disabled, as the old cache files would corrupt gnus when the cache was next enabled. Depends upon the caller to determine whether group deletion is supported." (let ((dir (gnus-cache-file-name group ""))) - (gnus-delete-file dir)) + (gnus-delete-directory dir)) (let ((no-save gnus-cache-active-hashtb)) (unless gnus-cache-active-hashtb
--- a/lisp/gnus/gnus-spec.el Thu Dec 23 16:43:51 2004 +0000 +++ b/lisp/gnus/gnus-spec.el Thu Jan 06 15:00:09 2005 +0000 @@ -275,21 +275,15 @@ (defun gnus-spec-tab (column) (if (> column 0) - `(insert (make-string (max (- ,column (current-column)) 0) ? )) + `(insert-char ? (max (- ,column (current-column)) 0)) (let ((column (abs column))) - (if gnus-use-correct-string-widths - `(progn - (if (> (current-column) ,column) - (while (progn - (delete-backward-char 1) - (> (current-column) ,column)))) - (insert (make-string (max (- ,column (current-column)) 0) ? ))) - `(progn - (if (> (current-column) ,column) - (delete-region (point) - (- (point) (- (current-column) ,column))) - (insert (make-string (max (- ,column (current-column)) 0) - ? )))))))) + `(if (> (current-column) ,column) + (let ((end (point))) + (if (= (move-to-column ,column) ,column) + (delete-region (point) end) + (delete-region (1- (point)) end) + (insert " "))) + (insert-char ? (max (- ,column (current-column)) 0)))))) (defun gnus-correct-length (string) "Return the correct width of STRING."
--- a/lisp/gnus/gnus-util.el Thu Dec 23 16:43:51 2004 +0000 +++ b/lisp/gnus/gnus-util.el Thu Jan 06 15:00:09 2005 +0000 @@ -708,6 +708,23 @@ (when (file-exists-p file) (delete-file file))) +(defun gnus-delete-directory (directory) + "Delete files in DIRECTORY. Subdirectories remain. +If there's no subdirectory, delete DIRECTORY as well." + (when (file-directory-p directory) + (let ((files (directory-files + directory t "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")) + file dir) + (while files + (setq file (pop files)) + (if (eq t (car (file-attributes file))) + ;; `file' is a subdirectory. + (setq dir t) + ;; `file' is a file or a symlink. + (delete-file file))) + (unless dir + (delete-directory directory))))) + (defun gnus-strip-whitespace (string) "Return STRING stripped of all whitespace." (while (string-match "[\r\n\t ]+" string)
--- a/lisp/gnus/mm-util.el Thu Dec 23 16:43:51 2004 +0000 +++ b/lisp/gnus/mm-util.el Thu Jan 06 15:00:09 2005 +0000 @@ -576,6 +576,83 @@ (length (memq (coding-system-base b) priorities))) t)))) +(eval-when-compile + (autoload 'latin-unity-massage-name "latin-unity") + (autoload 'latin-unity-maybe-remap "latin-unity") + (autoload 'latin-unity-representations-feasible-region "latin-unity") + (autoload 'latin-unity-representations-present-region "latin-unity") + (defvar latin-unity-coding-systems) + (defvar latin-unity-ucs-list)) + +(defun mm-xemacs-find-mime-charset-1 (begin end) + "Determine which MIME charset to use to send region as message. +This uses the XEmacs-specific latin-unity package to better handle the +case where identical characters from diverse ISO-8859-? character sets +can be encoded using a single one of the corresponding coding systems. + +It treats `mm-coding-system-priorities' as the list of preferred +coding systems; a useful example setting for this list in Western +Europe would be '(iso-8859-1 iso-8859-15 utf-8), which would default +to the very standard Latin 1 coding system, and only move to coding +systems that are less supported as is necessary to encode the +characters that exist in the buffer. + +Latin Unity doesn't know about those non-ASCII Roman characters that +are available in various East Asian character sets. As such, its +behavior if you have a JIS 0212 LATIN SMALL LETTER A WITH ACUTE in a +buffer and it can otherwise be encoded as Latin 1, won't be ideal. +But this is very much a corner case, so don't worry about it." + (let ((systems mm-coding-system-priorities) csets psets curset) + + ;; Load the Latin Unity library, if available. + (when (and (not (featurep 'latin-unity)) (locate-library "latin-unity")) + (require 'latin-unity)) + + ;; Now, can we use it? + (if (featurep 'latin-unity) + (progn + (setq csets (latin-unity-representations-feasible-region begin end) + psets (latin-unity-representations-present-region begin end)) + + (catch 'done + + ;; Pass back the first coding system in the preferred list + ;; that can encode the whole region. + (dolist (curset systems) + (setq curset (latin-unity-massage-name 'buffer-default curset)) + + ;; If the coding system is a universal coding system, then + ;; it can certainly encode all the characters in the region. + (if (memq curset latin-unity-ucs-list) + (throw 'done (list curset))) + + ;; If a coding system isn't universal, and isn't in + ;; the list that latin unity knows about, we can't + ;; decide whether to use it here. Leave that until later + ;; in `mm-find-mime-charset-region' function, whence we + ;; have been called. + (unless (memq curset latin-unity-coding-systems) + (throw 'done nil)) + + ;; Right, we know about this coding system, and it may + ;; conceivably be able to encode all the characters in + ;; the region. + (if (latin-unity-maybe-remap begin end curset csets psets t) + (throw 'done (list curset)))) + + ;; Can't encode using anything from the + ;; `mm-coding-system-priorities' list. + ;; Leave `mm-find-mime-charset' to do most of the work. + nil)) + + ;; Right, latin unity isn't available; let `mm-find-charset-region' + ;; take its default action, which equally applies to GNU Emacs. + nil))) + +(defmacro mm-xemacs-find-mime-charset (begin end) + (when (featurep 'xemacs) + `(mm-xemacs-find-mime-charset-1 ,begin ,end))) + (defun mm-find-mime-charset-region (b e &optional hack-charsets) "Return the MIME charsets needed to encode the region between B and E. nil means ASCII, a single-element list represents an appropriate MIME @@ -617,8 +694,12 @@ (setq systems nil charsets (list cs)))))) charsets)) - ;; Otherwise we're not multibyte, we're XEmacs, or a single - ;; coding system won't cover it. + ;; If we're XEmacs, and some coding system is appropriate, + ;; mm-xemacs-find-mime-charset will return an appropriate list. + ;; Otherwise, we'll get nil, and the next setq will get invoked. + (setq charsets (mm-xemacs-find-mime-charset b e)) + + ;; We're not multibyte, or a single coding system won't cover it. (setq charsets (mm-delete-duplicates (mapcar 'mm-mime-charset
--- a/lisp/gnus/rfc2231.el Thu Dec 23 16:43:51 2004 +0000 +++ b/lisp/gnus/rfc2231.el Thu Jan 06 15:00:09 2005 +0000 @@ -88,7 +88,6 @@ (point) (progn (forward-sexp 1) (point)))))) (error "Invalid header: %s" string)) (setq c (char-after)) - (setq encoded nil) (when (eq c ?*) (forward-char 1) (setq c (char-after)) @@ -126,16 +125,22 @@ (point) (progn (forward-sexp) (point))))) (t (error "Invalid header: %s" string))) - (when encoded - (setq value (rfc2231-decode-encoded-string value))) (if number (setq prev-attribute attribute prev-value (concat prev-value value)) - (push (cons attribute value) parameters)))) + (push (cons attribute + (if encoded + (rfc2231-decode-encoded-string value) + value)) + parameters)))) ;; Take care of any final continuations. (when prev-attribute - (push (cons prev-attribute prev-value) parameters)) + (push (cons prev-attribute + (if encoded + (rfc2231-decode-encoded-string prev-value) + prev-value)) + parameters)) (when type `(,type ,@(nreverse parameters)))))))
--- a/lisp/help-fns.el Thu Dec 23 16:43:51 2004 +0000 +++ b/lisp/help-fns.el Thu Jan 06 15:00:09 2005 +0000 @@ -355,7 +355,7 @@ (if (re-search-backward "alias for `\\([^`']+\\)'" nil t) (help-xref-button 1 'help-function def))))) (or file-name - (setq file-name (symbol-file function))) + (setq file-name (symbol-file function 'defun))) (when (equal file-name "loaddefs.el") ;; Find the real def site of the preloaded function. ;; This is necessary only for defaliases. @@ -614,7 +614,7 @@ ;; Make a hyperlink to the library if appropriate. (Don't ;; change the format of the buffer's initial line in case ;; anything expects the current format.) - (let ((file-name (symbol-file (cons 'defvar variable)))) + (let ((file-name (symbol-file variable 'defvar))) (when (equal file-name "loaddefs.el") ;; Find the real def site of the preloaded variable. (let ((location
--- a/lisp/hexl.el Thu Dec 23 16:43:51 2004 +0000 +++ b/lisp/hexl.el Thu Jan 06 15:00:09 2005 +0000 @@ -111,11 +111,19 @@ (defvar hexl-mode-old-isearch-search-fun-function) (defvar hexl-mode-old-require-final-newline) (defvar hexl-mode-old-syntax-table) +(defvar hexl-mode-old-font-lock-keywords) (defvar hexl-ascii-overlay nil "Overlay used to highlight ASCII element corresponding to current point.") (make-variable-buffer-local 'hexl-ascii-overlay) +(defvar hexl-font-lock-keywords + '(("^\\([0-9a-f]+:\\).\\{40\\} \\(.+$\\)" + ;; "^\\([0-9a-f]+:\\).+ \\(.+$\\)" + (1 'hexl-address-area t t) + (2 'hexl-ascii-area t t))) + "Font lock keywords used in `hexl-mode'.") + ;; routines (put 'hexl-mode 'mode-class 'special) @@ -265,6 +273,11 @@ (make-local-variable 'require-final-newline) (setq require-final-newline nil) + (make-local-variable 'hexl-mode-old-font-lock-keywords) + (setq hexl-mode-old-font-lock-keywords font-lock-defaults) + (make-local-variable 'font-lock-defaults) + (setq font-lock-defaults '(hexl-font-lock-keywords t)) + ;; Add hooks to rehexlify or dehexlify on various events. (add-hook 'after-revert-hook 'hexl-after-revert-hook nil t) @@ -376,6 +389,7 @@ (setq isearch-search-fun-function hexl-mode-old-isearch-search-fun-function) (use-local-map hexl-mode-old-local-map) (set-syntax-table hexl-mode-old-syntax-table) + (setq font-lock-defaults hexl-mode-old-font-lock-keywords) (setq major-mode hexl-mode-old-major-mode) (force-mode-line-update)) @@ -684,15 +698,6 @@ (apply 'call-process-region (point-min) (point-max) (expand-file-name hexl-program exec-directory) t t nil (split-string hexl-options)) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "^[0-9a-f]+:" nil t) - (put-text-property (match-beginning 0) (match-end 0) - 'font-lock-face 'hexl-address-area)) - (goto-char (point-min)) - (while (re-search-forward " \\(.+$\\)" nil t) - (put-text-property (match-beginning 1) (match-end 1) - 'font-lock-face 'hexl-ascii-area))) (if (> (point) (hexl-address-to-marker hexl-max-address)) (hexl-goto-address hexl-max-address))))
--- a/lisp/international/mule.el Thu Dec 23 16:43:51 2004 +0000 +++ b/lisp/international/mule.el Thu Jan 06 15:00:09 2005 +0000 @@ -1878,13 +1878,27 @@ (defun decode-coding-inserted-region (from to filename &optional visit beg end replace) "Decode the region between FROM and TO as if it is read from file FILENAME. +The idea is that the text between FROM and TO was just inserted somehow. Optional arguments VISIT, BEG, END, and REPLACE are the same as those -of the function `insert-file-contents'." +of the function `insert-file-contents'. +Part of the job of this function is setting `buffer-undo-list' appropriately." (save-excursion (save-restriction - (narrow-to-region from to) - (goto-char (point-min)) - (let ((coding coding-system-for-read)) + (let ((coding coding-system-for-read) + undo-list-saved) + (if visit + ;; Temporarily turn off undo recording, if we're decoding the + ;; text of a visited file. + (setq buffer-undo-list t) + ;; Otherwise, if we can recognize the undo elt for the insertion, + ;; remove it and get ready to replace it later. + ;; In the mean time, turn off undo recording. + (let ((last (car buffer-undo-list))) + (if (and (consp last) (eql (car last) from) (eql (cdr last) to)) + (setq undo-list-saved (cdr buffer-undo-list) + buffer-undo-list t)))) + (narrow-to-region from to) + (goto-char (point-min)) (or coding (setq coding (funcall set-auto-coding-function filename (- (point-max) (point-min))))) @@ -1899,7 +1913,16 @@ (setq coding nil)) (if coding (decode-coding-region (point-min) (point-max) coding) - (setq last-coding-system-used coding)))))) + (setq last-coding-system-used coding)) + ;; If we're decoding the text of a visited file, + ;; the undo list should start out empty. + (if visit + (setq buffer-undo-list nil) + ;; If we decided to replace the undo entry for the insertion, + ;; do so now. + (if undo-list-saved + (setq buffer-undo-list + (cons (cons from (point-max)) undo-list-saved)))))))) (defun make-translation-table (&rest args) "Make a translation table from arguments.
--- a/lisp/international/utf-8.el Thu Dec 23 16:43:51 2004 +0000 +++ b/lisp/international/utf-8.el Thu Jan 06 15:00:09 2005 +0000 @@ -305,26 +305,30 @@ ;; Load the files explicitly, to avoid having to keep ;; around the large tables they contain (as well as the ;; ones which get built). - (cond ((string= "Korean" current-language-environment) - (load "subst-jis") - (load "subst-big5") - (load "subst-gb2312") - (load "subst-ksc")) - ((string= "Chinese-BIG5" current-language-environment) - (load "subst-jis") - (load "subst-ksc") - (load "subst-gb2312") - (load "subst-big5")) - ((string= "Chinese-GB" current-language-environment) - (load "subst-jis") - (load "subst-ksc") - (load "subst-big5") - (load "subst-gb2312")) - (t - (load "subst-ksc") - (load "subst-gb2312") - (load "subst-big5") - (load "subst-jis"))) ; jis covers as much as big5, gb2312 + ;; Here we bind coding-system-for-read to nil so that coding tags + ;; in the files are respected even if the files are not yet + ;; byte-compiled + (let ((coding-system-for-read nil)) + (cond ((string= "Korean" current-language-environment) + (load "subst-jis") + (load "subst-big5") + (load "subst-gb2312") + (load "subst-ksc")) + ((string= "Chinese-BIG5" current-language-environment) + (load "subst-jis") + (load "subst-ksc") + (load "subst-gb2312") + (load "subst-big5")) + ((string= "Chinese-GB" current-language-environment) + (load "subst-jis") + (load "subst-ksc") + (load "subst-big5") + (load "subst-gb2312")) + (t + (load "subst-ksc") + (load "subst-gb2312") + (load "subst-big5") + (load "subst-jis")))) ; jis covers as much as big5, gb2312 (when redefined (define-translation-hash-table 'utf-subst-table-for-decode
--- a/lisp/loadup.el Thu Dec 23 16:43:51 2004 +0000 +++ b/lisp/loadup.el Thu Jan 06 15:00:09 2005 +0000 @@ -46,7 +46,8 @@ (message "Using load-path %s" load-path) ;; We don't want to have any undo records in the dumped Emacs. -(buffer-disable-undo "*scratch*") +(set-buffer "*scratch*") +(setq buffer-undo-list t) (load "emacs-lisp/byte-run") (load "emacs-lisp/backquote")
--- a/lisp/mail/rmail.el Thu Dec 23 16:43:51 2004 +0000 +++ b/lisp/mail/rmail.el Thu Jan 06 15:00:09 2005 +0000 @@ -3435,6 +3435,8 @@ (if (not from) (setq from user-mail-address)) (let ((tembuf (generate-new-buffer " sendmail temp")) (case-fold-search nil) + (mail-personal-alias-file + (or mail-alias-file mail-personal-alias-file)) (mailbuf rmail-buffer)) (unwind-protect (with-current-buffer tembuf
--- a/lisp/mail/smtpmail.el Thu Dec 23 16:43:51 2004 +0000 +++ b/lisp/mail/smtpmail.el Thu Jan 06 15:00:09 2005 +0000 @@ -523,7 +523,7 @@ (when (and cred mech) (cond ((eq mech 'cram-md5) - (smtpmail-send-command process (format "AUTH %s" mech)) + (smtpmail-send-command process (upcase (format "AUTH %s" mech))) (if (or (null (car (setq ret (smtpmail-read-response process)))) (not (integerp (car ret))) (>= (car ret) 400))
--- a/lisp/mouse.el Thu Dec 23 16:43:51 2004 +0000 +++ b/lisp/mouse.el Thu Jan 06 15:00:09 2005 +0000 @@ -754,7 +754,8 @@ If the click is in the echo area, display the `*Messages*' buffer." (interactive "e") - (let ((w (posn-window (event-start start-event)))) + (let ((w (posn-window (event-start start-event))) + (mouse-autoselect-window nil)) (if (not (or (not (window-minibuffer-p w)) (minibuffer-window-active-p w))) (save-excursion
--- a/lisp/net/goto-addr.el Thu Dec 23 16:43:51 2004 +0000 +++ b/lisp/net/goto-addr.el Thu Jan 06 15:00:09 2005 +0000 @@ -100,7 +100,7 @@ (defvar goto-address-mail-regexp ;; Actually pretty much any char could appear in the username part. -stef - "[-a-zA-Z0-9._+]+@\\([-a-zA-z0-9_]+\\.\\)+[a-zA-Z0-9]+" + "[-a-zA-Z0-9=._+]+@\\([-a-zA-z0-9_]+\\.\\)+[a-zA-Z0-9]+" "A regular expression probably matching an e-mail address.") (defvar goto-address-url-regexp
--- a/lisp/progmodes/compile.el Thu Dec 23 16:43:51 2004 +0000 +++ b/lisp/progmodes/compile.el Thu Jan 06 15:00:09 2005 +0000 @@ -1463,8 +1463,8 @@ ;; If the current buffer is a compilation buffer, return it. ;; Otherwise, look for a compilation buffer and signal an error ;; if there are none. -(defun compilation-find-buffer (&optional other-buffer) - (next-error-find-buffer other-buffer 'compilation-buffer-internal-p)) +(defun compilation-find-buffer (&optional avoid-current) + (next-error-find-buffer avoid-current 'compilation-buffer-internal-p)) ;;;###autoload (defun compilation-next-error-function (n &optional reset)
--- a/lisp/progmodes/cperl-mode.el Thu Dec 23 16:43:51 2004 +0000 +++ b/lisp/progmodes/cperl-mode.el Thu Jan 06 15:00:09 2005 +0000 @@ -6026,7 +6026,8 @@ (interactive) (let (found-bad (p (point))) (setq last-nonmenu-event 13) ; To disable popup - (beginning-of-buffer) + (with-no-warnings ; It is useful to push the mark here. + (beginning-of-buffer)) (map-y-or-n-p "Insert space here? " (lambda (arg) (insert " ")) 'cperl-next-bad-style @@ -7183,13 +7184,9 @@ ;;; Plug for wrong font-lock: (defun cperl-font-lock-unfontify-region-function (beg end) - (let* ((modified (buffer-modified-p)) (buffer-undo-list t) - (inhibit-read-only t) (inhibit-point-motion-hooks t) - before-change-functions after-change-functions - deactivate-mark buffer-file-name buffer-file-truename) - (remove-text-properties beg end '(face nil)) - (when (and (not modified) (buffer-modified-p)) - (set-buffer-modified-p nil)))) + ;; Simplified now that font-lock-unfontify-region uses save-buffer-state. + (let (before-change-functions after-change-functions) + (remove-text-properties beg end '(face nil)))) (defvar cperl-d-l nil) (defun cperl-fontify-syntaxically (end)
--- a/lisp/progmodes/hideshow.el Thu Dec 23 16:43:51 2004 +0000 +++ b/lisp/progmodes/hideshow.el Thu Jan 06 15:00:09 2005 +0000 @@ -5,7 +5,7 @@ ;; Author: Thien-Thi Nguyen <ttn@gnu.org> ;; Dan Nicolaescu <dann@ics.uci.edu> ;; Keywords: C C++ java lisp tools editing comments blocks hiding outlines -;; Maintainer-Version: 5.31 +;; Maintainer-Version: 5.58.2.3 ;; Time-of-Day-Author-Most-Likely-to-be-Recalcitrant: early morning ;; This file is part of GNU Emacs. @@ -58,7 +58,7 @@ ;; ;; (load-library "hideshow") ;; (add-hook 'X-mode-hook ; other modes similarly -;; '(lambda () (hs-minor-mode 1))) +;; (lambda () (hs-minor-mode 1))) ;; ;; where X = {emacs-lisp,c,c++,perl,...}. You can also manually toggle ;; hideshow minor mode by typing `M-x hs-minor-mode'. After hideshow is @@ -133,14 +133,24 @@ ;; variable `hs-special-modes-alist'. Packages that use hideshow should ;; do something like: ;; -;; (let ((my-mode-hs-info '(my-mode "{{" "}}" ...))) -;; (if (not (member my-mode-hs-info hs-special-modes-alist)) -;; (setq hs-special-modes-alist -;; (cons my-mode-hs-info hs-special-modes-alist)))) +;; (add-to-list 'hs-special-modes-alist '(my-mode "{{" "}}" ...)) ;; ;; If you have an entry that works particularly well, consider ;; submitting it for inclusion in hideshow.el. See docstring for ;; `hs-special-modes-alist' for more info on the entry format. +;; +;; See also variable `hs-set-up-overlay' for per-block customization of +;; appearance or other effects associated with overlays. For example: +;; +;; (setq hs-set-up-overlay +;; (defun my-display-code-line-counts (ov) +;; (when (eq 'code (overlay-get ov 'hs)) +;; (overlay-put ov 'display +;; (propertize +;; (format " ... <%d>" +;; (count-lines (overlay-start ov) +;; (overlay-end ov))) +;; 'face 'font-lock-type-face))))) ;; * Bugs ;; @@ -180,9 +190,9 @@ ;; In the case of `vc-diff', here is a less invasive workaround: ;; ;; (add-hook 'vc-before-checkin-hook -;; '(lambda () -;; (goto-char (point-min)) -;; (hs-show-block))) +;; (lambda () +;; (goto-char (point-min)) +;; (hs-show-block))) ;; ;; Unfortunately, these workarounds do not restore hideshow state. ;; If someone figures out a better way, please let me know. @@ -223,6 +233,7 @@ ;;; Code: (require 'easymenu) +(eval-when-compile (require 'cl)) ;;--------------------------------------------------------------------------- ;; user-configurable variables @@ -265,8 +276,7 @@ '((c-mode "{" "}" "/[*/]" nil hs-c-like-adjust-block-beginning) (c++-mode "{" "}" "/[*/]" nil hs-c-like-adjust-block-beginning) (bibtex-mode ("^@\\S(*\\(\\s(\\)" 1)) - (java-mode "{" "}" "/[*/]" nil hs-c-like-adjust-block-beginning) - ) + (java-mode "{" "}" "/[*/]" nil hs-c-like-adjust-block-beginning)) "*Alist for initializing the hideshow variables for different modes. Each element has the form (MODE START END COMMENT-START FORWARD-SEXP-FUNC ADJUST-BEG-FUNC). @@ -307,6 +317,24 @@ These commands include the toggling commands (when the result is to show a block), `hs-show-all' and `hs-show-block'..") +(defvar hs-set-up-overlay nil + "*Function called with one arg, OV, a newly initialized overlay. +Hideshow puts a unique overlay on each range of text to be hidden +in the buffer. Here is a simple example of how to use this variable: + + (defun display-code-line-counts (ov) + (when (eq 'code (overlay-get ov 'hs)) + (overlay-put ov 'display + (format \"... / %d\" + (count-lines (overlay-start ov) + (overlay-end ov)))))) + + (setq hs-set-up-overlay 'display-code-line-counts) + +This example shows how to get information from the overlay as well +as how to set its `display' property. See `hs-make-overlay' and +info node `(elisp)Overlays'.") + ;;--------------------------------------------------------------------------- ;; internal variables @@ -378,28 +406,6 @@ ;;--------------------------------------------------------------------------- ;; system dependency -; ;; xemacs compatibility -; (when (string-match "xemacs\\|lucid" emacs-version) -; ;; use pre-packaged compatiblity layer -; (require 'overlay)) -; -; ;; xemacs and emacs-19 compatibility -; (when (or (not (fboundp 'add-to-invisibility-spec)) -; (not (fboundp 'remove-from-invisibility-spec))) -; ;; `buffer-invisibility-spec' mutators snarfed from Emacs 20.3 lisp/subr.el -; (defun add-to-invisibility-spec (arg) -; (cond -; ((or (null buffer-invisibility-spec) (eq buffer-invisibility-spec t)) -; (setq buffer-invisibility-spec (list arg))) -; (t -; (setq buffer-invisibility-spec -; (cons arg buffer-invisibility-spec))))) -; (defun remove-from-invisibility-spec (arg) -; (when buffer-invisibility-spec -; (setq buffer-invisibility-spec -; (delete arg buffer-invisibility-spec))))) - -;; hs-match-data (defalias 'hs-match-data 'match-data) ;;--------------------------------------------------------------------------- @@ -409,12 +415,38 @@ "Delete hideshow overlays in region defined by FROM and TO." (when (< to from) (setq from (prog1 to (setq to from)))) - (let ((ovs (overlays-in from to))) - (while ovs - (let ((ov (car ovs))) - (when (overlay-get ov 'hs) - (delete-overlay ov))) - (setq ovs (cdr ovs))))) + (dolist (ov (overlays-in from to)) + (when (overlay-get ov 'hs) + (delete-overlay ov)))) + +(defun hs-make-overlay (b e kind &optional b-offset e-offset) + "Return a new overlay in region defined by B and E with type KIND. +KIND is either `code' or `comment'. Optional fourth arg B-OFFSET +when added to B specifies the actual buffer position where the block +begins. Likewise for optional fifth arg E-OFFSET. If unspecified +they are taken to be 0 (zero). The following properties are set +in the overlay: 'invisible 'hs 'hs-b-offset 'hs-e-offset. Also, +depending on variable `hs-isearch-open', the following properties may +be present: 'isearch-open-invisible 'isearch-open-invisible-temporary. +If variable `hs-set-up-overlay' is non-nil it should specify a function +to call with the newly initialized overlay." + (unless b-offset (setq b-offset 0)) + (unless e-offset (setq e-offset 0)) + (let ((ov (make-overlay b e)) + (io (if (eq 'block hs-isearch-open) + ;; backward compatibility -- `block'<=>`code' + 'code + hs-isearch-open))) + (overlay-put ov 'invisible 'hs) + (overlay-put ov 'hs kind) + (overlay-put ov 'hs-b-offset b-offset) + (overlay-put ov 'hs-e-offset e-offset) + (when (or (eq io t) (eq io kind)) + (overlay-put ov 'isearch-open-invisible 'hs-isearch-show) + (overlay-put ov 'isearch-open-invisible-temporary + 'hs-isearch-show-temporary)) + (when hs-set-up-overlay (funcall hs-set-up-overlay ov)) + ov)) (defun hs-isearch-show (ov) "Delete overlay OV, and set `hs-headline' to nil. @@ -433,43 +465,28 @@ This function is meant to be used as the `isearch-open-invisible-temporary' property of an overlay." (setq hs-headline - (if hide-p - nil - (or hs-headline - (let ((start (overlay-start ov))) - (buffer-substring - (save-excursion (goto-char start) - (beginning-of-line) - (skip-chars-forward " \t") - (point)) - start))))) + (if hide-p + nil + (or hs-headline + (let ((start (overlay-start ov))) + (buffer-substring + (save-excursion (goto-char start) + (beginning-of-line) + (skip-chars-forward " \t") + (point)) + start))))) (force-mode-line-update) + ;; handle `display' property specially + (let (value) + (if hide-p + (when (setq value (overlay-get ov 'hs-isearch-display)) + (overlay-put ov 'display value) + (overlay-put ov 'hs-isearch-display nil)) + (when (setq value (overlay-get ov 'display)) + (overlay-put ov 'hs-isearch-display value) + (overlay-put ov 'display nil)))) (overlay-put ov 'invisible (and hide-p 'hs))) -(defun hs-flag-region (from to flag) - "Hide or show lines from FROM to TO, according to FLAG. -If FLAG is nil then text is shown, while if FLAG is non-nil the text is -hidden. FLAG must be one of the symbols `code' or `comment', depending -on what kind of block is to be hidden." - (save-excursion - ;; first clear it all out - (hs-discard-overlays from to) - ;; now create overlays if needed - (when flag - (let ((overlay (make-overlay from to))) - (overlay-put overlay 'invisible 'hs) - (overlay-put overlay 'hs flag) - (when (or (eq hs-isearch-open t) - (eq hs-isearch-open flag) - ;; deprecated backward compatibility -- `block'<=>`code' - (and (eq 'block hs-isearch-open) - (eq 'code flag))) - (overlay-put overlay 'isearch-open-invisible 'hs-isearch-show) - (overlay-put overlay - 'isearch-open-invisible-temporary - 'hs-isearch-show-temporary)) - overlay)))) - (defun hs-forward-sexp (match-data arg) "Adjust point based on MATCH-DATA and call `hs-forward-sexp-func' w/ ARG. Original match data is restored upon return." @@ -481,9 +498,10 @@ (defun hs-hide-comment-region (beg end &optional repos-end) "Hide a region from BEG to END, marking it as a comment. Optional arg REPOS-END means reposition at end." - (hs-flag-region (progn (goto-char beg) (end-of-line) (point)) - (progn (goto-char end) (end-of-line) (point)) - 'comment) + (let ((beg-eol (progn (goto-char beg) (end-of-line) (point))) + (end-eol (progn (goto-char end) (end-of-line) (point)))) + (hs-discard-overlays beg-eol end-eol) + (hs-make-overlay beg-eol end-eol 'comment beg end)) (goto-char (if repos-end end beg))) (defun hs-hide-block-at-point (&optional end comment-reg) @@ -516,17 +534,16 @@ (end-of-line) (point)))) (when (and (< p (point)) (> (count-lines p q) 1)) - (overlay-put (hs-flag-region p q 'code) - 'hs-ofs - (- pure-p p))) + (hs-discard-overlays p q) + (hs-make-overlay p q 'code (- pure-p p))) (goto-char (if end q (min p pure-p))))))) (defun hs-safety-is-job-n () "Warn if `buffer-invisibility-spec' does not contain symbol `hs'." - (unless (and (listp buffer-invisibility-spec) - (assq 'hs buffer-invisibility-spec)) - (message "Warning: `buffer-invisibility-spec' does not contain hs!!") - (sit-for 2))) + (unless (and (listp buffer-invisibility-spec) + (assq 'hs buffer-invisibility-spec)) + (message "Warning: `buffer-invisibility-spec' does not contain hs!!") + (sit-for 2))) (defun hs-inside-comment-p () "Return non-nil if point is inside a comment, otherwise nil. @@ -543,10 +560,15 @@ (let ((q (point))) (when (or (looking-at hs-c-start-regexp) (re-search-backward hs-c-start-regexp (point-min) t)) + ;; first get to the beginning of this comment... + (while (and (not (bobp)) + (= (point) (progn (forward-comment -1) (point)))) + (forward-char -1)) + ;; ...then extend backwards (forward-comment (- (buffer-size))) (skip-chars-forward " \t\n\f") (let ((p (point)) - (not-hidable nil)) + (hidable t)) (beginning-of-line) (unless (looking-at (concat "[ \t]*" hs-c-start-regexp)) ;; we are in this situation: (example) @@ -565,19 +587,19 @@ (while (and (< (point) q) (> (point) p) (not (looking-at hs-c-start-regexp))) - (setq p (point));; use this to avoid an infinite cycle + (setq p (point)) ;; use this to avoid an infinite cycle (forward-comment 1) (skip-chars-forward " \t\n\f")) (when (or (not (looking-at hs-c-start-regexp)) (> (point) q)) ;; we cannot hide this comment block - (setq not-hidable t))) + (setq hidable nil))) ;; goto the end of the comment (forward-comment (buffer-size)) (skip-chars-backward " \t\n\f") (end-of-line) (when (>= (point) q) - (list (if not-hidable nil p) (point)))))))) + (list (and hidable p) (point)))))))) (defun hs-grok-mode-type () "Set up hideshow variables for new buffers. @@ -635,7 +657,7 @@ (setq minp (1+ (point))) (funcall hs-forward-sexp-func 1) (setq maxp (1- (point)))) - (hs-flag-region minp maxp nil) ; eliminate weirdness + (hs-discard-overlays minp maxp) ; eliminate weirdness (goto-char minp) (while (progn (forward-comment (buffer-size)) @@ -645,7 +667,7 @@ (hs-hide-level-recursive (1- arg) minp maxp) (goto-char (match-beginning hs-block-start-mdata-select)) (hs-hide-block-at-point t))) - (hs-safety-is-job-n) + (hs-safety-is-job-n) (goto-char maxp)) (defmacro hs-life-goes-on (&rest body) @@ -675,8 +697,8 @@ (let ((overlays (overlays-at (point))) (found nil)) (while (and (not found) (overlayp (car overlays))) - (setq found (overlay-get (car overlays) 'hs) - overlays (cdr overlays))) + (setq found (overlay-get (car overlays) 'hs) + overlays (cdr overlays))) found))) (defun hs-c-like-adjust-block-beginning (initial) @@ -701,7 +723,7 @@ (hs-life-goes-on (message "Hiding all blocks ...") (save-excursion - (hs-flag-region (point-min) (point-max) nil) ; eliminate weirdness + (hs-discard-overlays (point-min) (point-max)) ; eliminate weirdness (goto-char (point-min)) (let ((count 0) (re (concat "\\(" @@ -724,7 +746,7 @@ (funcall hs-hide-all-non-comment-function) (hs-hide-block-at-point t))) ;; found a comment, probably - (let ((c-reg (hs-inside-comment-p))) ; blech! + (let ((c-reg (hs-inside-comment-p))) ; blech! (when (and c-reg (car c-reg)) (if (> (count-lines (car c-reg) (nth 1 c-reg)) 1) (hs-hide-block-at-point t c-reg) @@ -740,7 +762,7 @@ (interactive) (hs-life-goes-on (message "Showing all blocks ...") - (hs-flag-region (point-min) (point-max) nil) + (hs-discard-overlays (point-min) (point-max)) (message "Showing all blocks ... done") (run-hooks 'hs-show-hook))) @@ -772,18 +794,15 @@ (or ;; first see if we have something at the end of the line (catch 'eol-begins-hidden-region-p - (let ((here (point)) - (ovs (save-excursion (end-of-line) (overlays-at (point))))) - (while ovs - (let ((ov (car ovs))) - (when (overlay-get ov 'hs) - (goto-char - (cond (end (overlay-end ov)) - ((eq 'comment (overlay-get ov 'hs)) here) - (t (+ (overlay-start ov) (overlay-get ov 'hs-ofs))))) - (delete-overlay ov) - (throw 'eol-begins-hidden-region-p t))) - (setq ovs (cdr ovs))) + (let ((here (point))) + (dolist (ov (save-excursion (end-of-line) (overlays-at (point)))) + (when (overlay-get ov 'hs) + (goto-char + (cond (end (overlay-end ov)) + ((eq 'comment (overlay-get ov 'hs)) here) + (t (+ (overlay-start ov) (overlay-get ov 'hs-b-offset))))) + (delete-overlay ov) + (throw 'eol-begins-hidden-region-p t))) nil)) ;; not immediately obvious, look for a suitable block (let ((c-reg (hs-inside-comment-p)) @@ -797,7 +816,7 @@ (setq p (point) q (progn (hs-forward-sexp (hs-match-data t) 1) (point))))) (when (and p q) - (hs-flag-region p q nil) + (hs-discard-overlays p q) (goto-char (if end q (1+ p))))) (hs-safety-is-job-n) (run-hooks 'hs-show-hook)))) @@ -870,9 +889,9 @@ (interactive "P") (setq hs-headline nil - hs-minor-mode (if (null arg) - (not hs-minor-mode) - (> (prefix-numeric-value arg) 0))) + hs-minor-mode (if (null arg) + (not hs-minor-mode) + (> (prefix-numeric-value arg) 0))) (if hs-minor-mode (progn (hs-grok-mode-type) @@ -912,27 +931,19 @@ ))))) ;; some housekeeping -(or (assq 'hs-minor-mode minor-mode-map-alist) - (setq minor-mode-map-alist - (cons (cons 'hs-minor-mode hs-minor-mode-map) - minor-mode-map-alist))) -(or (assq 'hs-minor-mode minor-mode-alist) - (setq minor-mode-alist (append minor-mode-alist - (list '(hs-minor-mode " hs"))))) +(add-to-list 'minor-mode-map-alist (cons 'hs-minor-mode hs-minor-mode-map)) +(add-to-list 'minor-mode-alist '(hs-minor-mode " hs") t) ;; make some variables permanently buffer-local -(let ((vars '(hs-minor-mode - hs-c-start-regexp - hs-block-start-regexp - hs-block-start-mdata-select - hs-block-end-regexp - hs-forward-sexp-func - hs-adjust-block-beginning))) - (while vars - (let ((var (car vars))) - (make-variable-buffer-local var) - (put var 'permanent-local t)) - (setq vars (cdr vars)))) +(dolist (var '(hs-minor-mode + hs-c-start-regexp + hs-block-start-regexp + hs-block-start-mdata-select + hs-block-end-regexp + hs-forward-sexp-func + hs-adjust-block-beginning)) + (make-variable-buffer-local var) + (put var 'permanent-local t)) ;;--------------------------------------------------------------------------- ;; that's it
--- a/lisp/simple.el Thu Dec 23 16:43:51 2004 +0000 +++ b/lisp/simple.el Thu Jan 06 15:00:09 2005 +0000 @@ -124,70 +124,87 @@ (make-variable-buffer-local 'next-error-function) (defsubst next-error-buffer-p (buffer - &optional + &optional avoid-current extra-test-inclusive extra-test-exclusive) "Test if BUFFER is a next-error capable buffer. -EXTRA-TEST-INCLUSIVE is called to allow extra buffers. -EXTRA-TEST-EXCLUSIVE is called to disallow buffers." - (with-current-buffer buffer - (or (and extra-test-inclusive (funcall extra-test-inclusive)) - (and (if extra-test-exclusive (funcall extra-test-exclusive) t) - next-error-function)))) - -(defun next-error-find-buffer (&optional other-buffer + +If AVOID-CURRENT is non-nil, treat the current buffer +as an absolute last resort only. + +The function EXTRA-TEST-INCLUSIVE, if non-nil, is called in each buffer +that normally would not qualify. If it returns t, the buffer +in question is treated as usable. + +The function EXTRA-TEST-EXCLUSIVE, if non-nil is called in each buffer +that would normally be considered usable. if it returns nil, +that buffer is rejected." + (and (buffer-name buffer) ;First make sure it's live. + (not (and avoid-current (eq buffer (current-buffer)))) + (with-current-buffer buffer + (if next-error-function ; This is the normal test. + ;; Optionally reject some buffers. + (if extra-test-exclusive + (funcall extra-test-exclusive) + t) + ;; Optionally accept some other buffers. + (and extra-test-inclusive + (funcall extra-test-inclusive)))))) + +(defun next-error-find-buffer (&optional avoid-current extra-test-inclusive extra-test-exclusive) "Return a next-error capable buffer. -OTHER-BUFFER will disallow the current buffer. -EXTRA-TEST-INCLUSIVE is called to allow extra buffers. -EXTRA-TEST-EXCLUSIVE is called to disallow buffers." +If AVOID-CURRENT is non-nil, treat the current buffer +as an absolute last resort only. + +The function EXTRA-TEST-INCLUSIVE, if non-nil, is called in each buffers +that normally would not qualify. If it returns t, the buffer +in question is treated as usable. + +The function EXTRA-TEST-EXCLUSIVE, if non-nil is called in each buffer +that would normally be considered usable. If it returns nil, +that buffer is rejected." (or ;; 1. If one window on the selected frame displays such buffer, return it. (let ((window-buffers (delete-dups (delq nil (mapcar (lambda (w) (if (next-error-buffer-p - (window-buffer w) + (window-buffer w) + avoid-current extra-test-inclusive extra-test-exclusive) (window-buffer w))) (window-list)))))) - (if other-buffer - (setq window-buffers (delq (current-buffer) window-buffers))) (if (eq (length window-buffers) 1) (car window-buffers))) - ;; 2. If next-error-last-buffer is set to a live buffer, use that. + ;; 2. If next-error-last-buffer is an acceptable buffer, use that. (if (and next-error-last-buffer - (buffer-name next-error-last-buffer) - (next-error-buffer-p next-error-last-buffer - extra-test-inclusive extra-test-exclusive) - (or (not other-buffer) - (not (eq next-error-last-buffer (current-buffer))))) + (next-error-buffer-p next-error-last-buffer avoid-current + extra-test-inclusive extra-test-exclusive)) next-error-last-buffer) - ;; 3. If the current buffer is a next-error capable buffer, return it. - (if (and (not other-buffer) - (next-error-buffer-p (current-buffer) - extra-test-inclusive extra-test-exclusive)) + ;; 3. If the current buffer is acceptable, choose it. + (if (next-error-buffer-p (current-buffer) avoid-current + extra-test-inclusive extra-test-exclusive) (current-buffer)) - ;; 4. Look for a next-error capable buffer in a buffer list. + ;; 4. Look for any acceptable buffer. (let ((buffers (buffer-list))) (while (and buffers - (or (not (next-error-buffer-p - (car buffers) - extra-test-inclusive extra-test-exclusive)) - (and other-buffer (eq (car buffers) (current-buffer))))) + (not (next-error-buffer-p + (car buffers) avoid-current + extra-test-inclusive extra-test-exclusive))) (setq buffers (cdr buffers))) - (if buffers - (car buffers) - (or (and other-buffer - (next-error-buffer-p (current-buffer) - extra-test-inclusive extra-test-exclusive) - ;; The current buffer is a next-error capable buffer. - (progn - (if other-buffer - (message "This is the only next-error capable buffer")) - (current-buffer))) - (error "No next-error capable buffer found")))))) + (car buffers)) + ;; 5. Use the current buffer as a last resort if it qualifies, + ;; even despite AVOID-CURRENT. + (and avoid-current + (next-error-buffer-p (current-buffer) nil + extra-test-inclusive extra-test-exclusive) + (progn + (message "This is the only next-error capable buffer") + (current-buffer))) + ;; 6. Give up. + (error "No next-error capable buffer found"))) (defun next-error (&optional arg reset) "Visit next next-error message and corresponding source code. @@ -1113,11 +1130,13 @@ nil minibuffer-local-map nil - 'minibuffer-history-search-history))) + 'minibuffer-history-search-history + (car minibuffer-history-search-history)))) ;; Use the last regexp specified, by default, if input is empty. (list (if (string= regexp "") - (setcar minibuffer-history-search-history - (nth 1 minibuffer-history-search-history)) + (if minibuffer-history-search-history + (car minibuffer-history-search-history) + (error "No previous history search regexp")) regexp) (prefix-numeric-value current-prefix-arg)))) (previous-matching-history-element regexp (- n))) @@ -1215,6 +1234,10 @@ (defvar undo-no-redo nil "If t, `undo' doesn't go through redo entries.") +(defvar undo-list-saved nil + "The value of `buffer-undo-list' saved by the last undo command.") +(make-variable-buffer-local 'undo-list-saved) + (defun undo (&optional arg) "Undo some previous changes. Repeat this command to undo more changes. @@ -1237,7 +1260,13 @@ ;; So set `this-command' to something other than `undo'. (setq this-command 'undo-start) - (unless (eq last-command 'undo) + (unless (and (eq last-command 'undo) + ;; If something (a timer or filter?) changed the buffer + ;; since the previous command, don't continue the undo seq. + (let ((list buffer-undo-list)) + (while (eq (car list) nil) + (setq list (cdr list))) + (eq undo-list-saved list))) (setq undo-in-region (if transient-mark-mode mark-active (and arg (not (numberp arg))))) (if undo-in-region @@ -1289,10 +1318,20 @@ (setq tail (cdr tail))) (setq tail nil))) (setq prev tail tail (cdr tail)))) - + ;; Record what the current undo list says, + ;; so the next command can tell if the buffer was modified in between. + (setq undo-list-saved buffer-undo-list) (and modified (not (buffer-modified-p)) (delete-auto-save-file-if-necessary recent-save)))) +(defun buffer-disable-undo (&optional buffer) + "Make BUFFER stop keeping undo information. +No argument or nil as argument means do this for the current buffer." + (interactive) + (with-current-buffer (get-buffer buffer) + (setq buffer-undo-list t + undo-list-saved nil))) + (defun undo-only (&optional arg) "Undo some previous changes. Repeat this command to undo more changes. @@ -1491,8 +1530,9 @@ ;; so it had better not do a lot of consing. (setq undo-outer-limit-function 'undo-outer-limit-truncate) (defun undo-outer-limit-truncate (size) - (if (yes-or-no-p (format "Buffer %s undo info is %d bytes long; discard it? " - (buffer-name) size)) + (if (let (use-dialog-box) + (yes-or-no-p (format "Buffer %s undo info is %d bytes long; discard it? " + (buffer-name) size))) (progn (setq buffer-undo-list nil) t) nil))
--- a/lisp/subr.el Thu Dec 23 16:43:51 2004 +0000 +++ b/lisp/subr.el Thu Jan 06 15:00:09 2005 +0000 @@ -823,7 +823,7 @@ (defalias 'unfocus-frame 'ignore "") -;;;; Obsolescence declarations for variables. +;;;; Obsolescence declarations for variables, and aliases. (make-obsolete-variable 'directory-sep-char "do not use it." "21.1") (make-obsolete-variable 'mode-line-inverse-video "use the appropriate faces instead." "21.1") @@ -840,6 +840,8 @@ (make-obsolete-variable 'x-lost-selection-hooks 'x-lost-selection-functions "21.4") (defvaralias 'x-sent-selection-hooks 'x-sent-selection-functions) (make-obsolete-variable 'x-sent-selection-hooks 'x-sent-selection-functions "21.4") + +(defvaralias 'messages-buffer-max-lines 'message-log-max) ;;;; Alternate names for functions - these are not being phased out. @@ -1012,19 +1014,33 @@ ;;; nil nil t) ;;; (setq symbol-file-load-history-loaded t))) -(defun symbol-file (function) - "Return the input source from which FUNCTION was loaded. +(defun symbol-file (symbol &optional type) + "Return the input source in which SYMBOL was defined. The value is normally a string that was passed to `load': either an absolute file name, or a library name \(with no directory name and no `.el' or `.elc' at the end). -It can also be nil, if the definition is not associated with any file." - (if (and (symbolp function) (fboundp function) - (eq 'autoload (car-safe (symbol-function function)))) - (nth 1 (symbol-function function)) +It can also be nil, if the definition is not associated with any file. + +If TYPE is nil, then any kind of definition is acceptable. +If type is `defun' or `defvar', that specifies function +definition only or variable definition only." + (if (and (or (null type) (eq type 'defun)) + (symbolp symbol) (fboundp symbol) + (eq 'autoload (car-safe (symbol-function symbol)))) + (nth 1 (symbol-function symbol)) (let ((files load-history) file) (while files - (if (member function (cdr (car files))) + (if (if type + (if (eq type 'defvar) + ;; Variables are present just as their names. + (member symbol (cdr (car files))) + ;; Other types are represented as (TYPE . NAME). + (member (cons type symbol) (cdr (car files)))) + ;; We accept all types, so look for variable def + ;; and then for any other kind. + (or (member symbol (cdr (car files))) + (rassq symbol (cdr (car files))))) (setq file (car (car files)) files nil)) (setq files (cdr files))) file)))
--- a/lisp/term/mac-win.el Thu Dec 23 16:43:51 2004 +0000 +++ b/lisp/term/mac-win.el Thu Jan 06 15:00:09 2005 +0000 @@ -1,8 +1,9 @@ -;;; mac-win.el --- support for "Macintosh windows" +;;; mac-win.el --- parse switches controlling interface with Mac window system -;; Copyright (C) 1999, 2000, 2002, 2003 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2002, 2003, 2004 Free Software Foundation, Inc. ;; Author: Andrew Choi <akochoi@mac.com> +;; Keywords: terminals ;; This file is part of GNU Emacs. @@ -23,634 +24,212 @@ ;;; Commentary: -;;; Code: - -;; --------------------------------------------------------------------------- -;; We want to delay setting frame parameters until the faces are setup - -;; Mac can't handle ~ prefix in file names -;(setq auto-save-list-file-prefix ".saves-") - -(setq frame-creation-function 'x-create-frame-with-faces) +;; Mac-win.el: this file is loaded from ../lisp/startup.el when it recognizes +;; that Mac windows are to be used. Command line switches are parsed and those +;; pertaining to Mac are processed and removed from the command line. The +;; Mac display is opened and hooks are set for popping up the initial window. -;; for debugging -;; (defun mac-handle-scroll-bar-event (event) (interactive "e") (princ event)) - -;;(global-set-key [vertical-scroll-bar mouse-1] 'mac-handle-scroll-bar-event) +;; startup.el will then examine startup files, and eventually call the hooks +;; which create the first window(s). -(global-set-key - [vertical-scroll-bar down-mouse-1] - 'mac-handle-scroll-bar-event) +;;; Code: + +;; These are the standard X switches from the Xt Initialize.c file of +;; Release 4. -(global-unset-key [vertical-scroll-bar drag-mouse-1]) -(global-unset-key [vertical-scroll-bar mouse-1]) - -(require 'scroll-bar) +;; Command line Resource Manager string -(defun mac-handle-scroll-bar-event (event) - "Handle scroll bar EVENT to emulate Mac Toolbox style scrolling." - (interactive "e") - (let* ((position (event-start event)) - (window (nth 0 position)) - (bar-part (nth 4 position))) - (select-window window) - (cond - ((eq bar-part 'up) - (goto-char (window-start window)) - (mac-scroll-down-line)) - ((eq bar-part 'above-handle) - (mac-scroll-down)) - ((eq bar-part 'handle) - (scroll-bar-drag event)) - ((eq bar-part 'below-handle) - (mac-scroll-up)) - ((eq bar-part 'down) - (goto-char (window-start window)) - (mac-scroll-up-line))))) - -(defun mac-scroll-ignore-events () - ;; Ignore confusing non-mouse events - (while (not (memq (car-safe (read-event)) - '(mouse-1 double-mouse-1 triple-mouse-1))) nil)) - -(defun mac-scroll-down () - (track-mouse - (mac-scroll-ignore-events) - (scroll-down))) +;; +rv *reverseVideo +;; +synchronous *synchronous +;; -background *background +;; -bd *borderColor +;; -bg *background +;; -bordercolor *borderColor +;; -borderwidth .borderWidth +;; -bw .borderWidth +;; -display .display +;; -fg *foreground +;; -fn *font +;; -font *font +;; -foreground *foreground +;; -geometry .geometry +;; -i .iconType +;; -itype .iconType +;; -iconic .iconic +;; -name .name +;; -reverse *reverseVideo +;; -rv *reverseVideo +;; -selectionTimeout .selectionTimeout +;; -synchronous *synchronous +;; -xrm -(defun mac-scroll-down-line () - (track-mouse - (mac-scroll-ignore-events) - (scroll-down 1))) - -(defun mac-scroll-up () - (track-mouse - (mac-scroll-ignore-events) - (scroll-up))) - -(defun mac-scroll-up-line () - (track-mouse - (mac-scroll-ignore-events) - (scroll-up 1))) +;; An alist of X options and the function which handles them. See +;; ../startup.el. -(defun xw-defined-colors (&optional frame) - "Internal function called by `defined-colors', which see." - (or frame (setq frame (selected-frame))) - (let ((all-colors x-colors) - (this-color nil) - (defined-colors nil)) - (while all-colors - (setq this-color (car all-colors) - all-colors (cdr all-colors)) - (and (color-supported-p this-color frame t) - (setq defined-colors (cons this-color defined-colors)))) - defined-colors)) - -;; Don't have this yet. -(fset 'x-get-resource 'ignore) +(if (not (eq window-system 'mac)) + (error "%s: Loading mac-win.el but not compiled for Mac" (invocation-name))) -(unless (eq system-type 'darwin) - ;; This variable specifies the Unix program to call (as a process) to - ;; deteremine the amount of free space on a file system (defaults to - ;; df). If it is not set to nil, ls-lisp will not work correctly - ;; unless an external application df is implemented on the Mac. - (setq directory-free-space-program nil) - - ;; Set this so that Emacs calls subprocesses with "sh" as shell to - ;; expand filenames Note no subprocess for the shell is actually - ;; started (see run_mac_command in sysdep.c). - (setq shell-file-name "sh")) - -;; X Window emulation in macterm.c is not complete enough to start a -;; frame without a minibuffer properly. Call this to tell ediff -;; library to use a single frame. -; (ediff-toggle-multiframe) +(require 'frame) +(require 'mouse) +(require 'scroll-bar) +(require 'faces) +;;(require 'select) +(require 'menu-bar) +(require 'fontset) +;;(require 'x-dnd) -;; 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))) +(defvar x-invocation-args) -(setq interprogram-paste-function - '(lambda () - (let ((clipboard (mac-paste-function))) - (if clipboard - (decode-coding-string clipboard selection-coding-system t))))) - -;; Don't show the frame name; that's redundant. -(setq-default mode-line-frame-identification " ") +(defvar x-command-line-resources nil) -(defun mac-drag-n-drop (event) - "Edit the files listed in the drag-n-drop event.\n\ -Switch to a buffer editing the last file dropped." - (interactive "e") - (save-excursion - ;; Make sure the drop target has positive co-ords - ;; before setting the selected frame - otherwise it - ;; won't work. <skx@tardis.ed.ac.uk> - (let* ((window (posn-window (event-start event))) - (coords (posn-x-y (event-start event))) - (x (car coords)) - (y (cdr coords))) - (if (and (> x 0) (> y 0)) - (set-frame-selected-window nil window)) - (mapcar - '(lambda (file) - (find-file - (decode-coding-string - file - (or file-name-coding-system - default-file-name-coding-system)))) - (car (cdr (cdr event))))) - (raise-frame) - (recenter))) +;; Handler for switches of the form "-switch value" or "-switch". +(defun x-handle-switch (switch) + (let ((aelt (assoc switch command-line-x-option-alist))) + (if aelt + (let ((param (nth 3 aelt)) + (value (nth 4 aelt))) + (if value + (setq default-frame-alist + (cons (cons param value) + default-frame-alist)) + (setq default-frame-alist + (cons (cons param + (car x-invocation-args)) + default-frame-alist) + x-invocation-args (cdr x-invocation-args))))))) -(global-set-key [drag-n-drop] 'mac-drag-n-drop) - -;; By checking whether the variable mac-ready-for-drag-n-drop has been -;; defined, the event loop in macterm.c can be informed that it can -;; now receive Finder drag and drop events. Files dropped onto the -;; Emacs application icon can only be processed when the initial frame -;; has been created: this is where the files should be opened. -(add-hook 'after-init-hook - '(lambda () - (defvar mac-ready-for-drag-n-drop t))) +;; Handler for switches of the form "-switch n" +(defun x-handle-numeric-switch (switch) + (let ((aelt (assoc switch command-line-x-option-alist))) + (if aelt + (let ((param (nth 3 aelt))) + (setq default-frame-alist + (cons (cons param + (string-to-int (car x-invocation-args))) + default-frame-alist) + x-invocation-args + (cdr x-invocation-args)))))) -; Define constant values to be set to mac-keyboard-text-encoding -(defconst kTextEncodingMacRoman 0) -(defconst kTextEncodingISOLatin1 513 "0x201") -(defconst kTextEncodingISOLatin2 514 "0x202") - - -(define-ccl-program ccl-encode-mac-roman-font - `(0 - (if (r0 != ,(charset-id 'ascii)) - (if (r0 <= ?\x8f) - (translate-character mac-roman-encoder r0 r1) - ((r1 <<= 7) - (r1 |= r2) - (translate-character mac-roman-encoder r0 r1))))) - "CCL program for Mac Roman font") +;; Handle options that apply to initial frame only +(defun x-handle-initial-switch (switch) + (let ((aelt (assoc switch command-line-x-option-alist))) + (if aelt + (let ((param (nth 3 aelt)) + (value (nth 4 aelt))) + (if value + (setq initial-frame-alist + (cons (cons param value) + initial-frame-alist)) + (setq initial-frame-alist + (cons (cons param + (car x-invocation-args)) + initial-frame-alist) + x-invocation-args (cdr x-invocation-args))))))) -(let - ((encoding-vector (make-vector 256 nil)) - (i 0) - (vec ;; mac-centraleurroman (128..255) -> UCS mapping - [ #x00C4 ;; 128:LATIN CAPITAL LETTER A WITH DIAERESIS - #x0100 ;; 129:LATIN CAPITAL LETTER A WITH MACRON - #x0101 ;; 130:LATIN SMALL LETTER A WITH MACRON - #x00C9 ;; 131:LATIN CAPITAL LETTER E WITH ACUTE - #x0104 ;; 132:LATIN CAPITAL LETTER A WITH OGONEK - #x00D6 ;; 133:LATIN CAPITAL LETTER O WITH DIAERESIS - #x00DC ;; 134:LATIN CAPITAL LETTER U WITH DIAERESIS - #x00E1 ;; 135:LATIN SMALL LETTER A WITH ACUTE - #x0105 ;; 136:LATIN SMALL LETTER A WITH OGONEK - #x010C ;; 137:LATIN CAPITAL LETTER C WITH CARON - #x00E4 ;; 138:LATIN SMALL LETTER A WITH DIAERESIS - #x010D ;; 139:LATIN SMALL LETTER C WITH CARON - #x0106 ;; 140:LATIN CAPITAL LETTER C WITH ACUTE - #x0107 ;; 141:LATIN SMALL LETTER C WITH ACUTE - #x00E9 ;; 142:LATIN SMALL LETTER E WITH ACUTE - #x0179 ;; 143:LATIN CAPITAL LETTER Z WITH ACUTE - #x017A ;; 144:LATIN SMALL LETTER Z WITH ACUTE - #x010E ;; 145:LATIN CAPITAL LETTER D WITH CARON - #x00ED ;; 146:LATIN SMALL LETTER I WITH ACUTE - #x010F ;; 147:LATIN SMALL LETTER D WITH CARON - #x0112 ;; 148:LATIN CAPITAL LETTER E WITH MACRON - #x0113 ;; 149:LATIN SMALL LETTER E WITH MACRON - #x0116 ;; 150:LATIN CAPITAL LETTER E WITH DOT ABOVE - #x00F3 ;; 151:LATIN SMALL LETTER O WITH ACUTE - #x0117 ;; 152:LATIN SMALL LETTER E WITH DOT ABOVE - #x00F4 ;; 153:LATIN SMALL LETTER O WITH CIRCUMFLEX - #x00F6 ;; 154:LATIN SMALL LETTER O WITH DIAERESIS - #x00F5 ;; 155:LATIN SMALL LETTER O WITH TILDE - #x00FA ;; 156:LATIN SMALL LETTER U WITH ACUTE - #x011A ;; 157:LATIN CAPITAL LETTER E WITH CARON - #x011B ;; 158:LATIN SMALL LETTER E WITH CARON - #x00FC ;; 159:LATIN SMALL LETTER U WITH DIAERESIS - #x2020 ;; 160:DAGGER - #x00B0 ;; 161:DEGREE SIGN - #x0118 ;; 162:LATIN CAPITAL LETTER E WITH OGONEK - #x00A3 ;; 163:POUND SIGN - #x00A7 ;; 164:SECTION SIGN - #x2022 ;; 165:BULLET - #x00B6 ;; 166:PILCROW SIGN - #x00DF ;; 167:LATIN SMALL LETTER SHARP S - #x00AE ;; 168:REGISTERED SIGN - #x00A9 ;; 169:COPYRIGHT SIGN - #x2122 ;; 170:TRADE MARK SIGN - #x0119 ;; 171:LATIN SMALL LETTER E WITH OGONEK - #x00A8 ;; 172:DIAERESIS - #x2260 ;; 173:NOT EQUAL TO - #x0123 ;; 174:LATIN SMALL LETTER G WITH CEDILLA - #x012E ;; 175:LATIN CAPITAL LETTER I WITH OGONEK - #x012F ;; 176:LATIN SMALL LETTER I WITH OGONEK - #x012A ;; 177:LATIN CAPITAL LETTER I WITH MACRON - #x2264 ;; 178:LESS-THAN OR EQUAL TO - #x2265 ;; 179:GREATER-THAN OR EQUAL TO - #x012B ;; 180:LATIN SMALL LETTER I WITH MACRON - #x0136 ;; 181:LATIN CAPITAL LETTER K WITH CEDILLA - #x2202 ;; 182:PARTIAL DIFFERENTIAL - #x2211 ;; 183:N-ARY SUMMATION - #x0142 ;; 184:LATIN SMALL LETTER L WITH STROKE - #x013B ;; 185:LATIN CAPITAL LETTER L WITH CEDILLA - #x013C ;; 186:LATIN SMALL LETTER L WITH CEDILLA - #x013D ;; 187:LATIN CAPITAL LETTER L WITH CARON - #x013E ;; 188:LATIN SMALL LETTER L WITH CARON - #x0139 ;; 189:LATIN CAPITAL LETTER L WITH ACUTE - #x013A ;; 190:LATIN SMALL LETTER L WITH ACUTE - #x0145 ;; 191:LATIN CAPITAL LETTER N WITH CEDILLA - #x0146 ;; 192:LATIN SMALL LETTER N WITH CEDILLA - #x0143 ;; 193:LATIN CAPITAL LETTER N WITH ACUTE - #x00AC ;; 194:NOT SIGN - #x221A ;; 195:SQUARE ROOT - #x0144 ;; 196:LATIN SMALL LETTER N WITH ACUTE - #x0147 ;; 197:LATIN CAPITAL LETTER N WITH CARON - #x2206 ;; 198:INCREMENT - #x00AB ;; 199:LEFT-POINTING DOUBLE ANGLE QUOTATION MARK - #x00BB ;; 200:RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK - #x2026 ;; 201:HORIZONTAL ELLIPSIS - #x00A0 ;; 202:NO-BREAK SPACE - #x0148 ;; 203:LATIN SMALL LETTER N WITH CARON - #x0150 ;; 204:LATIN CAPITAL LETTER O WITH DOUBLE ACUTE - #x00D5 ;; 205:LATIN CAPITAL LETTER O WITH TILDE - #x0151 ;; 206:LATIN SMALL LETTER O WITH DOUBLE ACUTE - #x014C ;; 207:LATIN CAPITAL LETTER O WITH MACRON - #x2013 ;; 208:EN DASH - #x2014 ;; 209:EM DASH - #x201C ;; 210:LEFT DOUBLE QUOTATION MARK - #x201D ;; 211:RIGHT DOUBLE QUOTATION MARK - #x2018 ;; 212:LEFT SINGLE QUOTATION MARK - #x2019 ;; 213:RIGHT SINGLE QUOTATION MARK - #x00F7 ;; 214:DIVISION SIGN - #x25CA ;; 215:LOZENGE - #x014D ;; 216:LATIN SMALL LETTER O WITH MACRON - #x0154 ;; 217:LATIN CAPITAL LETTER R WITH ACUTE - #x0155 ;; 218:LATIN SMALL LETTER R WITH ACUTE - #x0158 ;; 219:LATIN CAPITAL LETTER R WITH CARON - #x2039 ;; 220:SINGLE LEFT-POINTING ANGLE QUOTATION MARK - #x203A ;; 221:SINGLE RIGHT-POINTING ANGLE QUOTATION MARK - #x0159 ;; 222:LATIN SMALL LETTER R WITH CARON - #x0156 ;; 223:LATIN CAPITAL LETTER R WITH CEDILLA - #x0157 ;; 224:LATIN SMALL LETTER R WITH CEDILLA - #x0160 ;; 225:LATIN CAPITAL LETTER S WITH CARON - #x201A ;; 226:SINGLE LOW-9 QUOTATION MARK - #x201E ;; 227:DOUBLE LOW-9 QUOTATION MARK - #x0161 ;; 228:LATIN SMALL LETTER S WITH CARON - #x015A ;; 229:LATIN CAPITAL LETTER S WITH ACUTE - #x015B ;; 230:LATIN SMALL LETTER S WITH ACUTE - #x00C1 ;; 231:LATIN CAPITAL LETTER A WITH ACUTE - #x0164 ;; 232:LATIN CAPITAL LETTER T WITH CARON - #x0165 ;; 233:LATIN SMALL LETTER T WITH CARON - #x00CD ;; 234:LATIN CAPITAL LETTER I WITH ACUTE - #x017D ;; 235:LATIN CAPITAL LETTER Z WITH CARON - #x017E ;; 236:LATIN SMALL LETTER Z WITH CARON - #x016A ;; 237:LATIN CAPITAL LETTER U WITH MACRON - #x00D3 ;; 238:LATIN CAPITAL LETTER O WITH ACUTE - #x00D4 ;; 239:LATIN CAPITAL LETTER O WITH CIRCUMFLEX - #x016B ;; 240:LATIN SMALL LETTER U WITH MACRON - #x016E ;; 241:LATIN CAPITAL LETTER U WITH RING ABOVE - #x00DA ;; 242:LATIN CAPITAL LETTER U WITH ACUTE - #x016F ;; 243:LATIN SMALL LETTER U WITH RING ABOVE - #x0170 ;; 244:LATIN CAPITAL LETTER U WITH DOUBLE ACUTE - #x0171 ;; 245:LATIN SMALL LETTER U WITH DOUBLE ACUTE - #x0172 ;; 246:LATIN CAPITAL LETTER U WITH OGONEK - #x0173 ;; 247:LATIN SMALL LETTER U WITH OGONEK - #x00DD ;; 248:LATIN CAPITAL LETTER Y WITH ACUTE - #x00FD ;; 249:LATIN SMALL LETTER Y WITH ACUTE - #x0137 ;; 250:LATIN SMALL LETTER K WITH CEDILLA - #x017B ;; 251:LATIN CAPITAL LETTER Z WITH DOT ABOVE - #x0141 ;; 252:LATIN CAPITAL LETTER L WITH STROKE - #x017C ;; 253:LATIN SMALL LETTER Z WITH DOT ABOVE - #x0122 ;; 254:LATIN CAPITAL LETTER G WITH CEDILLA - #x02C7 ;; 255:CARON - ]) - translation-table) - (while (< i 128) - (aset encoding-vector i i) - (setq i (1+ i))) - (while (< i 256) - (aset encoding-vector i - (decode-char 'ucs (aref vec (- i 128)))) - (setq i (1+ i))) - (setq translation-table - (make-translation-table-from-vector encoding-vector)) -;; (define-translation-table 'mac-centraleurroman-decoder translation-table) - (define-translation-table 'mac-centraleurroman-encoder - (char-table-extra-slot translation-table 0))) +;; Make -iconic apply only to the initial frame! +(defun x-handle-iconic (switch) + (setq initial-frame-alist + (cons '(visibility . icon) initial-frame-alist))) + +;; Handle the -xrm option. +(defun x-handle-xrm-switch (switch) + (unless (consp x-invocation-args) + (error "%s: missing argument to `%s' option" (invocation-name) switch)) + (setq x-command-line-resources + (if (null x-command-line-resources) + (car x-invocation-args) + (concat x-command-line-resources "\n" (car x-invocation-args)))) + (setq x-invocation-args (cdr x-invocation-args))) + +;; Handle the geometry option +(defun x-handle-geometry (switch) + (let* ((geo (x-parse-geometry (car x-invocation-args))) + (left (assq 'left geo)) + (top (assq 'top geo)) + (height (assq 'height geo)) + (width (assq 'width geo))) + (if (or height width) + (setq default-frame-alist + (append default-frame-alist + '((user-size . t)) + (if height (list height)) + (if width (list width))) + initial-frame-alist + (append initial-frame-alist + '((user-size . t)) + (if height (list height)) + (if width (list width))))) + (if (or left top) + (setq initial-frame-alist + (append initial-frame-alist + '((user-position . t)) + (if left (list left)) + (if top (list top))))) + (setq x-invocation-args (cdr x-invocation-args)))) + +;; Handle the -name option. Set the variable x-resource-name +;; to the option's operand; set the name of +;; the initial frame, too. +(defun x-handle-name-switch (switch) + (or (consp x-invocation-args) + (error "%s: missing argument to `%s' option" (invocation-name) switch)) + (setq x-resource-name (car x-invocation-args) + x-invocation-args (cdr x-invocation-args)) + (setq initial-frame-alist (cons (cons 'name x-resource-name) + initial-frame-alist))) -(let - ((encoding-vector (make-vector 256 nil)) - (i 0) - (vec ;; mac-cyrillic (128..255) -> UCS mapping - [ #x0410 ;; 128:CYRILLIC CAPITAL LETTER A - #x0411 ;; 129:CYRILLIC CAPITAL LETTER BE - #x0412 ;; 130:CYRILLIC CAPITAL LETTER VE - #x0413 ;; 131:CYRILLIC CAPITAL LETTER GHE - #x0414 ;; 132:CYRILLIC CAPITAL LETTER DE - #x0415 ;; 133:CYRILLIC CAPITAL LETTER IE - #x0416 ;; 134:CYRILLIC CAPITAL LETTER ZHE - #x0417 ;; 135:CYRILLIC CAPITAL LETTER ZE - #x0418 ;; 136:CYRILLIC CAPITAL LETTER I - #x0419 ;; 137:CYRILLIC CAPITAL LETTER SHORT I - #x041A ;; 138:CYRILLIC CAPITAL LETTER KA - #x041B ;; 139:CYRILLIC CAPITAL LETTER EL - #x041C ;; 140:CYRILLIC CAPITAL LETTER EM - #x041D ;; 141:CYRILLIC CAPITAL LETTER EN - #x041E ;; 142:CYRILLIC CAPITAL LETTER O - #x041F ;; 143:CYRILLIC CAPITAL LETTER PE - #x0420 ;; 144:CYRILLIC CAPITAL LETTER ER - #x0421 ;; 145:CYRILLIC CAPITAL LETTER ES - #x0422 ;; 146:CYRILLIC CAPITAL LETTER TE - #x0423 ;; 147:CYRILLIC CAPITAL LETTER U - #x0424 ;; 148:CYRILLIC CAPITAL LETTER EF - #x0425 ;; 149:CYRILLIC CAPITAL LETTER HA - #x0426 ;; 150:CYRILLIC CAPITAL LETTER TSE - #x0427 ;; 151:CYRILLIC CAPITAL LETTER CHE - #x0428 ;; 152:CYRILLIC CAPITAL LETTER SHA - #x0429 ;; 153:CYRILLIC CAPITAL LETTER SHCHA - #x042A ;; 154:CYRILLIC CAPITAL LETTER HARD SIGN - #x042B ;; 155:CYRILLIC CAPITAL LETTER YERU - #x042C ;; 156:CYRILLIC CAPITAL LETTER SOFT SIGN - #x042D ;; 157:CYRILLIC CAPITAL LETTER E - #x042E ;; 158:CYRILLIC CAPITAL LETTER YU - #x042F ;; 159:CYRILLIC CAPITAL LETTER YA - #x2020 ;; 160:DAGGER - #x00B0 ;; 161:DEGREE SIGN - #x0490 ;; 162:CYRILLIC CAPITAL LETTER GHE WITH UPTURN - #x00A3 ;; 163:POUND SIGN - #x00A7 ;; 164:SECTION SIGN - #x2022 ;; 165:BULLET - #x00B6 ;; 166:PILCROW SIGN - #x0406 ;; 167:CYRILLIC CAPITAL LETTER BYELORUSSIAN-UKRAINIAN I - #x00AE ;; 168:REGISTERED SIGN - #x00A9 ;; 169:COPYRIGHT SIGN - #x2122 ;; 170:TRADE MARK SIGN - #x0402 ;; 171:CYRILLIC CAPITAL LETTER DJE - #x0452 ;; 172:CYRILLIC SMALL LETTER DJE - #x2260 ;; 173:NOT EQUAL TO - #x0403 ;; 174:CYRILLIC CAPITAL LETTER GJE - #x0453 ;; 175:CYRILLIC SMALL LETTER GJE - #x221E ;; 176:INFINITY - #x00B1 ;; 177:PLUS-MINUS SIGN - #x2264 ;; 178:LESS-THAN OR EQUAL TO - #x2265 ;; 179:GREATER-THAN OR EQUAL TO - #x0456 ;; 180:CYRILLIC SMALL LETTER BYELORUSSIAN-UKRAINIAN I - #x00B5 ;; 181:MICRO SIGN - #x0491 ;; 182:CYRILLIC SMALL LETTER GHE WITH UPTURN - #x0408 ;; 183:CYRILLIC CAPITAL LETTER JE - #x0404 ;; 184:CYRILLIC CAPITAL LETTER UKRAINIAN IE - #x0454 ;; 185:CYRILLIC SMALL LETTER UKRAINIAN IE - #x0407 ;; 186:CYRILLIC CAPITAL LETTER YI - #x0457 ;; 187:CYRILLIC SMALL LETTER YI - #x0409 ;; 188:CYRILLIC CAPITAL LETTER LJE - #x0459 ;; 189:CYRILLIC SMALL LETTER LJE - #x040A ;; 190:CYRILLIC CAPITAL LETTER NJE - #x045A ;; 191:CYRILLIC SMALL LETTER NJE - #x0458 ;; 192:CYRILLIC SMALL LETTER JE - #x0405 ;; 193:CYRILLIC CAPITAL LETTER DZE - #x00AC ;; 194:NOT SIGN - #x221A ;; 195:SQUARE ROOT - #x0192 ;; 196:LATIN SMALL LETTER F WITH HOOK - #x2248 ;; 197:ALMOST EQUAL TO - #x2206 ;; 198:INCREMENT - #x00AB ;; 199:LEFT-POINTING DOUBLE ANGLE QUOTATION MARK - #x00BB ;; 200:RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK - #x2026 ;; 201:HORIZONTAL ELLIPSIS - #x00A0 ;; 202:NO-BREAK SPACE - #x040B ;; 203:CYRILLIC CAPITAL LETTER TSHE - #x045B ;; 204:CYRILLIC SMALL LETTER TSHE - #x040C ;; 205:CYRILLIC CAPITAL LETTER KJE - #x045C ;; 206:CYRILLIC SMALL LETTER KJE - #x0455 ;; 207:CYRILLIC SMALL LETTER DZE - #x2013 ;; 208:EN DASH - #x2014 ;; 209:EM DASH - #x201C ;; 210:LEFT DOUBLE QUOTATION MARK - #x201D ;; 211:RIGHT DOUBLE QUOTATION MARK - #x2018 ;; 212:LEFT SINGLE QUOTATION MARK - #x2019 ;; 213:RIGHT SINGLE QUOTATION MARK - #x00F7 ;; 214:DIVISION SIGN - #x201E ;; 215:DOUBLE LOW-9 QUOTATION MARK - #x040E ;; 216:CYRILLIC CAPITAL LETTER SHORT U - #x045E ;; 217:CYRILLIC SMALL LETTER SHORT U - #x040F ;; 218:CYRILLIC CAPITAL LETTER DZHE - #x045F ;; 219:CYRILLIC SMALL LETTER DZHE - #x2116 ;; 220:NUMERO SIGN - #x0401 ;; 221:CYRILLIC CAPITAL LETTER IO - #x0451 ;; 222:CYRILLIC SMALL LETTER IO - #x044F ;; 223:CYRILLIC SMALL LETTER YA - #x0430 ;; 224:CYRILLIC SMALL LETTER A - #x0431 ;; 225:CYRILLIC SMALL LETTER BE - #x0432 ;; 226:CYRILLIC SMALL LETTER VE - #x0433 ;; 227:CYRILLIC SMALL LETTER GHE - #x0434 ;; 228:CYRILLIC SMALL LETTER DE - #x0435 ;; 229:CYRILLIC SMALL LETTER IE - #x0436 ;; 230:CYRILLIC SMALL LETTER ZHE - #x0437 ;; 231:CYRILLIC SMALL LETTER ZE - #x0438 ;; 232:CYRILLIC SMALL LETTER I - #x0439 ;; 233:CYRILLIC SMALL LETTER SHORT I - #x043A ;; 234:CYRILLIC SMALL LETTER KA - #x043B ;; 235:CYRILLIC SMALL LETTER EL - #x043C ;; 236:CYRILLIC SMALL LETTER EM - #x043D ;; 237:CYRILLIC SMALL LETTER EN - #x043E ;; 238:CYRILLIC SMALL LETTER O - #x043F ;; 239:CYRILLIC SMALL LETTER PE - #x0440 ;; 240:CYRILLIC SMALL LETTER ER - #x0441 ;; 241:CYRILLIC SMALL LETTER ES - #x0442 ;; 242:CYRILLIC SMALL LETTER TE - #x0443 ;; 243:CYRILLIC SMALL LETTER U - #x0444 ;; 244:CYRILLIC SMALL LETTER EF - #x0445 ;; 245:CYRILLIC SMALL LETTER HA - #x0446 ;; 246:CYRILLIC SMALL LETTER TSE - #x0447 ;; 247:CYRILLIC SMALL LETTER CHE - #x0448 ;; 248:CYRILLIC SMALL LETTER SHA - #x0449 ;; 249:CYRILLIC SMALL LETTER SHCHA - #x044A ;; 250:CYRILLIC SMALL LETTER HARD SIGN - #x044B ;; 251:CYRILLIC SMALL LETTER YERU - #x044C ;; 252:CYRILLIC SMALL LETTER SOFT SIGN - #x044D ;; 253:CYRILLIC SMALL LETTER E - #x044E ;; 254:CYRILLIC SMALL LETTER YU - #x20AC ;; 255:EURO SIGN - ]) - translation-table) - (while (< i 128) - (aset encoding-vector i i) - (setq i (1+ i))) - (while (< i 256) - (aset encoding-vector i - (decode-char 'ucs (aref vec (- i 128)))) - (setq i (1+ i))) - (setq translation-table - (make-translation-table-from-vector encoding-vector)) -;; (define-translation-table 'mac-cyrillic-decoder translation-table) - (define-translation-table 'mac-cyrillic-encoder - (char-table-extra-slot translation-table 0))) +(defvar x-display-name nil + "The display name specifying server and frame.") + +(defun x-handle-display (switch) + (setq x-display-name (car x-invocation-args) + x-invocation-args (cdr x-invocation-args))) -(defvar mac-font-encoder-list - '(("mac-roman" mac-roman-encoder - ccl-encode-mac-roman-font "%s") - ("mac-centraleurroman" mac-centraleurroman-encoder - ccl-encode-mac-centraleurroman-font "%s ce") - ("mac-cyrillic" mac-cyrillic-encoder - ccl-encode-mac-cyrillic-font "%s cy"))) - -(let ((encoder-list - (mapcar (lambda (lst) (nth 1 lst)) mac-font-encoder-list)) - (charset-list - '(latin-iso8859-2 - latin-iso8859-3 latin-iso8859-4 - cyrillic-iso8859-5 greek-iso8859-7 hebrew-iso8859-8 - latin-iso8859-9 latin-iso8859-14 latin-iso8859-15))) - (dolist (encoder encoder-list) - (let ((table (get encoder 'translation-table))) - (dolist (charset charset-list) - (dotimes (i 96) - (let* ((c (make-char charset (+ i 32))) - (mu (aref ucs-mule-to-mule-unicode c)) - (mac-encoded (and mu (aref table mu)))) - (if mac-encoded - (aset table c mac-encoded)))))))) - -(define-ccl-program ccl-encode-mac-centraleurroman-font - `(0 - (if (r0 != ,(charset-id 'ascii)) - (if (r0 <= ?\x8f) - (translate-character mac-centraleurroman-encoder r0 r1) - ((r1 <<= 7) - (r1 |= r2) - (translate-character mac-centraleurroman-encoder r0 r1))))) - "CCL program for Mac Central European Roman font") - -(define-ccl-program ccl-encode-mac-cyrillic-font - `(0 - (if (r0 != ,(charset-id 'ascii)) - (if (r0 <= ?\x8f) - (translate-character mac-cyrillic-encoder r0 r1) - ((r1 <<= 7) - (r1 |= r2) - (translate-character mac-cyrillic-encoder r0 r1))))) - "CCL program for Mac Cyrillic font") - - -(setq font-ccl-encoder-alist - (nconc - (mapcar (lambda (lst) (cons (nth 0 lst) (nth 2 lst))) - mac-font-encoder-list) - font-ccl-encoder-alist)) - -(defun fontset-add-mac-fonts (fontset &optional base-family) - (if base-family - (setq base-family (downcase base-family)) - (let ((ascii-font - (downcase (x-resolve-font-name - (fontset-font fontset (charset-id 'ascii)))))) - (setq base-family (aref (x-decompose-font-name ascii-font) - xlfd-regexp-family-subnum)))) -;; (if (not (string-match "^fontset-" fontset)) -;; (setq fontset -;; (concat "fontset-" (aref (x-decompose-font-name fontset) -;; xlfd-regexp-encoding-subnum)))) - (dolist - (font-encoder - (nreverse - (mapcar (lambda (lst) - (cons (cons (format (nth 3 lst) base-family) (nth 0 lst)) - (nth 1 lst))) - mac-font-encoder-list))) - (let ((font (car font-encoder)) - (encoder (cdr font-encoder))) - (map-char-table - (lambda (key val) - (or (null val) - (generic-char-p key) - (memq (char-charset key) - '(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. - -Optional 1st arg RESOLVED-FONT is a resolved name of FONT. If -omitted, `x-resolve-font-name' is called to get the resolved name. At -this time, if FONT is not available, error is signaled. - -Optional 2nd arg FONTSET-NAME is a string to be used in -`<CHARSET_ENCODING>' fields of a new fontset name. If it is omitted, -an appropriate name is generated automatically. - -It returns a name of the created fontset." - (let ((fontset - (create-fontset-from-ascii-font font resolved-font fontset-name))) - (fontset-add-mac-fonts fontset) - fontset)) - -;; Create a fontset that uses mac-roman font. With this fontset, -;; characters decoded from mac-roman encoding (ascii, latin-iso8859-1, -;; and mule-unicode-xxxx-yyyy) are displayed by a mac-roman font. - -(if (fboundp 'new-fontset) - (progn - (require 'fontset) - (setup-default-fontset) - (create-fontset-from-fontset-spec - "-etl-fixed-medium-r-normal-*-16-*-*-*-*-*-fontset-mac, -ascii:-*-Monaco-*-*-*-*-12-*-*-*-*-*-mac-roman") - (fontset-add-mac-fonts "fontset-mac"))) - -(if (eq system-type 'darwin) - ;; On Darwin filenames are encoded in UTF-8 - (setq file-name-coding-system 'utf-8) - ;; To display filenames in Chinese or Japanese, replace mac-roman with - ;; big5 or sjis - (setq file-name-coding-system 'mac-roman)) - -;; If Emacs is started from the Finder, change the default directory -;; to the user's home directory. -(if (string= default-directory "/") - (cd "~")) - -;; Tell Emacs to use pipes instead of pty's for processes because the -;; latter sometimes lose characters. Pty support is compiled in since -;; ange-ftp will not work without it. -(setq process-connection-type nil) - -;; Assume that fonts are always scalable on the Mac. This sometimes -;; results in characters with jagged edges. However, without it, -;; fonts with both truetype and bitmap representations but no italic -;; or bold bitmap versions will not display these variants correctly. -(setq scalable-fonts-allowed t) - -;; Make suspend-emacs [C-z] collapse the current frame -(substitute-key-definition 'suspend-emacs 'iconify-frame - global-map) - -;; Support mouse-wheel scrolling -(mouse-wheel-mode 1) - -;; (prefer-coding-system 'mac-roman) - -;; Map certain keypad keys into ASCII characters that people usually expect -(define-key function-key-map [return] [?\C-m]) -(define-key function-key-map [M-return] [?\M-\C-m]) -(define-key function-key-map [tab] [?\t]) -(define-key function-key-map [M-tab] [?\M-\t]) -(define-key function-key-map [backspace] [127]) -(define-key function-key-map [M-backspace] [?\M-\d]) -(define-key function-key-map [escape] [?\e]) -(define-key function-key-map [M-escape] [?\M-\e]) - -;; Tell read-char how to convert special chars to ASCII -(put 'return 'ascii-character 13) -(put 'tab 'ascii-character ?\t) -(put 'backspace 'ascii-character 127) -(put 'escape 'ascii-character ?\e) - +(defun x-handle-args (args) + "Process the X-related command line options in ARGS. +This is done before the user's startup file is loaded. They are copied to +`x-invocation-args', from which the X-related things are extracted, first +the switch (e.g., \"-fg\") in the following code, and possible values +\(e.g., \"black\") in the option handler code (e.g., x-handle-switch). +This function returns ARGS minus the arguments that have been processed." + ;; We use ARGS to accumulate the args that we don't handle here, to return. + (setq x-invocation-args args + args nil) + (while (and x-invocation-args + (not (equal (car x-invocation-args) "--"))) + (let* ((this-switch (car x-invocation-args)) + (orig-this-switch this-switch) + completion argval aelt handler) + (setq x-invocation-args (cdr x-invocation-args)) + ;; Check for long options with attached arguments + ;; and separate out the attached option argument into argval. + (if (string-match "^--[^=]*=" this-switch) + (setq argval (substring this-switch (match-end 0)) + this-switch (substring this-switch 0 (1- (match-end 0))))) + ;; Complete names of long options. + (if (string-match "^--" this-switch) + (progn + (setq completion (try-completion this-switch command-line-x-option-alist)) + (if (eq completion t) + ;; Exact match for long option. + nil + (if (stringp completion) + (let ((elt (assoc completion command-line-x-option-alist))) + ;; Check for abbreviated long option. + (or elt + (error "Option `%s' is ambiguous" this-switch)) + (setq this-switch completion)))))) + (setq aelt (assoc this-switch command-line-x-option-alist)) + (if aelt (setq handler (nth 2 aelt))) + (if handler + (if argval + (let ((x-invocation-args + (cons argval x-invocation-args))) + (funcall handler this-switch)) + (funcall handler this-switch)) + (setq args (cons orig-this-switch args))))) + (nconc (nreverse args) x-invocation-args)) + ;; ;; Available colors ;; @@ -1407,8 +986,723 @@ "GhostWhite" "ghost white" "snow") - "The list of X colors from the `rgb.txt' file. + "The list of X colors from the `rgb.txt' file. XConsortium: rgb.txt,v 10.41 94/02/20 18:39:36 rws Exp") +(defun xw-defined-colors (&optional frame) + "Internal function called by `defined-colors', which see." + (or frame (setq frame (selected-frame))) + (let ((all-colors x-colors) + (this-color nil) + (defined-colors nil)) + (while all-colors + (setq this-color (car all-colors) + all-colors (cdr all-colors)) + (and (color-supported-p this-color frame t) + (setq defined-colors (cons this-color defined-colors)))) + defined-colors)) + +;;;; Function keys + +(substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame + global-map) + +;; Map certain keypad keys into ASCII characters +;; that people usually expect. +(define-key function-key-map [return] [?\C-m]) +(define-key function-key-map [M-return] [?\M-\C-m]) +(define-key function-key-map [tab] [?\t]) +(define-key function-key-map [M-tab] [?\M-\t]) +(define-key function-key-map [backspace] [127]) +(define-key function-key-map [M-backspace] [?\M-\d]) +(define-key function-key-map [escape] [?\e]) +(define-key function-key-map [M-escape] [?\M-\e]) + +;; These tell read-char how to convert +;; these special chars to ASCII. +(put 'return 'ascii-character 13) +(put 'tab 'ascii-character ?\t) +(put 'backspace 'ascii-character 127) +(put 'escape 'ascii-character ?\e) + + +;;;; Keysyms + +;; Define constant values to be set to mac-keyboard-text-encoding +(defconst kTextEncodingMacRoman 0) +(defconst kTextEncodingISOLatin1 513 "0x201") +(defconst kTextEncodingISOLatin2 514 "0x202") + + +;;;; 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))))) + + +;;; Do the actual Windows setup here; the above code just defines +;;; functions and variables that we use now. + +(setq command-line-args (x-handle-args command-line-args)) + +;;; Make sure we have a valid resource name. +(or (stringp x-resource-name) + (let (i) + (setq x-resource-name (invocation-name)) + + ;; Change any . or * characters in x-resource-name to hyphens, + ;; so as not to choke when we use it in X resource queries. + (while (setq i (string-match "[.*]" x-resource-name)) + (aset x-resource-name i ?-)))) + +(if (x-display-list) + ;; On Mac OS 8/9, Most coding systems used in code conversion for + ;; font names are not ready at the time when the terminal frame is + ;; created. So we reconstruct font name table for the initial + ;; frame. + (mac-clear-font-name-table) + (x-open-connection "Mac" + x-command-line-resources + ;; Exit Emacs with fatal error if this fails. + t)) + +(setq frame-creation-function 'x-create-frame-with-faces) + +(define-ccl-program ccl-encode-mac-roman-font + `(0 + (if (r0 != ,(charset-id 'ascii)) + (if (r0 <= ?\x8f) + (translate-character mac-roman-encoder r0 r1) + ((r1 <<= 7) + (r1 |= r2) + (translate-character mac-roman-encoder r0 r1))))) + "CCL program for Mac Roman font") + +(let + ((encoding-vector (make-vector 256 nil)) + (i 0) + (vec ;; mac-centraleurroman (128..255) -> UCS mapping + [ #x00C4 ;; 128:LATIN CAPITAL LETTER A WITH DIAERESIS + #x0100 ;; 129:LATIN CAPITAL LETTER A WITH MACRON + #x0101 ;; 130:LATIN SMALL LETTER A WITH MACRON + #x00C9 ;; 131:LATIN CAPITAL LETTER E WITH ACUTE + #x0104 ;; 132:LATIN CAPITAL LETTER A WITH OGONEK + #x00D6 ;; 133:LATIN CAPITAL LETTER O WITH DIAERESIS + #x00DC ;; 134:LATIN CAPITAL LETTER U WITH DIAERESIS + #x00E1 ;; 135:LATIN SMALL LETTER A WITH ACUTE + #x0105 ;; 136:LATIN SMALL LETTER A WITH OGONEK + #x010C ;; 137:LATIN CAPITAL LETTER C WITH CARON + #x00E4 ;; 138:LATIN SMALL LETTER A WITH DIAERESIS + #x010D ;; 139:LATIN SMALL LETTER C WITH CARON + #x0106 ;; 140:LATIN CAPITAL LETTER C WITH ACUTE + #x0107 ;; 141:LATIN SMALL LETTER C WITH ACUTE + #x00E9 ;; 142:LATIN SMALL LETTER E WITH ACUTE + #x0179 ;; 143:LATIN CAPITAL LETTER Z WITH ACUTE + #x017A ;; 144:LATIN SMALL LETTER Z WITH ACUTE + #x010E ;; 145:LATIN CAPITAL LETTER D WITH CARON + #x00ED ;; 146:LATIN SMALL LETTER I WITH ACUTE + #x010F ;; 147:LATIN SMALL LETTER D WITH CARON + #x0112 ;; 148:LATIN CAPITAL LETTER E WITH MACRON + #x0113 ;; 149:LATIN SMALL LETTER E WITH MACRON + #x0116 ;; 150:LATIN CAPITAL LETTER E WITH DOT ABOVE + #x00F3 ;; 151:LATIN SMALL LETTER O WITH ACUTE + #x0117 ;; 152:LATIN SMALL LETTER E WITH DOT ABOVE + #x00F4 ;; 153:LATIN SMALL LETTER O WITH CIRCUMFLEX + #x00F6 ;; 154:LATIN SMALL LETTER O WITH DIAERESIS + #x00F5 ;; 155:LATIN SMALL LETTER O WITH TILDE + #x00FA ;; 156:LATIN SMALL LETTER U WITH ACUTE + #x011A ;; 157:LATIN CAPITAL LETTER E WITH CARON + #x011B ;; 158:LATIN SMALL LETTER E WITH CARON + #x00FC ;; 159:LATIN SMALL LETTER U WITH DIAERESIS + #x2020 ;; 160:DAGGER + #x00B0 ;; 161:DEGREE SIGN + #x0118 ;; 162:LATIN CAPITAL LETTER E WITH OGONEK + #x00A3 ;; 163:POUND SIGN + #x00A7 ;; 164:SECTION SIGN + #x2022 ;; 165:BULLET + #x00B6 ;; 166:PILCROW SIGN + #x00DF ;; 167:LATIN SMALL LETTER SHARP S + #x00AE ;; 168:REGISTERED SIGN + #x00A9 ;; 169:COPYRIGHT SIGN + #x2122 ;; 170:TRADE MARK SIGN + #x0119 ;; 171:LATIN SMALL LETTER E WITH OGONEK + #x00A8 ;; 172:DIAERESIS + #x2260 ;; 173:NOT EQUAL TO + #x0123 ;; 174:LATIN SMALL LETTER G WITH CEDILLA + #x012E ;; 175:LATIN CAPITAL LETTER I WITH OGONEK + #x012F ;; 176:LATIN SMALL LETTER I WITH OGONEK + #x012A ;; 177:LATIN CAPITAL LETTER I WITH MACRON + #x2264 ;; 178:LESS-THAN OR EQUAL TO + #x2265 ;; 179:GREATER-THAN OR EQUAL TO + #x012B ;; 180:LATIN SMALL LETTER I WITH MACRON + #x0136 ;; 181:LATIN CAPITAL LETTER K WITH CEDILLA + #x2202 ;; 182:PARTIAL DIFFERENTIAL + #x2211 ;; 183:N-ARY SUMMATION + #x0142 ;; 184:LATIN SMALL LETTER L WITH STROKE + #x013B ;; 185:LATIN CAPITAL LETTER L WITH CEDILLA + #x013C ;; 186:LATIN SMALL LETTER L WITH CEDILLA + #x013D ;; 187:LATIN CAPITAL LETTER L WITH CARON + #x013E ;; 188:LATIN SMALL LETTER L WITH CARON + #x0139 ;; 189:LATIN CAPITAL LETTER L WITH ACUTE + #x013A ;; 190:LATIN SMALL LETTER L WITH ACUTE + #x0145 ;; 191:LATIN CAPITAL LETTER N WITH CEDILLA + #x0146 ;; 192:LATIN SMALL LETTER N WITH CEDILLA + #x0143 ;; 193:LATIN CAPITAL LETTER N WITH ACUTE + #x00AC ;; 194:NOT SIGN + #x221A ;; 195:SQUARE ROOT + #x0144 ;; 196:LATIN SMALL LETTER N WITH ACUTE + #x0147 ;; 197:LATIN CAPITAL LETTER N WITH CARON + #x2206 ;; 198:INCREMENT + #x00AB ;; 199:LEFT-POINTING DOUBLE ANGLE QUOTATION MARK + #x00BB ;; 200:RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK + #x2026 ;; 201:HORIZONTAL ELLIPSIS + #x00A0 ;; 202:NO-BREAK SPACE + #x0148 ;; 203:LATIN SMALL LETTER N WITH CARON + #x0150 ;; 204:LATIN CAPITAL LETTER O WITH DOUBLE ACUTE + #x00D5 ;; 205:LATIN CAPITAL LETTER O WITH TILDE + #x0151 ;; 206:LATIN SMALL LETTER O WITH DOUBLE ACUTE + #x014C ;; 207:LATIN CAPITAL LETTER O WITH MACRON + #x2013 ;; 208:EN DASH + #x2014 ;; 209:EM DASH + #x201C ;; 210:LEFT DOUBLE QUOTATION MARK + #x201D ;; 211:RIGHT DOUBLE QUOTATION MARK + #x2018 ;; 212:LEFT SINGLE QUOTATION MARK + #x2019 ;; 213:RIGHT SINGLE QUOTATION MARK + #x00F7 ;; 214:DIVISION SIGN + #x25CA ;; 215:LOZENGE + #x014D ;; 216:LATIN SMALL LETTER O WITH MACRON + #x0154 ;; 217:LATIN CAPITAL LETTER R WITH ACUTE + #x0155 ;; 218:LATIN SMALL LETTER R WITH ACUTE + #x0158 ;; 219:LATIN CAPITAL LETTER R WITH CARON + #x2039 ;; 220:SINGLE LEFT-POINTING ANGLE QUOTATION MARK + #x203A ;; 221:SINGLE RIGHT-POINTING ANGLE QUOTATION MARK + #x0159 ;; 222:LATIN SMALL LETTER R WITH CARON + #x0156 ;; 223:LATIN CAPITAL LETTER R WITH CEDILLA + #x0157 ;; 224:LATIN SMALL LETTER R WITH CEDILLA + #x0160 ;; 225:LATIN CAPITAL LETTER S WITH CARON + #x201A ;; 226:SINGLE LOW-9 QUOTATION MARK + #x201E ;; 227:DOUBLE LOW-9 QUOTATION MARK + #x0161 ;; 228:LATIN SMALL LETTER S WITH CARON + #x015A ;; 229:LATIN CAPITAL LETTER S WITH ACUTE + #x015B ;; 230:LATIN SMALL LETTER S WITH ACUTE + #x00C1 ;; 231:LATIN CAPITAL LETTER A WITH ACUTE + #x0164 ;; 232:LATIN CAPITAL LETTER T WITH CARON + #x0165 ;; 233:LATIN SMALL LETTER T WITH CARON + #x00CD ;; 234:LATIN CAPITAL LETTER I WITH ACUTE + #x017D ;; 235:LATIN CAPITAL LETTER Z WITH CARON + #x017E ;; 236:LATIN SMALL LETTER Z WITH CARON + #x016A ;; 237:LATIN CAPITAL LETTER U WITH MACRON + #x00D3 ;; 238:LATIN CAPITAL LETTER O WITH ACUTE + #x00D4 ;; 239:LATIN CAPITAL LETTER O WITH CIRCUMFLEX + #x016B ;; 240:LATIN SMALL LETTER U WITH MACRON + #x016E ;; 241:LATIN CAPITAL LETTER U WITH RING ABOVE + #x00DA ;; 242:LATIN CAPITAL LETTER U WITH ACUTE + #x016F ;; 243:LATIN SMALL LETTER U WITH RING ABOVE + #x0170 ;; 244:LATIN CAPITAL LETTER U WITH DOUBLE ACUTE + #x0171 ;; 245:LATIN SMALL LETTER U WITH DOUBLE ACUTE + #x0172 ;; 246:LATIN CAPITAL LETTER U WITH OGONEK + #x0173 ;; 247:LATIN SMALL LETTER U WITH OGONEK + #x00DD ;; 248:LATIN CAPITAL LETTER Y WITH ACUTE + #x00FD ;; 249:LATIN SMALL LETTER Y WITH ACUTE + #x0137 ;; 250:LATIN SMALL LETTER K WITH CEDILLA + #x017B ;; 251:LATIN CAPITAL LETTER Z WITH DOT ABOVE + #x0141 ;; 252:LATIN CAPITAL LETTER L WITH STROKE + #x017C ;; 253:LATIN SMALL LETTER Z WITH DOT ABOVE + #x0122 ;; 254:LATIN CAPITAL LETTER G WITH CEDILLA + #x02C7 ;; 255:CARON + ]) + translation-table) + (while (< i 128) + (aset encoding-vector i i) + (setq i (1+ i))) + (while (< i 256) + (aset encoding-vector i + (decode-char 'ucs (aref vec (- i 128)))) + (setq i (1+ i))) + (setq translation-table + (make-translation-table-from-vector encoding-vector)) +;; (define-translation-table 'mac-centraleurroman-decoder translation-table) + (define-translation-table 'mac-centraleurroman-encoder + (char-table-extra-slot translation-table 0))) + +(let + ((encoding-vector (make-vector 256 nil)) + (i 0) + (vec ;; mac-cyrillic (128..255) -> UCS mapping + [ #x0410 ;; 128:CYRILLIC CAPITAL LETTER A + #x0411 ;; 129:CYRILLIC CAPITAL LETTER BE + #x0412 ;; 130:CYRILLIC CAPITAL LETTER VE + #x0413 ;; 131:CYRILLIC CAPITAL LETTER GHE + #x0414 ;; 132:CYRILLIC CAPITAL LETTER DE + #x0415 ;; 133:CYRILLIC CAPITAL LETTER IE + #x0416 ;; 134:CYRILLIC CAPITAL LETTER ZHE + #x0417 ;; 135:CYRILLIC CAPITAL LETTER ZE + #x0418 ;; 136:CYRILLIC CAPITAL LETTER I + #x0419 ;; 137:CYRILLIC CAPITAL LETTER SHORT I + #x041A ;; 138:CYRILLIC CAPITAL LETTER KA + #x041B ;; 139:CYRILLIC CAPITAL LETTER EL + #x041C ;; 140:CYRILLIC CAPITAL LETTER EM + #x041D ;; 141:CYRILLIC CAPITAL LETTER EN + #x041E ;; 142:CYRILLIC CAPITAL LETTER O + #x041F ;; 143:CYRILLIC CAPITAL LETTER PE + #x0420 ;; 144:CYRILLIC CAPITAL LETTER ER + #x0421 ;; 145:CYRILLIC CAPITAL LETTER ES + #x0422 ;; 146:CYRILLIC CAPITAL LETTER TE + #x0423 ;; 147:CYRILLIC CAPITAL LETTER U + #x0424 ;; 148:CYRILLIC CAPITAL LETTER EF + #x0425 ;; 149:CYRILLIC CAPITAL LETTER HA + #x0426 ;; 150:CYRILLIC CAPITAL LETTER TSE + #x0427 ;; 151:CYRILLIC CAPITAL LETTER CHE + #x0428 ;; 152:CYRILLIC CAPITAL LETTER SHA + #x0429 ;; 153:CYRILLIC CAPITAL LETTER SHCHA + #x042A ;; 154:CYRILLIC CAPITAL LETTER HARD SIGN + #x042B ;; 155:CYRILLIC CAPITAL LETTER YERU + #x042C ;; 156:CYRILLIC CAPITAL LETTER SOFT SIGN + #x042D ;; 157:CYRILLIC CAPITAL LETTER E + #x042E ;; 158:CYRILLIC CAPITAL LETTER YU + #x042F ;; 159:CYRILLIC CAPITAL LETTER YA + #x2020 ;; 160:DAGGER + #x00B0 ;; 161:DEGREE SIGN + #x0490 ;; 162:CYRILLIC CAPITAL LETTER GHE WITH UPTURN + #x00A3 ;; 163:POUND SIGN + #x00A7 ;; 164:SECTION SIGN + #x2022 ;; 165:BULLET + #x00B6 ;; 166:PILCROW SIGN + #x0406 ;; 167:CYRILLIC CAPITAL LETTER BYELORUSSIAN-UKRAINIAN I + #x00AE ;; 168:REGISTERED SIGN + #x00A9 ;; 169:COPYRIGHT SIGN + #x2122 ;; 170:TRADE MARK SIGN + #x0402 ;; 171:CYRILLIC CAPITAL LETTER DJE + #x0452 ;; 172:CYRILLIC SMALL LETTER DJE + #x2260 ;; 173:NOT EQUAL TO + #x0403 ;; 174:CYRILLIC CAPITAL LETTER GJE + #x0453 ;; 175:CYRILLIC SMALL LETTER GJE + #x221E ;; 176:INFINITY + #x00B1 ;; 177:PLUS-MINUS SIGN + #x2264 ;; 178:LESS-THAN OR EQUAL TO + #x2265 ;; 179:GREATER-THAN OR EQUAL TO + #x0456 ;; 180:CYRILLIC SMALL LETTER BYELORUSSIAN-UKRAINIAN I + #x00B5 ;; 181:MICRO SIGN + #x0491 ;; 182:CYRILLIC SMALL LETTER GHE WITH UPTURN + #x0408 ;; 183:CYRILLIC CAPITAL LETTER JE + #x0404 ;; 184:CYRILLIC CAPITAL LETTER UKRAINIAN IE + #x0454 ;; 185:CYRILLIC SMALL LETTER UKRAINIAN IE + #x0407 ;; 186:CYRILLIC CAPITAL LETTER YI + #x0457 ;; 187:CYRILLIC SMALL LETTER YI + #x0409 ;; 188:CYRILLIC CAPITAL LETTER LJE + #x0459 ;; 189:CYRILLIC SMALL LETTER LJE + #x040A ;; 190:CYRILLIC CAPITAL LETTER NJE + #x045A ;; 191:CYRILLIC SMALL LETTER NJE + #x0458 ;; 192:CYRILLIC SMALL LETTER JE + #x0405 ;; 193:CYRILLIC CAPITAL LETTER DZE + #x00AC ;; 194:NOT SIGN + #x221A ;; 195:SQUARE ROOT + #x0192 ;; 196:LATIN SMALL LETTER F WITH HOOK + #x2248 ;; 197:ALMOST EQUAL TO + #x2206 ;; 198:INCREMENT + #x00AB ;; 199:LEFT-POINTING DOUBLE ANGLE QUOTATION MARK + #x00BB ;; 200:RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK + #x2026 ;; 201:HORIZONTAL ELLIPSIS + #x00A0 ;; 202:NO-BREAK SPACE + #x040B ;; 203:CYRILLIC CAPITAL LETTER TSHE + #x045B ;; 204:CYRILLIC SMALL LETTER TSHE + #x040C ;; 205:CYRILLIC CAPITAL LETTER KJE + #x045C ;; 206:CYRILLIC SMALL LETTER KJE + #x0455 ;; 207:CYRILLIC SMALL LETTER DZE + #x2013 ;; 208:EN DASH + #x2014 ;; 209:EM DASH + #x201C ;; 210:LEFT DOUBLE QUOTATION MARK + #x201D ;; 211:RIGHT DOUBLE QUOTATION MARK + #x2018 ;; 212:LEFT SINGLE QUOTATION MARK + #x2019 ;; 213:RIGHT SINGLE QUOTATION MARK + #x00F7 ;; 214:DIVISION SIGN + #x201E ;; 215:DOUBLE LOW-9 QUOTATION MARK + #x040E ;; 216:CYRILLIC CAPITAL LETTER SHORT U + #x045E ;; 217:CYRILLIC SMALL LETTER SHORT U + #x040F ;; 218:CYRILLIC CAPITAL LETTER DZHE + #x045F ;; 219:CYRILLIC SMALL LETTER DZHE + #x2116 ;; 220:NUMERO SIGN + #x0401 ;; 221:CYRILLIC CAPITAL LETTER IO + #x0451 ;; 222:CYRILLIC SMALL LETTER IO + #x044F ;; 223:CYRILLIC SMALL LETTER YA + #x0430 ;; 224:CYRILLIC SMALL LETTER A + #x0431 ;; 225:CYRILLIC SMALL LETTER BE + #x0432 ;; 226:CYRILLIC SMALL LETTER VE + #x0433 ;; 227:CYRILLIC SMALL LETTER GHE + #x0434 ;; 228:CYRILLIC SMALL LETTER DE + #x0435 ;; 229:CYRILLIC SMALL LETTER IE + #x0436 ;; 230:CYRILLIC SMALL LETTER ZHE + #x0437 ;; 231:CYRILLIC SMALL LETTER ZE + #x0438 ;; 232:CYRILLIC SMALL LETTER I + #x0439 ;; 233:CYRILLIC SMALL LETTER SHORT I + #x043A ;; 234:CYRILLIC SMALL LETTER KA + #x043B ;; 235:CYRILLIC SMALL LETTER EL + #x043C ;; 236:CYRILLIC SMALL LETTER EM + #x043D ;; 237:CYRILLIC SMALL LETTER EN + #x043E ;; 238:CYRILLIC SMALL LETTER O + #x043F ;; 239:CYRILLIC SMALL LETTER PE + #x0440 ;; 240:CYRILLIC SMALL LETTER ER + #x0441 ;; 241:CYRILLIC SMALL LETTER ES + #x0442 ;; 242:CYRILLIC SMALL LETTER TE + #x0443 ;; 243:CYRILLIC SMALL LETTER U + #x0444 ;; 244:CYRILLIC SMALL LETTER EF + #x0445 ;; 245:CYRILLIC SMALL LETTER HA + #x0446 ;; 246:CYRILLIC SMALL LETTER TSE + #x0447 ;; 247:CYRILLIC SMALL LETTER CHE + #x0448 ;; 248:CYRILLIC SMALL LETTER SHA + #x0449 ;; 249:CYRILLIC SMALL LETTER SHCHA + #x044A ;; 250:CYRILLIC SMALL LETTER HARD SIGN + #x044B ;; 251:CYRILLIC SMALL LETTER YERU + #x044C ;; 252:CYRILLIC SMALL LETTER SOFT SIGN + #x044D ;; 253:CYRILLIC SMALL LETTER E + #x044E ;; 254:CYRILLIC SMALL LETTER YU + #x20AC ;; 255:EURO SIGN + ]) + translation-table) + (while (< i 128) + (aset encoding-vector i i) + (setq i (1+ i))) + (while (< i 256) + (aset encoding-vector i + (decode-char 'ucs (aref vec (- i 128)))) + (setq i (1+ i))) + (setq translation-table + (make-translation-table-from-vector encoding-vector)) +;; (define-translation-table 'mac-cyrillic-decoder translation-table) + (define-translation-table 'mac-cyrillic-encoder + (char-table-extra-slot translation-table 0))) + +(defvar mac-font-encoder-list + '(("mac-roman" mac-roman-encoder + ccl-encode-mac-roman-font "%s") + ("mac-centraleurroman" mac-centraleurroman-encoder + ccl-encode-mac-centraleurroman-font "%s ce") + ("mac-cyrillic" mac-cyrillic-encoder + ccl-encode-mac-cyrillic-font "%s cy"))) + +(let ((encoder-list + (mapcar (lambda (lst) (nth 1 lst)) mac-font-encoder-list)) + (charset-list + '(latin-iso8859-2 + latin-iso8859-3 latin-iso8859-4 + cyrillic-iso8859-5 greek-iso8859-7 hebrew-iso8859-8 + latin-iso8859-9 latin-iso8859-14 latin-iso8859-15))) + (dolist (encoder encoder-list) + (let ((table (get encoder 'translation-table))) + (dolist (charset charset-list) + (dotimes (i 96) + (let* ((c (make-char charset (+ i 32))) + (mu (aref ucs-mule-to-mule-unicode c)) + (mac-encoded (and mu (aref table mu)))) + (if mac-encoded + (aset table c mac-encoded)))))))) + +(define-ccl-program ccl-encode-mac-centraleurroman-font + `(0 + (if (r0 != ,(charset-id 'ascii)) + (if (r0 <= ?\x8f) + (translate-character mac-centraleurroman-encoder r0 r1) + ((r1 <<= 7) + (r1 |= r2) + (translate-character mac-centraleurroman-encoder r0 r1))))) + "CCL program for Mac Central European Roman font") + +(define-ccl-program ccl-encode-mac-cyrillic-font + `(0 + (if (r0 != ,(charset-id 'ascii)) + (if (r0 <= ?\x8f) + (translate-character mac-cyrillic-encoder r0 r1) + ((r1 <<= 7) + (r1 |= r2) + (translate-character mac-cyrillic-encoder r0 r1))))) + "CCL program for Mac Cyrillic font") + + +(setq font-ccl-encoder-alist + (nconc + (mapcar (lambda (lst) (cons (nth 0 lst) (nth 2 lst))) + mac-font-encoder-list) + font-ccl-encoder-alist)) + +(defun fontset-add-mac-fonts (fontset &optional base-family) + (if base-family + (setq base-family (downcase base-family)) + (let ((ascii-font + (downcase (x-resolve-font-name + (fontset-font fontset (charset-id 'ascii)))))) + (setq base-family (aref (x-decompose-font-name ascii-font) + xlfd-regexp-family-subnum)))) +;; (if (not (string-match "^fontset-" fontset)) +;; (setq fontset +;; (concat "fontset-" (aref (x-decompose-font-name fontset) +;; xlfd-regexp-encoding-subnum)))) + (dolist + (font-encoder + (nreverse + (mapcar (lambda (lst) + (cons (cons (format (nth 3 lst) base-family) (nth 0 lst)) + (nth 1 lst))) + mac-font-encoder-list))) + (let ((font (car font-encoder)) + (encoder (cdr font-encoder))) + (map-char-table + (lambda (key val) + (or (null val) + (generic-char-p key) + (memq (char-charset key) + '(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. + +Optional 1st arg RESOLVED-FONT is a resolved name of FONT. If +omitted, `x-resolve-font-name' is called to get the resolved name. At +this time, if FONT is not available, error is signaled. + +Optional 2nd arg FONTSET-NAME is a string to be used in +`<CHARSET_ENCODING>' fields of a new fontset name. If it is omitted, +an appropriate name is generated automatically. + +It returns a name of the created fontset." + (let ((fontset + (create-fontset-from-ascii-font font resolved-font fontset-name))) + (fontset-add-mac-fonts fontset) + fontset)) + +;; Setup the default fontset. +(setup-default-fontset) + +;; Create a fontset that uses mac-roman font. With this fontset, +;; characters decoded from mac-roman encoding (ascii, latin-iso8859-1, +;; and mule-unicode-xxxx-yyyy) are displayed by a mac-roman font. +(create-fontset-from-fontset-spec + "-etl-fixed-medium-r-normal-*-16-*-*-*-*-*-fontset-mac, +ascii:-*-Monaco-*-*-*-*-12-*-*-*-*-*-mac-roman") +(fontset-add-mac-fonts "fontset-mac") + +;; Create fontset specified in X resources "Fontset-N" (N is 0, 1, ...). +(create-fontset-from-x-resource) + +;; Try to create a fontset from a font specification which comes +;; from initial-frame-alist, default-frame-alist, or X resource. +;; A font specification in command line argument (i.e. -fn XXXX) +;; should be already in default-frame-alist as a `font' +;; parameter. However, any font specifications in site-start +;; library, user's init file (.emacs), and default.el are not +;; yet handled here. + +(let ((font (or (cdr (assq 'font initial-frame-alist)) + (cdr (assq 'font default-frame-alist)) + (x-get-resource "font" "Font"))) + xlfd-fields resolved-name) + (if (and font + (not (query-fontset font)) + (setq resolved-name (x-resolve-font-name font)) + (setq xlfd-fields (x-decompose-font-name font))) + (if (string= "fontset" (aref xlfd-fields xlfd-regexp-registry-subnum)) + (new-fontset font (x-complement-fontset-spec xlfd-fields nil)) + ;; Create a fontset from FONT. The fontset name is + ;; generated from FONT. + (create-fontset-from-ascii-font font resolved-name "startup")))) + +;; Apply a geometry resource to the initial frame. Put it at the end +;; of the alist, so that anything specified on the command line takes +;; precedence. +(let* ((res-geometry (x-get-resource "geometry" "Geometry")) + parsed) + (if res-geometry + (progn + (setq parsed (x-parse-geometry res-geometry)) + ;; If the resource specifies a position, + ;; call the position and size "user-specified". + (if (or (assq 'top parsed) (assq 'left parsed)) + (setq parsed (cons '(user-position . t) + (cons '(user-size . t) parsed)))) + ;; All geometry parms apply to the initial frame. + (setq initial-frame-alist (append initial-frame-alist parsed)) + ;; The size parms apply to all frames. + (if (assq 'height parsed) + (setq default-frame-alist + (cons (cons 'height (cdr (assq 'height parsed))) + default-frame-alist))) + (if (assq 'width parsed) + (setq default-frame-alist + (cons (cons 'width (cdr (assq 'width parsed))) + default-frame-alist)))))) + +;; Check the reverseVideo resource. +(let ((case-fold-search t)) + (let ((rv (x-get-resource "reverseVideo" "ReverseVideo"))) + (if (and rv + (string-match "^\\(true\\|yes\\|on\\)$" rv)) + (setq default-frame-alist + (cons '(reverse . t) default-frame-alist))))) + +(defun x-win-suspend-error () + (error "Suspending an Emacs running under Mac makes no sense")) +(add-hook 'suspend-hook 'x-win-suspend-error) + +;; 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) + +(defun mac-drag-n-drop (event) + "Edit the files listed in the drag-n-drop event.\n\ +Switch to a buffer editing the last file dropped." + (interactive "e") + (save-excursion + ;; Make sure the drop target has positive co-ords + ;; before setting the selected frame - otherwise it + ;; won't work. <skx@tardis.ed.ac.uk> + (let* ((window (posn-window (event-start event))) + (coords (posn-x-y (event-start event))) + (x (car coords)) + (y (cdr coords))) + (if (and (> x 0) (> y 0)) + (set-frame-selected-window nil window)) + (mapcar + '(lambda (file) + (find-file + (decode-coding-string + file + (or file-name-coding-system + default-file-name-coding-system)))) + (car (cdr (cdr event))))) + (raise-frame) + (recenter))) + +(global-set-key [drag-n-drop] 'mac-drag-n-drop) + +;; By checking whether the variable mac-ready-for-drag-n-drop has been +;; defined, the event loop in macterm.c can be informed that it can +;; now receive Finder drag and drop events. Files dropped onto the +;; Emacs application icon can only be processed when the initial frame +;; has been created: this is where the files should be opened. +(add-hook 'after-init-hook + '(lambda () + (defvar mac-ready-for-drag-n-drop t))) + +;;;; Scroll bars + +;; for debugging +;; (defun mac-handle-scroll-bar-event (event) (interactive "e") (princ event)) + +;;(global-set-key [vertical-scroll-bar mouse-1] 'mac-handle-scroll-bar-event) + +(global-set-key + [vertical-scroll-bar down-mouse-1] + 'mac-handle-scroll-bar-event) + +(global-unset-key [vertical-scroll-bar drag-mouse-1]) +(global-unset-key [vertical-scroll-bar mouse-1]) + +(defun mac-handle-scroll-bar-event (event) + "Handle scroll bar EVENT to emulate Mac Toolbox style scrolling." + (interactive "e") + (let* ((position (event-start event)) + (window (nth 0 position)) + (bar-part (nth 4 position))) + (select-window window) + (cond + ((eq bar-part 'up) + (goto-char (window-start window)) + (mac-scroll-down-line)) + ((eq bar-part 'above-handle) + (mac-scroll-down)) + ((eq bar-part 'handle) + (scroll-bar-drag event)) + ((eq bar-part 'below-handle) + (mac-scroll-up)) + ((eq bar-part 'down) + (goto-char (window-start window)) + (mac-scroll-up-line))))) + +(defun mac-scroll-ignore-events () + ;; Ignore confusing non-mouse events + (while (not (memq (car-safe (read-event)) + '(mouse-1 double-mouse-1 triple-mouse-1))) nil)) + +(defun mac-scroll-down () + (track-mouse + (mac-scroll-ignore-events) + (scroll-down))) + +(defun mac-scroll-down-line () + (track-mouse + (mac-scroll-ignore-events) + (scroll-down 1))) + +(defun mac-scroll-up () + (track-mouse + (mac-scroll-ignore-events) + (scroll-up))) + +(defun mac-scroll-up-line () + (track-mouse + (mac-scroll-ignore-events) + (scroll-up 1))) + + +;;;; Others + +(unless (eq system-type 'darwin) + ;; This variable specifies the Unix program to call (as a process) to + ;; deteremine the amount of free space on a file system (defaults to + ;; df). If it is not set to nil, ls-lisp will not work correctly + ;; unless an external application df is implemented on the Mac. + (setq directory-free-space-program nil) + + ;; Set this so that Emacs calls subprocesses with "sh" as shell to + ;; expand filenames Note no subprocess for the shell is actually + ;; started (see run_mac_command in sysdep.c). + (setq shell-file-name "sh")) + +;; X Window emulation in macterm.c is not complete enough to start a +;; frame without a minibuffer properly. Call this to tell ediff +;; library to use a single frame. +; (ediff-toggle-multiframe) + +(if (eq system-type 'darwin) + ;; On Darwin filenames are encoded in UTF-8 + (setq file-name-coding-system 'utf-8) + ;; To display filenames in Chinese or Japanese, replace mac-roman with + ;; big5 or sjis + (setq file-name-coding-system 'mac-roman)) + +;; If Emacs is started from the Finder, change the default directory +;; to the user's home directory. +(if (string= default-directory "/") + (cd "~")) + +;; Tell Emacs to use pipes instead of pty's for processes because the +;; latter sometimes lose characters. Pty support is compiled in since +;; ange-ftp will not work without it. +(setq process-connection-type nil) + +;; Assume that fonts are always scalable on the Mac. This sometimes +;; results in characters with jagged edges. However, without it, +;; fonts with both truetype and bitmap representations but no italic +;; or bold bitmap versions will not display these variants correctly. +(setq scalable-fonts-allowed t) + +;; (prefer-coding-system 'mac-roman) + ;;; arch-tag: 71dfcd14-cde8-4d66-b05c-85ec94fb23a6 ;;; mac-win.el ends here
--- a/lisp/textmodes/texinfmt.el Thu Dec 23 16:43:51 2004 +0000 +++ b/lisp/textmodes/texinfmt.el Thu Jan 06 15:00:09 2005 +0000 @@ -378,6 +378,7 @@ (find-file outfile) (texinfo-mode) (erase-buffer) + (buffer-disable-undo) (message "Formatting Info file: %s" outfile) (setq texinfo-format-filename
--- a/lisp/type-break.el Thu Dec 23 16:43:51 2004 +0000 +++ b/lisp/type-break.el Thu Jan 06 15:00:09 2005 +0000 @@ -399,10 +399,6 @@ (type-break-keystroke-reset) (type-break-mode-line-countdown-or-break nil) - (if (boundp 'save-some-buffers-always) - (add-to-list 'save-some-buffers-always - (expand-file-name type-break-file-name))) - (setq type-break-time-last-break (type-break-get-previous-time)) ;; schedule according to break time from session file @@ -437,13 +433,10 @@ (do-auto-save) (with-current-buffer (find-file-noselect type-break-file-name 'nowarn) - (set-buffer-modified-p nil) + (setq buffer-save-without-query t) + (set-buffer-modified-p nil) (unlock-buffer) (kill-this-buffer)) - (if (boundp 'save-some-buffers-always) - (setq save-some-buffers-always - (remove (expand-file-name type-break-file-name) - save-some-buffers-always))) (and (interactive-p) (message "Type Break mode is disabled"))))) type-break-mode) @@ -515,16 +508,18 @@ (defun type-break-file-keystroke-count () "File keystroke count in `type-break-file-name', unless the file is locked." (if (not (stringp (file-locked-p type-break-file-name))) - (with-current-buffer (find-file-noselect type-break-file-name - 'nowarn) - (save-excursion - (let ((inhibit-read-only t)) - (goto-char (point-min)) - (forward-line) - (delete-region (point) (save-excursion (end-of-line) (point))) - (insert (format "%s" type-break-keystroke-count)) - ;; file saving is left to auto-save - ))))) + ;; Prevent deactivation of the mark in some other buffer. + (let (deactivate-mark) + (with-current-buffer (find-file-noselect type-break-file-name + 'nowarn) + (save-excursion + (let ((inhibit-read-only t)) + (goto-char (point-min)) + (forward-line) + (delete-region (point) (save-excursion (end-of-line) (point))) + (insert (format "%s" type-break-keystroke-count)) + ;; file saving is left to auto-save + )))))) (defun timep (time) "If TIME is in the format returned by `current-time' then
--- a/lisp/uniquify.el Thu Dec 23 16:43:51 2004 +0000 +++ b/lisp/uniquify.el Thu Jan 06 15:00:09 2005 +0000 @@ -188,7 +188,6 @@ file name elements. Arguments BASE, DIRNAME, and NEWBUF specify the new buffer that causes this rationaliztion." - (interactive) (if (null dirname) (with-current-buffer newbuf (setq uniquify-managed nil)) (setq dirname (expand-file-name (directory-file-name dirname)))
--- a/lisp/wid-edit.el Thu Dec 23 16:43:51 2004 +0000 +++ b/lisp/wid-edit.el Thu Jan 06 15:00:09 2005 +0000 @@ -3059,7 +3059,7 @@ (defvar widget-function-prompt-value-history nil "History of input to `widget-function-prompt-value'.") -(define-widget 'function 'sexp +(define-widget 'function 'restricted-sexp "A Lisp function." :complete-function (lambda () (interactive)
--- a/lispref/ChangeLog Thu Dec 23 16:43:51 2004 +0000 +++ b/lispref/ChangeLog Thu Jan 06 15:00:09 2005 +0000 @@ -1,3 +1,18 @@ +2004-12-27 Richard M. Stallman <rms@gnu.org> + + * Makefile.in (MAKEINFO): Specify --force. + + * buffers.texi (Killing Buffers): Add buffer-save-without-query. + + * modes.texi (Emulating Mode Line): Document format's BUFFER arg. + + * display.texi (Line Height): Further clarify. + + * elisp.texi (Top): Update Loading submenu. + + * loading.texi (Where Defined): New node. + (Unloading): load-history moved to Where Defined. + 2004-12-21 Richard M. Stallman <rms@gnu.org> * commands.texi (Event Input Misc): Add while-no-input.
--- a/lispref/Makefile.in Thu Dec 23 16:43:51 2004 +0000 +++ b/lispref/Makefile.in Thu Jan 06 15:00:09 2005 +0000 @@ -31,7 +31,7 @@ TEXI2DVI = texi2dvi SHELL = /bin/sh INSTALL_INFO = install-info -MAKEINFO = makeinfo +MAKEINFO = makeinfo --force # The name of the manual: VERSION=2.9
--- a/lispref/buffers.texi Thu Dec 23 16:43:51 2004 +0000 +++ b/lispref/buffers.texi Thu Jan 06 15:00:09 2005 +0000 @@ -1041,6 +1041,13 @@ for any reason. @xref{Buffer-Local Variables}. @end defvar +@defvar buffer-save-without-query +This variable, if non-@code{nil} in a particular buffer, tells +@code{save-buffers-kill-emacs} and @code{save-some-buffers} to save +this buffer (if it's modified) without asking the user. The variable +automatically becomes buffer-local when set for any reason. +@end defvar + @defun buffer-live-p object This function returns @code{t} if @var{object} is a buffer which has not been killed, @code{nil} otherwise.
--- a/lispref/display.texi Thu Dec 23 16:43:51 2004 +0000 +++ b/lispref/display.texi Thu Jan 06 15:00:09 2005 +0000 @@ -1533,23 +1533,26 @@ A newline can have a @code{line-height} text or overlay property that controls the total height of the display line ending in that newline. If the property value is zero, the displayed height of the -line is exactly what its contents need; no line-spacing is added. +line is exactly what its contents demand; no line-spacing is added. This case is useful for tiling small images or image slices without adding blank areas between the images. - If the property value is not zero, it specifies a desired height, -@var{line-height}. There are several ways it can do this: + If the property value is not zero, it is a height spec. A height +spec stands for a numeric height value; this heigh spec specifies the +actual line height, @var{line-height}. There are several ways to +write a height spec; here's how each of them translates into a numeric +height: @table @code @item @var{integer} -If the property is a positive integer, @var{line-height} is that integer. +If the height spec is a positive integer, the height value is that integer. @item @var{float} -If the property is a float, @var{float}, @var{line-height} is @var{float} -times the frame's default line height. +If the height spec is a float, @var{float}, the numeric height value +is @var{float} times the frame's default line height. @item (@var{ratio} . @var{face}) -If the property is a cons of the format shown, @var{line-height} is -@var{ratio} times the height of face @var{face}. @var{ratio} can be -any type of number. If @var{face} is @code{t}, it refers to the +If the height spec is a cons of the format shown, the numeric height +is @var{ratio} times the height of face @var{face}. @var{ratio} can +be any type of number. If @var{face} is @code{t}, it refers to the current face. @end table @@ -1561,6 +1564,8 @@ If you don't specify the @code{line-height} propery, the line's height consists of the contents' height plus the line spacing. +There are several ways to specify the line spacing for different +parts of Emacs text. @vindex default-line-spacing You can specify the line spacing for all lines in a frame with the @@ -1584,24 +1589,23 @@ newline. The property value overrides the default frame line spacing and the buffer local @code{line-spacing} variable. - One way or another, these mechanisms specify a line spacing for each -line. Let's call the value @var{line-spacing}. - - If the @var{line-spacing} value is a positive integer, it specifies -the number of pixels of additional vertical space. This space appears -below the display line contents. - - If the @var{line-spacing} value is a floating point number or cons, -the additional vertical space is @var{line-spacing} times the frame -default line height. - -@ignore @c I think we may want to delete this, so don't document it -- rms. - If the @var{line-spacing} value is a cons @code{(total . @var{spacing})} -where @var{spacing} is any of the forms described above, the value of -@var{spacing} specifies the total displayed height of the line, -regardless of the height of the characters in it. This is equivalent -to using the @code{line-height} property. -@end ignore + One way or another, these mechanisms specify a Lisp value for the +spacing of each line. The value is a height spec, and it translates +into a Lisp value as described above. However, in this case the +numeric height value specifies the line spacing, rather than the line +height. + + There is one exception, however: if the @var{line-spacing} value is +a cons @code{(total . @var{spacing})}, then @var{spacing} itself is +treated as a heigh spec, and specifies the total displayed height of +the line, so the line spacing equals the specified amount minus the +line height. This differs from using the @code{line-height} property +because it adds space at the bottom of the line instead of the top. + + If you specify both @code{line-spacing} using @code{total} and +@code{line-height}, they are not redundant. First @code{line-height} +goes to work, adding space above the line contents. Then +@code{line-spacing} goes to work, adding space below the contents. @node Faces @section Faces
--- a/lispref/elisp.texi Thu Dec 23 16:43:51 2004 +0000 +++ b/lispref/elisp.texi Thu Jan 06 15:00:09 2005 +0000 @@ -420,9 +420,15 @@ Loading * How Programs Do Loading:: The @code{load} function and others. +* Library Search:: Finding a library to load. +* Loading Non-ASCII:: Non-@acronym{ASCII} characters in Emacs Lisp files. * Autoload:: Setting up a function to autoload. +* Repeated Loading:: Precautions about loading a file twice. * Named Features:: Loading a library if it isn't already loaded. -* Repeated Loading:: Precautions about loading a file twice. +* Where Defined:: Finding which file defined a certain symbol. +* Unloading:: to ``unload'' a library that was loaded. +* Hooks for Loading:: Providing code to be run when + particular libraries are loaded. Byte Compilation
--- a/lispref/loading.texi Thu Dec 23 16:43:51 2004 +0000 +++ b/lispref/loading.texi Thu Jan 06 15:00:09 2005 +0000 @@ -36,15 +36,16 @@ containing Lisp code. @menu -* How Programs Do Loading:: The @code{load} function and others. -* Library Search:: Finding a library to load. -* Loading Non-ASCII:: Non-@acronym{ASCII} characters in Emacs Lisp files. -* Autoload:: Setting up a function to autoload. -* Repeated Loading:: Precautions about loading a file twice. -* Named Features:: Loading a library if it isn't already loaded. -* Unloading:: How to ``unload'' a library that was loaded. -* Hooks for Loading:: Providing code to be run when - particular libraries are loaded. +* How Programs Do Loading:: The @code{load} function and others. +* Library Search:: Finding a library to load. +* Loading Non-ASCII:: Non-@acronym{ASCII} characters in Emacs Lisp files. +* Autoload:: Setting up a function to autoload. +* Repeated Loading:: Precautions about loading a file twice. +* Named Features:: Loading a library if it isn't already loaded. +* Where Defined:: Finding which file defined a certain symbol. +* Unloading:: to ``unload'' a library that was loaded. +* Hooks for Loading:: Providing code to be run when + particular libraries are loaded. @end menu @node How Programs Do Loading @@ -714,6 +715,60 @@ @code{features} list is not significant. @end defvar +@node Where Defined +@section Which File Defined a Certain Symbol + +@defun symbol-file symbol &optional type +This function returns the name of the file that defined @var{symbol}. +If @var{type} is @code{nil}, then any kind of definition is +acceptable. If @var{type} is @code{defun} or @code{defvar}, that +specifies function definition only or variable definition only. + +The value is the file name as it was specified to @code{load}: +either an absolute file name, or a library name +(with no directory name and no @samp{.el} or @samp{.elc} at the end). +It can also be @code{nil}, if the definition is not associated with any file. +@end defun + + The basis for @code{symbol-file} is the data in the variable +@code{load-history}. + +@defvar load-history +This variable's value is an alist connecting library names with the +names of functions and variables they define, the features they provide, +and the features they require. + +Each element is a list and describes one library. The @sc{car} of the +list is the name of the library, as a string. The rest of the list +elements have these forms: + +@table @code +@item @var{var} +The symbol @var{var} was defined as a variable. +@item (defun . @var{fun}) +The @var{fun} was defined by this library. +@item (t . @var{fun}) +The function @var{fun} was previously an autoload before this library +redefined it as a function. The following element is always the +symbol @var{fun}, which signifies that the library defined @var{fun} +as a function. +@item (autoload . @var{fun}) +The function @var{fun} was defined as an autoload. +@item (require . @var{feature}) +The feature @var{feature} was required. +@item (provide . @var{feature}) +The feature @var{feature} was provided. +@end table + +The value of @code{load-history} may have one element whose @sc{car} is +@code{nil}. This element describes definitions made with +@code{eval-buffer} on a buffer that is not visiting a file. +@end defvar + + The command @code{eval-region} updates @code{load-history}, but does so +by adding the symbols defined to the element for the file being visited, +rather than replacing that element. @xref{Eval}. + @node Unloading @section Unloading @cindex unloading @@ -760,42 +815,6 @@ The @code{unload-feature} function is written in Lisp; its actions are based on the variable @code{load-history}. -@defvar load-history -This variable's value is an alist connecting library names with the -names of functions and variables they define, the features they provide, -and the features they require. - -Each element is a list and describes one library. The @sc{car} of the -list is the name of the library, as a string. The rest of the list -elements have these forms: - -@table @code -@item @var{fun} -The function @var{fun} was defined by this library. -@item (t . @var{fun}) -The function @var{fun} was previously an autoload before this library -redefined it as a function. The following element is always the -symbol @var{fun}, which signifies that the library defined @var{fun} -as a function. -@item (autoload . @var{fun}) -The function @var{fun} was defined as an autoload. -@item (defvar . @var{var}) -The symbol @var{var} was defined as a variable. -@item (require . @var{feature}) -The feature @var{feature} was required. -@item (provide . @var{feature}) -The feature @var{feature} was provided. -@end table - -The value of @code{load-history} may have one element whose @sc{car} is -@code{nil}. This element describes definitions made with -@code{eval-buffer} on a buffer that is not visiting a file. -@end defvar - - The command @code{eval-region} updates @code{load-history}, but does so -by adding the symbols defined to the element for the file being visited, -rather than replacing that element. @xref{Eval}. - @defvar unload-feature-special-hooks This variable holds a list of hooks to be scanned before unloading a library, to remove functions defined in the library.
--- a/lispref/modes.texi Thu Dec 23 16:43:51 2004 +0000 +++ b/lispref/modes.texi Thu Jan 06 15:00:09 2005 +0000 @@ -1736,7 +1736,7 @@ the text that would appear in a mode line or header line based on certain mode-line specification. -@defun format-mode-line &optional format window no-props +@defun format-mode-line &optional format window no-props buffer This function formats a line of text according to @var{format} as if it were generating the mode line for @var{window}, but instead of displaying the text in the mode line or the header line, it returns @@ -1752,6 +1752,8 @@ The value string normally has text properties that correspond to the faces, keymaps, etc., that the mode line would have. If @var{no-props} is non-@code{nil}, the value has no text properties. +If @var{buffer} is non-@code{nil}, all the information used is taken +from @var{buffer}; by default,it comes from @var{window}'s buffer. @end defun @node Imenu
--- a/lwlib/ChangeLog Thu Dec 23 16:43:51 2004 +0000 +++ b/lwlib/ChangeLog Thu Jan 06 15:00:09 2005 +0000 @@ -1,3 +1,15 @@ +2004-12-27 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * xlwmenu.c (xlwMenuActionsList): Install MenuGadgetEscape as an + action procedure for compatibility with Lesstif/Motif. + + * Makefile.in (mostlyclean): Don't remove *~ on clean. + +2004-12-26 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * lwlib-Xaw.c: Put <KeyPress>Escape in dialogOverride so dialogs only + pops down on Escape, not any keypress. + 2004-11-01 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> * xlwmenu.c (find_first_selectable, find_next_selectable)
--- a/lwlib/Makefile.in Thu Dec 23 16:43:51 2004 +0000 +++ b/lwlib/Makefile.in Thu Jan 06 15:00:09 2005 +0000 @@ -57,7 +57,7 @@ xlwmenu.o: xlwmenu.c xlwmenu.h lwlib.h xlwmenuP.h mostlyclean: - $(RM) *.o core errs ,* *~ *.a .emacs_* make.log MakeOut \#* + $(RM) *.o core errs ,* *.a .emacs_* make.log MakeOut \#* clean: mostlyclean distclean: clean
--- a/lwlib/lwlib-Xaw.c Thu Dec 23 16:43:51 2004 +0000 +++ b/lwlib/lwlib-Xaw.c Thu Jan 06 15:00:09 2005 +0000 @@ -279,7 +279,7 @@ "<Message>WM_PROTOCOLS: lwlib_delete_dialog()"; /* Dialogs pop down on any key press */ static char dialogOverride[] = - "<KeyPress>: lwlib_delete_dialog()"; + "<KeyPress>Escape: lwlib_delete_dialog()"; static void wm_delete_window(); static XtActionsRec xaw_actions [] = { {"lwlib_delete_dialog", wm_delete_window}
--- a/lwlib/xlwmenu.c Thu Dec 23 16:43:51 2004 +0000 +++ b/lwlib/xlwmenu.c Thu Jan 06 15:00:09 2005 +0000 @@ -211,6 +211,7 @@ {"right", Right}, {"select", Select}, {"key", Key}, + {"MenuGadgetEscape", Key}, /* Compatibility with Lesstif/Motif. */ {"nothing", Nothing}, };
--- a/mac/ChangeLog Thu Dec 23 16:43:51 2004 +0000 +++ b/mac/ChangeLog Thu Jan 06 15:00:09 2005 +0000 @@ -1,3 +1,24 @@ +2004-12-24 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * makefile.MPW: Add dependencies for fringe.c.x, image.c.x, and + lastfile.c.x. + (PPCCOptions): Add -alloca. + (EmacsObjects): Remove alloca.c.x. Add fringe.c.x, image.c.x, and + lastfile.c.x. + (Emacs MPW): Add QuickTimeLib. + (EmacsSource): Remove alloca.c. Add fringe.c, image.c, and + lastfile.c. + (LispSource): Fix pathnames for byte-run.elc, float-sup.elc, and + map-ynp.elc. + * inc/config.h (USE_LSB_TAG) [__MRC__]: Define. + (UNEXEC_SRC): Close comment. + * inc/epaths.h (PATH_BITMAPS, PATH_GAME): New defines. + * inc/m-mac.h (HAVE_ALLOCA) [__MRC__]: Define. + (C_ALLOCA) [__MRC__]: Don't define. + * inc/s-mac.h (X_OK): New define. + (DECL_ALIGN) [USE_LSB_TAG && __MRC__]: New macro. + (GC_MARK_STACK): Define to GC_MAKE_GCPROS_NOOPS. + 2004-05-29 Steven Tamm <steventamm@mac.com> * INSTALL: Fixing typos
--- a/mac/inc/config.h Thu Dec 23 16:43:51 2004 +0000 +++ b/mac/inc/config.h Thu Jan 06 15:00:09 2005 +0000 @@ -261,7 +261,7 @@ /* #undef CRAY_STACKSEG_END */ -/* #undef UNEXEC_SRC unexelf.c +/* #undef UNEXEC_SRC */ /* #undef HAVE_LIBXBSD */ /* #undef HAVE_XRMSETDATABASE */ @@ -367,6 +367,13 @@ /* #undef _XOPEN_SOURCE */ #ifdef __MRC__ +/* Use low-bits for tags. If ENABLE_CHECKING is turned on together + with USE_LSB_TAG, optimization flags should be explicitly turned + off. */ +#define USE_LSB_TAG +#endif + +#ifdef __MRC__ #define EMACS_CONFIGURATION "macos-mpw" #else /* Assume CodeWarrior */ #define EMACS_CONFIGURATION "macos-cw"
--- a/mac/inc/epaths.h Thu Dec 23 16:43:51 2004 +0000 +++ b/mac/inc/epaths.h Thu Jan 06 15:00:09 2005 +0000 @@ -46,7 +46,7 @@ /* Where Emacs should look for X bitmap files. The lisp variable x-bitmap-file-path is set based on this value. */ -/* #define PATH_BITMAPS "/usr/include/X11/bitmaps" */ +#define PATH_BITMAPS "" /* Where Emacs should look for its docstring file. The lisp variable doc-directory is set to this value. */ @@ -57,6 +57,9 @@ macro, and is then used to set the Info-default-directory-list. */ #define PATH_INFO "~emacs/info" +/* Where Emacs should store game score files. */ +#define PATH_GAME "~emacs/games" + /* Where Emacs should look for the application default file. */ /* #define PATH_X_DEFAULTS "/usr/lib/X11/%L/%T/%N%C%S:/usr/lib/X11/%l/%T/%N%C%S:/usr/lib/X11/%T/%N%C%S:/usr/lib/X11/%L/%T/%N%S:/usr/lib/X11/%l/%T/%N%S:/usr/lib/X11/%T/%N%S" */
--- a/mac/inc/m-mac.h Thu Dec 23 16:43:51 2004 +0000 +++ b/mac/inc/m-mac.h Thu Jan 06 15:00:09 2005 +0000 @@ -87,8 +87,11 @@ Define neither one if an assembler-language alloca in the file alloca.s should be used. */ +#ifdef __MRC__ +#define HAVE_ALLOCA +#else #define C_ALLOCA -/* #define HAVE_ALLOCA */ +#endif /* Define NO_REMAP if memory segmentation makes it not work well to change the boundary between the text section and data section
--- a/mac/inc/s-mac.h Thu Dec 23 16:43:51 2004 +0000 +++ b/mac/inc/s-mac.h Thu Jan 06 15:00:09 2005 +0000 @@ -255,6 +255,10 @@ #include <unistd.h> #endif +#ifndef X_OK +#define X_OK 01 +#endif + #undef unlink #define unlink sys_unlink #undef read @@ -319,5 +323,15 @@ #define SYMS_SYSTEM syms_of_mac() +#ifdef USE_LSB_TAG +#ifdef __MRC__ +#define DECL_ALIGN(type, var) type var +#endif +#endif + +/* Use the GC_MAKE_GCPROS_NOOPS (see lisp.h) method for marking the + stack. */ +#define GC_MARK_STACK GC_MAKE_GCPROS_NOOPS + /* arch-tag: 6a941c4b-a419-4d25-80ac-9335053e58b2 (do not change this comment) */
--- a/mac/makefile.MPW Thu Dec 23 16:43:51 2004 +0000 +++ b/mac/makefile.MPW Thu Jan 06 15:00:09 2005 +0000 @@ -44,7 +44,7 @@ # The -noMapCR options and the two -d's must not be removed. -PPCCOptions = {SymOption} {OptOption} -noMapCR -enum int ¶ +PPCCOptions = {SymOption} {OptOption} -noMapCR -enum int -alloca ¶ -typecheck relaxed -w off ¶ -includes unix -i {Includes},{Src} ¶ -d emacs=1 -d HAVE_CONFIG_H -d MAC_OS -d MAC_OS8 @@ -63,7 +63,6 @@ EmacsObjects = ¶ "{Src}abbrev.c.x" ¶ "{Src}alloc.c.x" ¶ - "{Src}alloca.c.x" ¶ "{Src}atimer.c.x" ¶ "{Src}buffer.c.x" ¶ "{Src}bytecode.c.x" ¶ @@ -92,7 +91,9 @@ "{Src}fns.c.x" ¶ "{Src}fontset.c.x" ¶ "{Src}frame.c.x" ¶ + "{Src}fringe.c.x" ¶ "{Src}getloadavg.c.x" ¶ + "{Src}image.c.x" ¶ "{Src}indent.c.x" ¶ "{Src}insdel.c.x" ¶ "{Src}intervals.c.x" ¶ @@ -120,7 +121,8 @@ "{Src}undo.c.x" ¶ "{Src}window.c.x" ¶ "{Src}xdisp.c.x" ¶ - "{Src}xfaces.c.x" + "{Src}xfaces.c.x" ¶ + "{Src}lastfile.c.x" # The list of object files generated from new source files of the Macintosh port. @@ -142,6 +144,7 @@ "{SharedLibraries}AppleScriptLib" ¶ "{SharedLibraries}TextEncodingConverter" ¶ "{SharedLibraries}AppearanceLib" ¶ + "{SharedLibraries}QuickTimeLib" ¶ "{PPCLibraries}StdCRuntime.o" ¶ "{PPCLibraries}PPCCRuntime.o" ¶ "{PPCLibraries}PPCToolLibs.o" ¶ @@ -495,10 +498,33 @@ "{Src}commands.h" ¶ "{Src}keyboard.h" +{Src}fringe.c.x Ä ¶ + {CONFIG_H_GROUP} ¶ + "{Src}lisp.h" ¶ + "{Src}frame.h" ¶ + {WINDOW_H_GROUP} ¶ + "{Src}buffer.h" ¶ + {BLOCKINPUT_H_GROUP} + {Src}getloadavg.c.x Ä ¶ {CONFIG_H_GROUP} ¶ "{Includes}sys:types.h" +{Src}image.c.x Ä ¶ + {CONFIG_H_GROUP} ¶ + "{Src}lisp.h" ¶ + "{Src}frame.h" ¶ + {WINDOW_H_GROUP} ¶ + {DISPEXTERN_H_GROUP} ¶ + {BLOCKINPUT_H_GROUP} ¶ + "{Includes}epaths.h" ¶ + "{Src}macterm.h" ¶ + "{Src}macgui.h" ¶ + "{Src}frame.h" ¶ + "{Includes}sys:stat.h" ¶ + "{Includes}alloca.h" ¶ + "{Includes}sys:param.h" + {Src}indent.c.x Ä ¶ {CONFIG_H_GROUP} ¶ "{Src}lisp.h" ¶ @@ -574,6 +600,9 @@ "{Src}puresize.h" ¶ {INTERVALS_H_GROUP} +{Src}lastfile.c.x Ä ¶ + {CONFIG_H_GROUP} + {Src}lread.c.x Ä ¶ {CONFIG_H_GROUP} ¶ "{Includes}sys:types.h" ¶ @@ -935,7 +964,6 @@ EmacsSource = ¶ "{Src}abbrev.c" ¶ "{Src}alloc.c" ¶ - "{Src}alloca.c" ¶ "{Src}atimer.c" ¶ "{Src}buffer.c" ¶ "{Src}bytecode.c" ¶ @@ -964,12 +992,15 @@ "{Src}fns.c" ¶ "{Src}fontset.c" ¶ "{Src}frame.c" ¶ + "{Src}fringe.c" ¶ "{Src}getloadavg.c" ¶ + "{Src}image.c" ¶ "{Src}indent.c" ¶ "{Src}insdel.c" ¶ "{Src}intervals.c" ¶ "{Src}keyboard.c" ¶ "{Src}keymap.c" ¶ + "{Src}lastfile.c" ¶ "{Src}lread.c" ¶ "{Src}macros.c" ¶ "{Src}marker.c" ¶ @@ -1018,7 +1049,7 @@ {Lisp}abbrev.elc ¶ {Lisp}buff-menu.elc ¶ {Lisp}server.elc ¶ - {Lisp}byte-run.elc ¶ + {Lisp}emacs-lisp:byte-run.elc ¶ {Lisp}cus-start.el ¶ {Lisp}custom.elc ¶ {Lisp}emacs-lisp:lisp-mode.elc ¶ @@ -1026,7 +1057,7 @@ {Lisp}facemenu.elc ¶ {Lisp}faces.elc ¶ {Lisp}files.elc ¶ - {Lisp}float-sup.elc ¶ + {Lisp}emacs-lisp:float-sup.elc ¶ {Lisp}format.elc ¶ {Lisp}frame.elc ¶ {Lisp}help.elc ¶ @@ -1035,7 +1066,7 @@ {Lisp}loadup.el ¶ {Lisp}loaddefs.el ¶ {Lisp}bindings.elc ¶ - {Lisp}map-ynp.elc ¶ + {Lisp}emacs-lisp:map-ynp.elc ¶ {Lisp}international:mule.elc ¶ {Lisp}international:mule-conf.el ¶ {Lisp}international:mule-cmds.elc ¶
--- a/man/ChangeLog Thu Dec 23 16:43:51 2004 +0000 +++ b/man/ChangeLog Thu Jan 06 15:00:09 2005 +0000 @@ -1,3 +1,19 @@ +2004-12-27 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * frames.texi (Dialog Boxes): Mention Gtk+ 2.6 also, as that version is + out now. + +2004-12-27 Richard M. Stallman <rms@gnu.org> + + * Makefile.in (MAKEINFO): Specify --force. + + * basic.texi (Moving Point): C-e now runs move-end-of-line. + (Undo): Doc undo-outer-limit. + +2004-12-11 Richard M. Stallman <rms@gnu.org> + + * Makefile.in (MAKEINFO): Add --force. + 2004-12-20 Jay Belanger <belanger@truman.edu> * calc.texi (Types Tutorial): Emphasized that you can't divide by @@ -23,6 +39,7 @@ the standard "The GNU Emacs Manual" in fifth argument of @xref's. (Dealing with HTTP documents): @inforef->@xref. +>>>>>>> 1.412 2004-12-15 Juri Linkov <juri@jurta.org> * mark.texi (Transient Mark, Mark Ring): M-< and other @@ -39,6 +56,7 @@ * calc.texi: Fix some TeX definitions. +>>>>>>> 1.407 2004-12-12 Juri Linkov <juri@jurta.org> * misc.texi (FFAP): Add C-x C-r, C-x C-v, C-x C-d, @@ -52,6 +70,7 @@ * mark.texi (Marking Objects): Marking commands also extend the region when mark is active in Transient Mark mode. +>>>>>>> 1.403 2004-12-09 Luc Teirlinck <teirllm@auburn.edu> * reftex.texi (Imprint): Remove erroneous @value's.
--- a/man/Makefile.in Thu Dec 23 16:43:51 2004 +0000 +++ b/man/Makefile.in Thu Jan 06 15:00:09 2005 +0000 @@ -31,7 +31,8 @@ # The makeinfo program is part of the Texinfo distribution. -MAKEINFO = makeinfo +# Use --force so that it generates output even if there are errors. +MAKEINFO = makeinfo --force INFO_TARGETS = ../info/emacs ../info/emacs-xtra ../info/ccmode ../info/cl \ ../info/dired-x ../info/ediff ../info/forms ../info/gnus \ ../info/message ../info/sieve ../info/pgg ../info/emacs-mime \
--- a/man/basic.texi Thu Dec 23 16:43:51 2004 +0000 +++ b/man/basic.texi Thu Jan 06 15:00:09 2005 +0000 @@ -171,7 +171,7 @@ @kindex UP @kindex DOWN @findex beginning-of-line -@findex end-of-line +@findex move-end-of-line @findex forward-char @findex backward-char @findex next-line @@ -185,7 +185,7 @@ @item C-a Move to the beginning of the line (@code{beginning-of-line}). @item C-e -Move to the end of the line (@code{end-of-line}). +Move to the end of the line (@code{move-end-of-line}). @item C-f Move forward one character (@code{forward-char}). The right-arrow key does the same thing. @@ -380,24 +380,32 @@ @vindex undo-limit @vindex undo-strong-limit +@vindex undo-outer-limit @cindex undo limit When the undo information for a buffer becomes too large, Emacs discards the oldest undo information from time to time (during garbage collection). You can specify how much undo information to keep by -setting two variables: @code{undo-limit} and @code{undo-strong-limit}. -Their values are expressed in units of bytes of space. +setting three variables: @code{undo-limit}, @code{undo-strong-limit}, +and @code{undo-outer-limit}. Their values are expressed in units of +bytes of space. The variable @code{undo-limit} sets a soft limit: Emacs keeps undo -data for enough commands to reach this size, and perhaps exceed it, but -does not keep data for any earlier commands beyond that. Its default -value is 20000. The variable @code{undo-strong-limit} sets a stricter -limit: the command which pushes the size past this amount is itself -forgotten. Its default value is 30000. +data for enough commands to reach this size, and perhaps exceed it, +but does not keep data for any earlier commands beyond that. Its +default value is 20000. The variable @code{undo-strong-limit} sets a +stricter limit: a previous command (not the most recent one) which +pushes the size past this amount is itself forgotten. The default +value of @code{undo-strong-limit} is 30000. - Regardless of the values of those variables, the most recent change is -never discarded, so there is no danger that garbage collection occurring -right after an unintentional large change might prevent you from undoing -it. + Regardless of the values of those variables, the most recent change +is never discarded unless it gets bigger than @code{undo-outer-limit} +(normally 300,000). At that point, Emacs asks whether to discard the +undo information even for the current command. (You also have the +option of quitting.) So there is normally no danger that garbage +collection occurring right after an unintentional large change might +prevent you from undoing it. But if you didn't expect the command +to create such large undo data, you can get rid of it and prevent +Emacs from running out of memory. The reason the @code{undo} command has two keys, @kbd{C-x u} and @kbd{C-_}, set up to run it is that it is worthy of a single-character
--- a/man/calc.texi Thu Dec 23 16:43:51 2004 +0000 +++ b/man/calc.texi Thu Jan 06 15:00:09 2005 +0000 @@ -11712,21 +11712,23 @@ variable is really just an Emacs Lisp variable that contains a Calc number or formula.) A variable's name is normally composed of letters and digits. Calc also allows apostrophes and @code{#} signs in variable names. -The Calc variable @code{foo} corresponds to the Emacs Lisp variable -@code{var-foo}. Commands like @kbd{s s} (@code{calc-store}) that operate -on variables can be made to use any arbitrary Lisp variable simply by -backspacing over the @samp{var-} prefix in the minibuffer. +(The Calc variable @code{foo} corresponds to the Emacs Lisp variable +@code{var-foo}, but unless you access the variable from within Emacs +Lisp, you don't need to worry about it.) In a command that takes a variable name, you can either type the full name of a variable, or type a single digit to use one of the special -convenience variables @code{var-q0} through @code{var-q9}. For example, -@kbd{3 s s 2} stores the number 3 in variable @code{var-q2}, and +convenience variables @code{q0} through @code{q9}. For example, +@kbd{3 s s 2} stores the number 3 in variable @code{q2}, and @w{@kbd{3 s s foo @key{RET}}} stores that number in variable -@code{var-foo}. +@code{foo}. To push a variable itself (as opposed to the variable's value) on the stack, enter its name as an algebraic expression using the apostrophe -(@key{'}) key. Variable names in algebraic formulas implicitly have +(@key{'}) key. + +xxx + Variable names in algebraic formulas implicitly have @samp{var-} prefixed to their names. The @samp{#} character in variable names used in algebraic formulas corresponds to a dash @samp{-} in the Lisp variable name. If the name contains any dashes, the prefix @samp{var-} @@ -14139,7 +14141,7 @@ turn into the @code{assign} function, which Calc normally displays using the @samp{:=} symbol. -The variables @code{var-pi} and @code{var-e} would be displayed @samp{pi} +The variables @code{pi} and @code{e} would be displayed @samp{pi} and @samp{e} in Normal mode, but in C mode they are displayed as @samp{M_PI} and @samp{M_E}, corresponding to the names of constants typically provided in the @file{<math.h>} header. Functions whose @@ -17220,7 +17222,9 @@ If your system does not have a suitable @samp{date} command, you may wish to put a @samp{(setq var-TimeZone ...)} in your Emacs -initialization file to set the time zone. The easiest way to do +initialization file to set the time zone. (Since you are interacting +with the variable @code{TimeZone} directly from Emacs Lisp, the +@code{var-} prefix needs to be present.) The easiest way to do this is to edit the @code{TimeZone} variable using Calc's @kbd{s T} command, then use the @kbd{s p} (@code{calc-permanent-variable}) command to save the value of @code{TimeZone} permanently. @@ -27847,14 +27851,8 @@ The @kbd{s s} (@code{calc-store}) command stores the value at the top of the stack into a specified variable. It prompts you to enter the name of the variable. If you press a single digit, the value is stored -immediately in one of the ``quick'' variables @code{var-q0} through -@code{var-q9}. Or you can enter any variable name. The prefix @samp{var-} -is supplied for you; when a name appears in a formula (as in @samp{a+q2}) -the prefix @samp{var-} is also supplied there, so normally you can simply -forget about @samp{var-} everywhere. Its only purpose is to enable you to -use Calc variables without fear of accidentally clobbering some variable in -another Emacs package. If you really want to store in an arbitrary Lisp -variable, just backspace over the @samp{var-}. +immediately in one of the ``quick'' variables @code{q0} through +@code{q9}. Or you can enter any variable name. @kindex s t @pindex calc-store-into @@ -28038,10 +28036,10 @@ special variables @code{inf}, @code{uinf}, and @code{nan} (which are normally void). -Note that @code{var-pi} doesn't actually have 3.14159265359 stored +Note that @code{pi} doesn't actually have 3.14159265359 stored in it, but rather a special magic value that evaluates to @cpi{} -at the current precision. Likewise @code{var-e}, @code{var-i}, and -@code{var-phi} evaluate according to the current precision or polar mode. +at the current precision. Likewise @code{e}, @code{i}, and +@code{phi} evaluate according to the current precision or polar mode. If you recall a value from @code{pi} and store it back, this magic property will be lost. @@ -28052,9 +28050,9 @@ followed by an @kbd{s t} in two important ways. First, the value never goes on the stack and thus is never rounded, evaluated, or simplified in any way; it is not even rounded down to the current precision. -Second, the ``magic'' contents of a variable like @code{var-e} can +Second, the ``magic'' contents of a variable like @code{e} can be copied into another variable with this command, perhaps because -you need to unstore @code{var-e} right now but you wish to put it +you need to unstore @code{e} right now but you wish to put it back when you're done. The @kbd{s c} command is the only way to manipulate these magic values intact. @@ -28216,7 +28214,7 @@ use a different file instead of @file{.emacs}.) If you do not specify the name of a variable to save (i.e., -@kbd{s p @key{RET}}), all @samp{var-} variables with defined values +@kbd{s p @key{RET}}), all Calc variables with defined values are saved except for the special constants @code{pi}, @code{e}, @code{i}, @code{phi}, and @code{gamma}; the variables @code{TimeZone} and @code{PlotRejects}; @@ -28228,8 +28226,9 @@ @kindex s i @pindex calc-insert-variables The @kbd{s i} (@code{calc-insert-variables}) command writes -the values of all @samp{var-} variables into a specified buffer. -The variables are written in the form of Lisp @code{setq} commands +the values of all Calc variables into a specified buffer. +The variables are written with the prefix @code{var-} in the form of +Lisp @code{setq} commands which store the values in string form. You can place these commands in your @file{.emacs} buffer if you wish, though in this case it would be easier to use @kbd{s p @key{RET}}. (Note that @kbd{s i}
--- a/man/frames.texi Thu Dec 23 16:43:51 2004 +0000 +++ b/man/frames.texi Thu Jan 06 15:00:09 2005 +0000 @@ -913,7 +913,7 @@ boxes with the option @code{use-dialog-box}. @vindex x-use-old-gtk-file-dialog - For Gtk+ version 2.4, you can make Emacs use the old file dialog + For Gtk+ version 2.4 and 2.6, you can make Emacs use the old file dialog by setting the variable @code{x-use-old-gtk-file-dialog} to a non-@code{nil} value. If Emacs is built with a Gtk+ version that has only one file dialog, the setting of this variable has no effect.
--- a/oldXMenu/Activate.c Thu Dec 23 16:43:51 2004 +0000 +++ b/oldXMenu/Activate.c Thu Jan 06 15:00:09 2005 +0000 @@ -81,6 +81,7 @@ #include <config.h> #include "XMenuInt.h" +#include <X11/keysym.h> /* For debug, set this to 0 to not grab the keyboard on menu popup */ int x_menu_grab_keyboard = 1; @@ -131,6 +132,7 @@ Window root, child; int root_x, root_y, win_x, win_y; unsigned int mask; + KeySym keysym; /* * Define and allocate a foreign event queue to hold events @@ -458,6 +460,18 @@ } selection = True; break; + case KeyPress: + case KeyRelease: + keysym = XLookupKeysym (&event.xkey, 0); + + /* Pop down on C-g and Escape. */ + if ((keysym == XK_g && (event.xkey.state & ControlMask) != 0) + || keysym == XK_Escape) /* Any escape, ignore modifiers. */ + { + ret_val = XM_NO_SELECT; + selection = True; + } + break; default: /* * If AEQ mode is enabled then queue the event.
--- a/oldXMenu/ChangeLog Thu Dec 23 16:43:51 2004 +0000 +++ b/oldXMenu/ChangeLog Thu Jan 06 15:00:09 2005 +0000 @@ -1,3 +1,8 @@ +2004-12-27 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * Activate.c (XMenuActivate): Return XM_NO_SELECT if Escape or C-g + was pressed. + 2004-11-12 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> * XMenu.h (XMenuActivateSetWaitFunction): New function.
--- a/src/ChangeLog Thu Dec 23 16:43:51 2004 +0000 +++ b/src/ChangeLog Thu Jan 06 15:00:09 2005 +0000 @@ -1,3 +1,203 @@ +2004-12-27 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * xmenu.c (popup_get_selection): Only pop down dialogs + on C-g and Escape. + (popup_get_selection): Remove parameter down_on_keypress. + (create_and_show_popup_menu, create_and_show_dialog): Remove + parameter down_on_keypress to popup_get_selection. + +2004-12-27 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * dispextern.h: Change HAVE_CARBON to MAC_OS. + (struct glyph_string): Likewise. + * emacs.c (main) [MAC_OS8]: Call mac_term_init instead of + mac_initialize. + * fileio.c (Fnext_read_file_uses_dialog_p, Fread_file_name): + Change TARGET_API_MAC_CARBON to HAVE_CARBON. + * fns.c (vector): Change MAC_OSX to MAC_OS. + * frame.c (x_set_frame_parameters, x_report_frame_params) + (x_set_fullscreen): Remove #ifndef HAVE_CARBON. + (x_set_border_width, Vdefault_frame_scroll_bars): Change + HAVE_CARBON to MAC_OS. + * image.c [MAC_OS]: Include sys/stat.h. + [MAC_OS && !MAC_OSX]: Include sys/param.h, ImageCompression.h, and + QuickTimeComponents.h. + * mac.c [!MAC_OSX] (mac_wait_next_event): Add extern. + [!MAC_OSX] (select): Use mac_wait_next_event. + [!MAC_OSX] (run_mac_command): Change EXEC_SUFFIXES to + Vexec_suffixes. + [!MAC_OSX] (select, run_mac_command): Change `#ifdef + TARGET_API_MAC_CARBON' to `#if TARGET_API_MAC_CARBON'. + (mac_clear_font_name_table): Add extern. + (Fmac_clear_font_name_table): New defun. + (syms_of_mac): Defsubr it. + [MAC_OSX] (SELECT_POLLING_PERIOD_USEC): New define. + [MAC_OSX] (select_and_poll_event): New function. + [MAC_OSX] (sys_select): Use it. + [MAC_OSX && SELECT_USE_CFSOCKET] (socket_callback): New function. + [MAC_OSX && SELECT_USE_CFSOCKET] + (SELECT_TIMEOUT_THRESHOLD_RUNLOOP, EVENT_CLASS_SOCK): New defines. + [MAC_OSX] (sys_select) [SELECT_USE_CFSOCKET]: Use CFSocket and + RunLoop for simultaneously monitoring two kinds of inputs, window + events and process outputs, without periodically polling. + * macfns.c (mac_initialized): Remove extern. + (stricmp): Put in #if 0. All callers changed to use xstricmp in + xfaces.c. + (strnicmp): Decrement `n' at the end of each loop, not the + beginning. + (check_mac): Use the term "Mac native windows" instead of "Mac + OS". + (check_x_display_info, x_display_info_for_name): Sync with xfns.c. + (mac_get_rdb_resource): New function (from w32reg.c). + (x_get_string_resource): Use it. + (install_window_handler): Add extern. + (mac_window): New function. + (Fx_create_frame): Use it instead of make_mac_frame. Set + parameter for Qfullscreen. Call x_wm_set_size_hint. + (Fx_open_connection, Fx_close_connection): New defuns. + (syms_of_macfns): Defsubr them. + (x_create_tip_frame) [TARGET_API_MAC_CARBON]: Add + kWindowNoUpdatesAttribute to the window attribute. + (x_create_tip_frame) [!TARGET_API_MAC_CARBON]: Use NewCWindow. + (x_create_tip_frame): Don't call ShowWindow. + (Fx_show_tip): Call ShowWindow. + (Fx_file_dialog): Change `#ifdef TARGET_API_MAC_CARBON' to `#if + TARGET_API_MAC_CARBON'. + (mac_frame_parm_handlers): Set handlers for Qfullscreen. + (syms_of_macfns) [MAC_OSX]: Initialize mac_in_use to 0. + * macgui.h [!MAC_OSX]: Don't include Controls.h. Include + Windows.h. + (Window): Typedef to WindowPtr and move outside `#if + TARGET_API_MAC_CARBON'. + (XSizeHints): New struct. + * macterm.c (x_update_begin, x_update_end) + [TARGET_API_MAC_CARBON]: Disable screen updates during update of a + frame. + (x_draw_glyph_string_background, x_draw_glyph_string_foreground) + [MAC_OS8]: Use XDrawImageString/XDrawImageString16. + (construct_mouse_click): Put in #if 0. + (x_check_fullscreen, x_check_fullscreen_move): Remove decls. + (x_scroll_bar_create, x_scroll_bar_handle_click): Change `#ifdef + TARGET_API_MAC_CARBON' to `#if TARGET_API_MAC_CARBON'. + (activate_scroll_bars, deactivate_scroll_bars) + [!TARGET_API_MAC_CARBON]: Use ActivateControl/DeactivateControl. + (x_make_frame_visible) [TARGET_API_MAC_CARBON]: Reposition window + if the position is neither user-specified nor program-specified. + (x_free_frame_resources): Free size_hints. + (x_wm_set_size_hint): Allocate size_hints if needed. Set + size_hints. + (mac_clear_font_name_table): New function. + (mac_do_list_fonts): Initialize font_name_table if needed. + (x_list_fonts): Don't initialize font_name_table. Add BLOCK_INPUT + around mac_do_list_fonts. + (mac_unload_font): New function. + (x_load_font): Add BLOCK_INPUT around XLoadQueryFont. + (init_mac_drag_n_drop, mac_do_receive_drag): Enclose declarations + and definitions with #if TARGET_API_MAC_CARBON. + [USE_CARBON_EVENTS] (mac_handle_window_event): Add decl. + (install_window_handler): Add decl. + (do_window_update): Add BeginUpdate/EndUpdate for the tooltip + window. Use UpdateControls. Get the rectangle that should be + updated and restrict the target of expose_frame to it. + (do_grow_window): Set minimum height/width according to + size_hints. + (do_grow_window) [TARGET_API_MAC_CARBON]: Use ResizeWindow. + (do_zoom_window): Don't use x_set_window_size. + [USE_CARBON_EVENTS] (mac_handle_window_event): New function. + (install_window_handler): New function. + [!USE_CARBON_EVENTS] (mouse_region): New variable. + [!USE_CARBON_EVENTS] (mac_wait_next_event): New function. + (XTread_socket) [USE_CARBON_EVENTS]: Move call to + GetEventDispatcherTarget inside BLOCK_INPUT. + (XTread_socket) [!USE_CARBON_EVENTS]: Use mac_wait_next_event. + Update mouse_region when mouse is moved. + (make_mac_frame): Remove. + (make_mac_terminal_frame): Put in #ifdef MAC_OS8. Initialize + mouse pointer shapes. Change values of f->left_pos and + f->top_pos. Don't use make_mac_frame. Use NewCWindow. Don't + call ShowWindow. + (mac_initialize_display_info) [MAC_OSX]: Create mac_id_name from + Vinvocation_name and Vsystem_name. + (mac_make_rdb): New function (from w32term.c). + (mac_term_init): Use it. Add BLOCK_INPUT. Error if display has + already been opened. Don't pass argument to + mac_initialize_display_info. Don't set dpyinfo->height/width. + Add entries to x_display_list and x_display_name_list. + (x_delete_display): New function. + (mac_initialize): Don't call mac_initialize_display_info. + (syms_of_macterm) [!MAC_OSX]: Don't call Fprovide. + * macterm.h (check_mac): Add extern. + (struct mac_output): New member size_hints. + (FRAME_SIZE_HINTS): New macro. + (mac_unload_font): Add extern. + * xdisp.c (expose_window, expose_frame): Remove kludges for Mac. + * xfaces.c (clear_font_table) [MAC_OS]: call mac_unload_font. + +2004-12-27 Richard M. Stallman <rms@gnu.org> + + * buffer.c (Fbuffer_disable_undo): Deleted (moved to simple.el). + (syms_of_buffer): Don't defsubr it. + + * process.c (list_processes_1): Set undo_list instead + of calling Fbuffer_disable_undo. + + * xdisp.c (single_display_spec_string_p): Renamed from + single_display_prop_string_p. + (single_display_spec_intangible_p): Renamed from + single_display_prop_intangible_p. + (handle_single_display_spec): Renamed from handle_single_display_prop. + Rewritten to be easier to understand. + + * Change in load-history format. Functions now get (defun . NAME), + and variables get just NAME. + + * data.c (Fdefalias): Use (defun . FN_NAME) in LOADHIST_ATTACH. + + * eval.c (Fdefun, Fdefmacro): Use (defun . FN_NAME) in LOADHIST_ATTACH. + (Fdefvaralias, Fdefvar, Fdefconst): Use just SYM in LOADHIST_ATTACH. + (Qdefvar): Var deleted. + (syms_of_eval): Don't initialze it. + + * lread.c (syms_of_lread) <load-history>: Doc fix. + +2004-12-27 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * xmenu.c (popup_get_selection): Pop down on C-g. + (set_frame_menubar): Install translations for Lucid/Motif/Lesstif that + pops down menu on C-g. + (xdialog_show): If dialog popped down and no button in the dialog was + pushed, call Fsignal to quit. + (xmenu_show): In no toolkit version, if menu returns NO_SELECT call + Fsignal to quit. + + * xfns.c (Fx_file_dialog): Motif/Lesstif version: Pop down on C-g. + + * gtkutil.c (xg_initialize): Install bindings for C-g so that + dialogs and menus pop down. + +2004-12-25 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * gtkutil.c (update_frame_tool_bar): Make the value of + tool-bar-button-margin control margins of images in tool bar. + + * alloc.c (check_depth): New variable. + (overrun_check_malloc, overrun_check_realloc): Only add + overhead and write check pattern if check_depth is 1 (to handle + recursive calls). Increase/decrease check_depth in entry/exit. + (overrun_check_free): Only check for overhead if check_depth is 1. + Increase/decrease check_depth in entry/exit. + +2004-12-23 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * keyboard.c (input_available_signal): Call SIGNAL_THREAD_CHECK + before touching input_available_clear_time, to avoid accessing it + from multiple threads. + +2004-12-23 Jason Rumney <jasonr@gnu.org> + + * image.c (__WIN32__) [HAVE_NTGUI]: Define for correct behaviour + of JPEG library. + 2004-12-22 Richard M. Stallman <rms@gnu.org> * emacs.c (main): If batch mode, set Vundo_outer_limit to nil.
--- a/src/alloc.c Thu Dec 23 16:43:51 2004 +0000 +++ b/src/alloc.c Thu Jan 06 15:00:09 2005 +0000 @@ -602,6 +602,27 @@ ((unsigned)(ptr[-4]) << 24)) +/* The call depth in overrun_check functions. For example, this might happen: + xmalloc() + overrun_check_malloc() + -> malloc -> (via hook)_-> emacs_blocked_malloc + -> overrun_check_malloc + call malloc (hooks are NULL, so real malloc is called). + malloc returns 10000. + add overhead, return 10016. + <- (back in overrun_check_malloc) + add overhead again, return 10032 + xmalloc returns 10032. + + (time passes). + + xfree(10032) + overrun_check_free(10032) + decrease overhed + free(10016) <- crash, because 10000 is the original pointer. */ + +static int check_depth; + /* Like malloc, but wraps allocated block with header and trailer. */ POINTER_TYPE * @@ -609,15 +630,17 @@ size_t size; { register unsigned char *val; - - val = (unsigned char *) malloc (size + XMALLOC_OVERRUN_CHECK_SIZE*2); - if (val) + size_t overhead = ++check_depth == 1 ? XMALLOC_OVERRUN_CHECK_SIZE*2 : 0; + + val = (unsigned char *) malloc (size + overhead); + if (val && check_depth == 1) { bcopy (xmalloc_overrun_check_header, val, XMALLOC_OVERRUN_CHECK_SIZE - 4); val += XMALLOC_OVERRUN_CHECK_SIZE; XMALLOC_PUT_SIZE(val, size); bcopy (xmalloc_overrun_check_trailer, val + size, XMALLOC_OVERRUN_CHECK_SIZE); } + --check_depth; return (POINTER_TYPE *)val; } @@ -631,8 +654,10 @@ size_t size; { register unsigned char *val = (unsigned char *)block; + size_t overhead = ++check_depth == 1 ? XMALLOC_OVERRUN_CHECK_SIZE*2 : 0; if (val + && check_depth == 1 && bcmp (xmalloc_overrun_check_header, val - XMALLOC_OVERRUN_CHECK_SIZE, XMALLOC_OVERRUN_CHECK_SIZE - 4) == 0) @@ -647,15 +672,16 @@ bzero (val, XMALLOC_OVERRUN_CHECK_SIZE); } - val = (unsigned char *) realloc ((POINTER_TYPE *)val, size + XMALLOC_OVERRUN_CHECK_SIZE*2); - - if (val) + val = (unsigned char *) realloc ((POINTER_TYPE *)val, size + overhead); + + if (val && check_depth == 1) { bcopy (xmalloc_overrun_check_header, val, XMALLOC_OVERRUN_CHECK_SIZE - 4); val += XMALLOC_OVERRUN_CHECK_SIZE; XMALLOC_PUT_SIZE(val, size); bcopy (xmalloc_overrun_check_trailer, val + size, XMALLOC_OVERRUN_CHECK_SIZE); } + --check_depth; return (POINTER_TYPE *)val; } @@ -667,7 +693,9 @@ { unsigned char *val = (unsigned char *)block; + ++check_depth; if (val + && check_depth == 1 && bcmp (xmalloc_overrun_check_header, val - XMALLOC_OVERRUN_CHECK_SIZE, XMALLOC_OVERRUN_CHECK_SIZE - 4) == 0) @@ -683,6 +711,7 @@ } free (val); + --check_depth; } #undef malloc
--- a/src/buffer.c Thu Dec 23 16:43:51 2004 +0000 +++ b/src/buffer.c Thu Jan 06 15:00:09 2005 +0000 @@ -1251,29 +1251,6 @@ return buf; } -DEFUN ("buffer-disable-undo", Fbuffer_disable_undo, Sbuffer_disable_undo, - 0, 1, "", - doc: /* Make BUFFER stop keeping undo information. -No argument or nil as argument means do this for the current buffer. */) - (buffer) - register Lisp_Object buffer; -{ - Lisp_Object real_buffer; - - if (NILP (buffer)) - XSETBUFFER (real_buffer, current_buffer); - else - { - real_buffer = Fget_buffer (buffer); - if (NILP (real_buffer)) - nsberror (buffer); - } - - XBUFFER (real_buffer)->undo_list = Qt; - - return Qnil; -} - DEFUN ("buffer-enable-undo", Fbuffer_enable_undo, Sbuffer_enable_undo, 0, 1, "", doc: /* Start keeping undo information for buffer BUFFER. @@ -5671,9 +5648,10 @@ DEFVAR_PER_BUFFER ("vertical-scroll-bar", ¤t_buffer->vertical_scroll_bar_type, Qnil, doc: /* *Position of this buffer's vertical scroll bar. -A value of left or right means to place the vertical scroll bar at that side -of the window; a value of nil means that this window has no vertical scroll bar. -A value of t means to use the vertical scroll bar type from the window's frame. */); +The value takes effect whenever you display this buffer in a window. +A value of `left' or `right' means put the vertical scroll bar at that side +of the window; a value of nil means don't show any vertical scroll bars. +A value of t (the default) means do whatever the window's frame specifies. */); DEFVAR_PER_BUFFER ("indicate-empty-lines", ¤t_buffer->indicate_empty_lines, Qnil, @@ -5951,7 +5929,6 @@ defsubr (&Sbuffer_modified_tick); defsubr (&Srename_buffer); defsubr (&Sother_buffer); - defsubr (&Sbuffer_disable_undo); defsubr (&Sbuffer_enable_undo); defsubr (&Skill_buffer); defsubr (&Sset_buffer_major_mode);
--- a/src/coding.c Thu Dec 23 16:43:51 2004 +0000 +++ b/src/coding.c Thu Jan 06 15:00:09 2005 +0000 @@ -5877,7 +5877,6 @@ REQUIRE + LEN_BYTE = LEN_BYTE * (NEW / ORIG) REQUIRE = LEN_BYTE * (NEW - ORIG) / ORIG Here, we are sure that NEW >= ORIG. */ - float ratio; if (coding->produced <= coding->consumed) { @@ -5887,7 +5886,8 @@ } else { - ratio = (coding->produced - coding->consumed) / coding->consumed; + float ratio = coding->produced - coding->consumed; + ratio /= coding->consumed; require = len_byte * ratio; } first = 0;
--- a/src/data.c Thu Dec 23 16:43:51 2004 +0000 +++ b/src/data.c Thu Jan 06 15:00:09 2005 +0000 @@ -723,7 +723,7 @@ && EQ (XCAR (XSYMBOL (symbol)->function), Qautoload)) LOADHIST_ATTACH (Fcons (Qt, symbol)); definition = Ffset (symbol, definition); - LOADHIST_ATTACH (symbol); + LOADHIST_ATTACH (Fcons (Qdefun, symbol)); if (!NILP (docstring)) Fput (symbol, Qfunction_documentation, docstring); return definition;
--- a/src/dispextern.h Thu Dec 23 16:43:51 2004 +0000 +++ b/src/dispextern.h Thu Jan 06 15:00:09 2005 +0000 @@ -62,7 +62,7 @@ typedef HDC XImagePtr_or_DC; #endif -#ifdef HAVE_CARBON +#ifdef MAC_OS #include "macgui.h" typedef struct mac_display_info Display_Info; /* Mac equivalent of XImage. */ @@ -1166,7 +1166,7 @@ unsigned for_overlaps_p : 1; /* The GC to use for drawing this glyph string. */ -#if defined(HAVE_X_WINDOWS) || defined(HAVE_CARBON) +#if defined(HAVE_X_WINDOWS) || defined(MAC_OS) GC gc; #endif #if defined(HAVE_NTGUI)
--- a/src/emacs.c Thu Dec 23 16:43:51 2004 +0000 +++ b/src/emacs.c Thu Jan 06 15:00:09 2005 +0000 @@ -1307,7 +1307,7 @@ creates a full-fledge output_mac type frame. This does not work correctly before syms_of_textprop, syms_of_macfns, syms_of_ccl, syms_of_fontset, syms_of_xterm, syms_of_search, - syms_of_frame, mac_initialize, and init_keyboard have already + syms_of_frame, mac_term_init, and init_keyboard have already been called. */ syms_of_textprop (); syms_of_macfns (); @@ -1319,7 +1319,7 @@ syms_of_search (); syms_of_frame (); - mac_initialize (); + mac_term_init (build_string ("Mac"), NULL, NULL); init_keyboard (); #endif
--- a/src/eval.c Thu Dec 23 16:43:51 2004 +0000 +++ b/src/eval.c Thu Jan 06 15:00:09 2005 +0000 @@ -88,7 +88,7 @@ int gcpro_level; #endif -Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp, Qdefun, Qdefvar; +Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp, Qdefun; Lisp_Object Qinhibit_quit, Vinhibit_quit, Vquit_flag; Lisp_Object Qand_rest, Qand_optional; Lisp_Object Qdebug_on_error; @@ -647,7 +647,7 @@ && EQ (XCAR (XSYMBOL (fn_name)->function), Qautoload)) LOADHIST_ATTACH (Fcons (Qt, fn_name)); Ffset (fn_name, defn); - LOADHIST_ATTACH (fn_name); + LOADHIST_ATTACH (Fcons (Qdefun, fn_name)); return fn_name; } @@ -716,7 +716,7 @@ && EQ (XCAR (XSYMBOL (fn_name)->function), Qautoload)) LOADHIST_ATTACH (Fcons (Qt, fn_name)); Ffset (fn_name, defn); - LOADHIST_ATTACH (fn_name); + LOADHIST_ATTACH (Fcons (Qdefun, fn_name)); return fn_name; } @@ -742,7 +742,7 @@ sym->indirect_variable = 1; sym->value = aliased; sym->constant = SYMBOL_CONSTANT_P (aliased); - LOADHIST_ATTACH (Fcons (Qdefvar, symbol)); + LOADHIST_ATTACH (symbol); if (!NILP (docstring)) Fput (symbol, Qvariable_documentation, docstring); @@ -810,7 +810,7 @@ tem = Fpurecopy (tem); Fput (sym, Qvariable_documentation, tem); } - LOADHIST_ATTACH (Fcons (Qdefvar, sym)); + LOADHIST_ATTACH (sym); } else /* Simple (defvar <var>) should not count as a definition at all. @@ -853,7 +853,7 @@ tem = Fpurecopy (tem); Fput (sym, Qvariable_documentation, tem); } - LOADHIST_ATTACH (Fcons (Qdefvar, sym)); + LOADHIST_ATTACH (sym); return sym; } @@ -3376,9 +3376,6 @@ Qdefun = intern ("defun"); staticpro (&Qdefun); - Qdefvar = intern ("defvar"); - staticpro (&Qdefvar); - Qand_rest = intern ("&rest"); staticpro (&Qand_rest);
--- a/src/fileio.c Thu Dec 23 16:43:51 2004 +0000 +++ b/src/fileio.c Thu Jan 06 15:00:09 2005 +0000 @@ -6190,7 +6190,7 @@ before any other event (mouse or keypress) is handeled. */) () { -#if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (TARGET_API_MAC_CARBON) +#if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON) if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event)) && use_dialog_box && use_file_dialog @@ -6331,7 +6331,7 @@ GCPRO2 (insdef, default_filename); -#if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (TARGET_API_MAC_CARBON) +#if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON) if (! NILP (Fnext_read_file_uses_dialog_p ())) { /* If DIR contains a file name, split it. */
--- a/src/fns.c Thu Dec 23 16:43:51 2004 +0000 +++ b/src/fns.c Thu Jan 06 15:00:09 2005 +0000 @@ -26,8 +26,8 @@ #endif #include <time.h> -#ifndef MAC_OSX -/* On Mac OS X, defining this conflicts with precompiled headers. */ +#ifndef MAC_OS +/* On Mac OS, defining this conflicts with precompiled headers. */ /* Note on some machines this defines `vector' as a typedef, so make sure we don't use that name in this file. */
--- a/src/frame.c Thu Dec 23 16:43:51 2004 +0000 +++ b/src/frame.c Thu Jan 06 15:00:09 2005 +0000 @@ -3052,8 +3052,6 @@ XSETINT (icon_top, 0); } -#ifndef HAVE_CARBON - /* MAC_TODO: fullscreen */ if (FRAME_VISIBLE_P (f) && fullscreen_is_being_set) { /* If the frame is visible already and the fullscreen parameter is @@ -3069,7 +3067,6 @@ if (new_top != f->top_pos || new_left != f->left_pos) x_set_offset (f, new_left, new_top, 1); } -#endif /* Don't set these parameters unless they've been explicitly specified. The window might be mapped or resized while we're in @@ -3230,14 +3227,11 @@ store_in_alist (alistptr, Qdisplay, XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element)); -#ifndef HAVE_CARBON -/* A Mac Window is identified by a struct, not an integer. */ if (FRAME_X_OUTPUT (f)->parent_desc == FRAME_X_DISPLAY_INFO (f)->root_window) tem = Qnil; else XSETFASTINT (tem, FRAME_X_OUTPUT (f)->parent_desc); store_in_alist (alistptr, Qparent_id, tem); -#endif } @@ -3249,7 +3243,6 @@ struct frame *f; Lisp_Object new_value, old_value; { -#ifndef HAVE_CARBON if (NILP (new_value)) f->want_fullscreen = FULLSCREEN_NONE; else if (EQ (new_value, Qfullboth)) @@ -3258,7 +3251,6 @@ f->want_fullscreen = FULLSCREEN_WIDTH; else if (EQ (new_value, Qfullheight)) f->want_fullscreen = FULLSCREEN_HEIGHT; -#endif } @@ -3378,7 +3370,7 @@ if (XINT (arg) == f->border_width) return; -#ifndef HAVE_CARBON +#ifndef MAC_OS if (FRAME_X_WINDOW (f) != 0) error ("Cannot change the border width of a window"); #endif /* MAC_TODO */ @@ -4300,7 +4292,7 @@ DEFVAR_LISP ("default-frame-scroll-bars", &Vdefault_frame_scroll_bars, doc: /* Default position of scroll bars on this window-system. */); #ifdef HAVE_WINDOW_SYSTEM -#if defined(HAVE_NTGUI) || defined(HAVE_CARBON) +#if defined(HAVE_NTGUI) || defined(MAC_OS) /* MS-Windows has scroll bars on the right by default. */ Vdefault_frame_scroll_bars = Qright; #else
--- a/src/gtkutil.c Thu Dec 23 16:43:51 2004 +0000 +++ b/src/gtkutil.c Thu Jan 06 15:00:09 2005 +0000 @@ -3356,12 +3356,37 @@ GList *icon_list; GList *iter; struct x_output *x = f->output_data.x; + int hmargin, vmargin; if (! FRAME_GTK_WIDGET (f)) return; BLOCK_INPUT; + if (INTEGERP (Vtool_bar_button_margin) + && XINT (Vtool_bar_button_margin) > 0) + { + hmargin = XFASTINT (Vtool_bar_button_margin); + vmargin = XFASTINT (Vtool_bar_button_margin); + } + else if (CONSP (Vtool_bar_button_margin)) + { + if (INTEGERP (XCAR (Vtool_bar_button_margin)) + && XINT (XCAR (Vtool_bar_button_margin)) > 0) + hmargin = XFASTINT (XCAR (Vtool_bar_button_margin)); + + if (INTEGERP (XCDR (Vtool_bar_button_margin)) + && XINT (XCDR (Vtool_bar_button_margin)) > 0) + vmargin = XFASTINT (XCDR (Vtool_bar_button_margin)); + } + + /* The natural size (i.e. when GTK uses 0 as margin) looks best, + so take DEFAULT_TOOL_BAR_BUTTON_MARGIN to mean "default for GTK", + i.e. zero. This means that margins less than + DEFAULT_TOOL_BAR_BUTTON_MARGIN has no effect. */ + hmargin = max (0, hmargin - DEFAULT_TOOL_BAR_BUTTON_MARGIN); + vmargin = max (0, vmargin - DEFAULT_TOOL_BAR_BUTTON_MARGIN); + if (! x->toolbar_widget) xg_create_tool_bar (f); @@ -3425,6 +3450,8 @@ { GtkWidget *w = xg_get_image_for_pixmap (f, img, x->widget, NULL); + gtk_misc_set_padding (GTK_MISC (w), hmargin, vmargin); + gtk_toolbar_append_item (GTK_TOOLBAR (x->toolbar_widget), 0, 0, 0, w, @@ -3480,6 +3507,8 @@ XG_TOOL_BAR_IMAGE_DATA); g_list_free (chlist); + gtk_misc_set_padding (GTK_MISC (wimage), hmargin, vmargin); + if (old_img != img->pixmap) (void) xg_get_image_for_pixmap (f, img, x->widget, wimage); @@ -3549,6 +3578,8 @@ void xg_initialize () { + GtkBindingSet *binding_set; + xg_ignore_gtk_scrollbar = 0; xg_detached_menus = 0; xg_menu_cb_list.prev = xg_menu_cb_list.next = @@ -3571,6 +3602,17 @@ "gtk-key-theme-name", "Emacs", EMACS_CLASS); + + /* Make dialogs close on C-g. Since file dialog inherits from + dialog, this works for them also. */ + binding_set = gtk_binding_set_by_class (gtk_type_class (GTK_TYPE_DIALOG)); + gtk_binding_entry_add_signal (binding_set, GDK_g, GDK_CONTROL_MASK, + "close", 0); + + /* Make menus close on C-g. */ + binding_set = gtk_binding_set_by_class (gtk_type_class (GTK_TYPE_MENU_SHELL)); + gtk_binding_entry_add_signal (binding_set, GDK_g, GDK_CONTROL_MASK, + "cancel", 0); } #endif /* USE_GTK */
--- a/src/image.c Thu Dec 23 16:43:51 2004 +0000 +++ b/src/image.c Thu Jan 06 15:00:09 2005 +0000 @@ -83,16 +83,19 @@ #ifdef MAC_OS #include "macterm.h" +#include <sys/stat.h> #ifndef MAC_OSX #include <alloca.h> +#include <sys/param.h> #endif #ifdef MAC_OSX -#include <sys/stat.h> #include <QuickTime/QuickTime.h> #else /* not MAC_OSX */ #include <Windows.h> #include <Gestalt.h> #include <TextUtils.h> +#include <ImageCompression.h> +#include <QuickTimeComponents.h> #endif /* not MAC_OSX */ /* MAC_TODO : Color tables on Mac. */ @@ -6269,6 +6272,12 @@ #undef HAVE_STDLIB_H #endif /* HAVE_STLIB_H */ +#if defined (HAVE_NTGUI) && !defined (__WIN32__) +/* jpeglib.h will define boolean differently depending on __WIN32__, + so make sure it is defined. */ +#define __WIN32__ 1 +#endif + #include <jpeglib.h> #include <jerror.h> #include <setjmp.h>
--- a/src/keyboard.c Thu Dec 23 16:43:51 2004 +0000 +++ b/src/keyboard.c Thu Jan 06 15:00:09 2005 +0000 @@ -6910,14 +6910,16 @@ sigisheld (SIGIO); #endif - if (input_available_clear_time) - EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0); - #ifdef SYNC_INPUT interrupt_input_pending = 1; #else - SIGNAL_THREAD_CHECK (signo); +#endif + + if (input_available_clear_time) + EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0); + +#ifndef SYNC_INPUT handle_async_input (); #endif
--- a/src/lisp.h Thu Dec 23 16:43:51 2004 +0000 +++ b/src/lisp.h Thu Jan 06 15:00:09 2005 +0000 @@ -1671,8 +1671,16 @@ #define DEFVAR_LISP_NOPRO(lname, vname, doc) defvar_lisp_nopro (lname, vname) #define DEFVAR_BOOL(lname, vname, doc) defvar_bool (lname, vname) #define DEFVAR_INT(lname, vname, doc) defvar_int (lname, vname) + +/* TYPE is nil for a general Lisp variable. + An integer specifies a type; then only LIsp values + with that type code are allowed (except that nil is allowed too). + LNAME is the LIsp-level variable name. + VNAME is the name of the buffer slot. + DOC is a dummy where you write the doc string as a comment. */ #define DEFVAR_PER_BUFFER(lname, vname, type, doc) \ defvar_per_buffer (lname, vname, type, 0) + #define DEFVAR_KBOARD(lname, vname, doc) \ defvar_kboard (lname, \ (int)((char *)(¤t_kboard->vname) \
--- a/src/lread.c Thu Dec 23 16:43:51 2004 +0000 +++ b/src/lread.c Thu Jan 06 15:00:09 2005 +0000 @@ -3847,10 +3847,10 @@ Each alist element is a list that starts with a file name, except for one element (optional) that starts with nil and describes definitions evaluated from buffers not visiting files. -The remaining elements of each list are symbols defined as functions, +The remaining elements of each list are symbols defined as variables and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)', -`(defvar . VARIABLE), `(autoload . SYMBOL)', and `(t . SYMBOL)'. -An element `(t . SYMBOL)' precedes an entry that is just SYMBOL, +`(defun . FUNCTION)', `(autoload . SYMBOL)', and `(t . SYMBOL)'. +An element `(t . SYMBOL)' precedes an entry `(defun . FUNCTION)', and means that SYMBOL was an autoload before this file redefined it as a function. */); Vload_history = Qnil;
--- a/src/mac.c Thu Dec 23 16:43:51 2004 +0000 +++ b/src/mac.c Thu Jan 06 15:00:09 2005 +0000 @@ -845,6 +845,8 @@ } +extern Boolean mac_wait_next_event (EventRecord *, UInt32, Boolean); + int select (n, rfds, wfds, efds, timeout) int n; @@ -853,49 +855,24 @@ SELECT_TYPE *efds; struct timeval *timeout; { -#ifdef TARGET_API_MAC_CARBON +#if TARGET_API_MAC_CARBON return 1; #else /* not TARGET_API_MAC_CARBON */ - EMACS_TIME end_time, now; EventRecord e; + UInt32 sleep_time = EMACS_SECS (*timeout) * 60 + + ((EMACS_USECS (*timeout) * 60) / 1000000); /* Can only handle wait for keyboard input. */ if (n > 1 || wfds || efds) return -1; - EMACS_GET_TIME (end_time); - EMACS_ADD_TIME (end_time, end_time, *timeout); - - do - { - /* Also return true if an event other than a keyDown has - occurred. This causes kbd_buffer_get_event in keyboard.c to - call read_avail_input which in turn calls XTread_socket to - poll for these events. Otherwise these never get processed - except but a very slow poll timer. */ - if (FD_ISSET (0, rfds) && EventAvail (everyEvent, &e)) - return 1; - - /* Also check movement of the mouse. */ - { - Point mouse_pos; - static Point old_mouse_pos = {-1, -1}; - - GetMouse (&mouse_pos); - if (!EqualPt (mouse_pos, old_mouse_pos)) - { - old_mouse_pos = mouse_pos; - return 1; - } - } - - WaitNextEvent (0, &e, 1UL, NULL); /* Accept no event; wait 1 - tic. by T.I. */ - - EMACS_GET_TIME (now); - EMACS_SUB_TIME (now, end_time, now); - } - while (!EMACS_TIME_NEG_P (now)); + /* Also return true if an event other than a keyDown has occurred. + This causes kbd_buffer_get_event in keyboard.c to call + read_avail_input which in turn calls XTread_socket to poll for + these events. Otherwise these never get processed except but a + very slow poll timer. */ + if (FD_ISSET (0, rfds) && mac_wait_next_event (&e, sleep_time, false)) + return 1; return 0; #endif /* not TARGET_API_MAC_CARBON */ @@ -1996,7 +1973,7 @@ const char *workdir; const char *infn, *outfn, *errfn; { -#ifdef TARGET_API_MAC_CARBON +#if TARGET_API_MAC_CARBON return -1; #else /* not TARGET_API_MAC_CARBON */ char macappname[MAXPATHLEN+1], macworkdir[MAXPATHLEN+1]; @@ -2081,7 +2058,7 @@ strcat (t, newargv[0]); #endif /* 0 */ Lisp_Object path; - openp (Vexec_path, build_string (newargv[0]), EXEC_SUFFIXES, &path, + openp (Vexec_path, build_string (newargv[0]), Vexec_suffixes, &path, make_number (X_OK)); if (NILP (path)) @@ -2793,17 +2770,98 @@ return Qnil; } +extern void mac_clear_font_name_table P_ ((void)); + +DEFUN ("mac-clear-font-name-table", Fmac_clear_font_name_table, Smac_clear_font_name_table, 0, 0, 0, + doc: /* Clear the font name table. */) + () +{ + check_mac (); + mac_clear_font_name_table (); + return Qnil; +} + #ifdef MAC_OSX #undef select extern int inhibit_window_system; extern int noninteractive; -/* When Emacs is started from the Finder, SELECT always immediately - returns as if input is present when file descriptor 0 is polled for - input. Strangely, when Emacs is run as a GUI application from the - command line, it blocks in the same situation. This `wrapper' of - the system call SELECT corrects this discrepancy. */ +/* Unlike in X11, window events in Carbon do not come from sockets. + So we cannot simply use `select' to monitor two kinds of inputs: + window events and process outputs. We emulate such functionality + by regarding fd 0 as the window event channel and simultaneously + monitoring both kinds of input channels. It is implemented by + dividing into some cases: + 1. The window event channel is not involved. + -> Use `select'. + 2. Sockets are not involved. + -> Use ReceiveNextEvent. + 3. [If SELECT_USE_CFSOCKET is defined] + Only the window event channel and socket read channels are + involved, and timeout is not too short (greater than + SELECT_TIMEOUT_THRESHHOLD_RUNLOOP seconds). + -> Create CFSocket for each socket and add it into the current + event RunLoop so that an `ready-to-read' event can be posted + to the event queue that is also used for window events. Then + ReceiveNextEvent can wait for both kinds of inputs. + 4. Otherwise. + -> Periodically poll the window input channel while repeatedly + executing `select' with a short timeout + (SELECT_POLLING_PERIOD_USEC microseconds). */ + +#define SELECT_POLLING_PERIOD_USEC 20000 +#ifdef SELECT_USE_CFSOCKET +#define SELECT_TIMEOUT_THRESHOLD_RUNLOOP 0.2 +#define EVENT_CLASS_SOCK 'Sock' + +static void +socket_callback (s, type, address, data, info) + CFSocketRef s; + CFSocketCallBackType type; + CFDataRef address; + const void *data; + void *info; +{ + EventRef event; + + CreateEvent (NULL, EVENT_CLASS_SOCK, 0, 0, kEventAttributeNone, &event); + PostEventToQueue (GetCurrentEventQueue (), event, kEventPriorityStandard); + ReleaseEvent (event); +} +#endif /* SELECT_USE_CFSOCKET */ + +static int +select_and_poll_event (n, rfds, wfds, efds, timeout) + int n; + SELECT_TYPE *rfds; + SELECT_TYPE *wfds; + SELECT_TYPE *efds; + struct timeval *timeout; +{ + int r; + OSErr err; + + r = select (n, rfds, wfds, efds, timeout); + if (r != -1) + { + BLOCK_INPUT; + err = ReceiveNextEvent (0, NULL, kEventDurationNoWait, + kEventLeaveInQueue, NULL); + UNBLOCK_INPUT; + if (err == noErr) + { + FD_SET (0, rfds); + r++; + } + } + return r; +} + +#ifndef MAC_OS_X_VERSION_10_2 +#undef SELECT_INVALIDATE_CFSOCKET +#endif + int sys_select (n, rfds, wfds, efds, timeout) int n; @@ -2813,91 +2871,182 @@ struct timeval *timeout; { OSErr err; - EMACS_TIME end_time, now, remaining_time; - + int i, r; + EMACS_TIME select_timeout; + if (inhibit_window_system || noninteractive || rfds == NULL || !FD_ISSET (0, rfds)) return select (n, rfds, wfds, efds, timeout); - + + FD_CLR (0, rfds); + if (wfds == NULL && efds == NULL) { - int i; + int nsocks = 0; + SELECT_TYPE orfds = *rfds; + + EventTimeout timeout_sec = + (timeout + ? (EMACS_SECS (*timeout) * kEventDurationSecond + + EMACS_USECS (*timeout) * kEventDurationMicrosecond) + : kEventDurationForever); for (i = 1; i < n; i++) if (FD_ISSET (i, rfds)) - break; - if (i == n) - { - EventTimeout timeout_sec = - (timeout - ? (EMACS_SECS (*timeout) * kEventDurationSecond - + EMACS_USECS (*timeout) * kEventDurationMicrosecond) - : kEventDurationForever); - + nsocks++; + + if (nsocks == 0) + { BLOCK_INPUT; err = ReceiveNextEvent (0, NULL, timeout_sec, kEventLeaveInQueue, NULL); UNBLOCK_INPUT; if (err == noErr) { - FD_ZERO (rfds); FD_SET (0, rfds); return 1; } else return 0; } - } - - if (timeout) - { - remaining_time = *timeout; - EMACS_GET_TIME (now); - EMACS_ADD_TIME (end_time, now, remaining_time); + + /* Avoid initial overhead of RunLoop setup for the case that + some input is already available. */ + EMACS_SET_SECS_USECS (select_timeout, 0, 0); + r = select_and_poll_event (n, rfds, wfds, efds, &select_timeout); + if (r != 0 || timeout_sec == 0.0) + return r; + + *rfds = orfds; + +#ifdef SELECT_USE_CFSOCKET + if (timeout_sec > 0 && timeout_sec <= SELECT_TIMEOUT_THRESHOLD_RUNLOOP) + goto poll_periodically; + + { + CFRunLoopRef runloop = + (CFRunLoopRef) GetCFRunLoopFromEventLoop (GetCurrentEventLoop ()); + EventTypeSpec specs[] = {{EVENT_CLASS_SOCK, 0}}; +#ifdef SELECT_INVALIDATE_CFSOCKET + CFSocketRef *shead, *s; +#else + CFRunLoopSourceRef *shead, *s; +#endif + + BLOCK_INPUT; + +#ifdef SELECT_INVALIDATE_CFSOCKET + shead = xmalloc (sizeof (CFSocketRef) * nsocks); +#else + shead = xmalloc (sizeof (CFRunLoopSourceRef) * nsocks); +#endif + s = shead; + for (i = 1; i < n; i++) + if (FD_ISSET (i, rfds)) + { + CFSocketRef socket = + CFSocketCreateWithNative (NULL, i, kCFSocketReadCallBack, + socket_callback, NULL); + CFRunLoopSourceRef source = + CFSocketCreateRunLoopSource (NULL, socket, 0); + +#ifdef SELECT_INVALIDATE_CFSOCKET + CFSocketSetSocketFlags (socket, 0); +#endif + CFRunLoopAddSource (runloop, source, kCFRunLoopDefaultMode); +#ifdef SELECT_INVALIDATE_CFSOCKET + CFRelease (source); + *s = socket; +#else + CFRelease (socket); + *s = source; +#endif + s++; + } + + err = ReceiveNextEvent (0, NULL, timeout_sec, kEventLeaveInQueue, NULL); + + do + { + --s; +#ifdef SELECT_INVALIDATE_CFSOCKET + CFSocketInvalidate (*s); +#else + CFRunLoopRemoveSource (runloop, *s, kCFRunLoopDefaultMode); +#endif + CFRelease (*s); + } + while (s != shead); + + xfree (shead); + + if (err) + { + FD_ZERO (rfds); + r = 0; + } + else + { + FlushEventsMatchingListFromQueue (GetCurrentEventQueue (), + GetEventTypeCount (specs), + specs); + EMACS_SET_SECS_USECS (select_timeout, 0, 0); + r = select_and_poll_event (n, rfds, wfds, efds, &select_timeout); + } + + UNBLOCK_INPUT; + + return r; + } +#endif /* SELECT_USE_CFSOCKET */ } - FD_CLR (0, rfds); - do - { - EMACS_TIME select_timeout; - SELECT_TYPE orfds = *rfds; - int r; - - EMACS_SET_SECS_USECS (select_timeout, 0, 20000); - - if (timeout && EMACS_TIME_LT (remaining_time, select_timeout)) - select_timeout = remaining_time; - - r = select (n, &orfds, wfds, efds, &select_timeout); - BLOCK_INPUT; - err = ReceiveNextEvent (0, NULL, kEventDurationNoWait, - kEventLeaveInQueue, NULL); - UNBLOCK_INPUT; - if (r > 0) - { - *rfds = orfds; - if (err == noErr) - { - FD_SET (0, rfds); - r++; - } + + poll_periodically: + { + EMACS_TIME end_time, now, remaining_time; + SELECT_TYPE orfds = *rfds, owfds, oefds; + + if (wfds) + owfds = *wfds; + if (efds) + oefds = *efds; + if (timeout) + { + remaining_time = *timeout; + EMACS_GET_TIME (now); + EMACS_ADD_TIME (end_time, now, remaining_time); + } + + do + { + EMACS_SET_SECS_USECS (select_timeout, 0, SELECT_POLLING_PERIOD_USEC); + if (timeout && EMACS_TIME_LT (remaining_time, select_timeout)) + select_timeout = remaining_time; + r = select_and_poll_event (n, rfds, wfds, efds, &select_timeout); + if (r != 0) return r; - } - else if (err == noErr) - { - FD_ZERO (rfds); - FD_SET (0, rfds); - return 1; - } - - if (timeout) - { - EMACS_GET_TIME (now); - EMACS_SUB_TIME (remaining_time, end_time, now); - } - } - while (!timeout || EMACS_TIME_LT (now, end_time)); - - return 0; + + *rfds = orfds; + if (wfds) + *wfds = owfds; + if (efds) + *efds = oefds; + + if (timeout) + { + EMACS_GET_TIME (now); + EMACS_SUB_TIME (remaining_time, end_time, now); + } + } + while (!timeout || EMACS_TIME_LT (now, end_time)); + + FD_ZERO (rfds); + if (wfds) + FD_ZERO (wfds); + if (efds) + FD_ZERO (efds); + return 0; + } } /* Set up environment variables so that Emacs can correctly find its @@ -3043,6 +3192,7 @@ defsubr (&Smac_paste_function); defsubr (&Smac_cut_function); defsubr (&Sx_selection_exists_p); + defsubr (&Smac_clear_font_name_table); defsubr (&Sdo_applescript); defsubr (&Smac_file_name_to_posix);
--- a/src/macfns.c Thu Dec 23 16:43:51 2004 +0000 +++ b/src/macfns.c Thu Jan 06 15:00:09 2005 +0000 @@ -158,9 +158,7 @@ extern Lisp_Object Vwindow_system_version; -extern int mac_initialized; - - +#if 0 /* Use xstricmp instead. */ /* compare two strings ignoring case */ static int @@ -171,13 +169,14 @@ return 0; return tolower (*s) - tolower (*t); } +#endif /* compare two strings up to n characters, ignoring case */ static int strnicmp (const char *s, const char *t, unsigned int n) { - for ( ; n-- > 0 && tolower (*s) == tolower (*t); s++, t++) + for ( ; n > 0 && tolower (*s) == tolower (*t); n--, s++, t++) if (*s == '\0') return 0; return n == 0 ? 0 : tolower (*s) - tolower (*t); @@ -190,7 +189,7 @@ check_mac () { if (! mac_in_use) - error ("Mac OS not in use or not initialized"); + error ("Mac native windows not in use or not initialized"); } /* Nonzero if we can use mouse menus. @@ -228,33 +227,28 @@ check_x_display_info (frame) Lisp_Object frame; { - if (!mac_initialized) - { - mac_initialize (); - mac_initialized = 1; - } + struct mac_display_info *dpyinfo = NULL; if (NILP (frame)) { struct frame *sf = XFRAME (selected_frame); if (FRAME_MAC_P (sf) && FRAME_LIVE_P (sf)) - return FRAME_MAC_DISPLAY_INFO (sf); + dpyinfo = FRAME_MAC_DISPLAY_INFO (sf); + else if (x_display_list != 0) + dpyinfo = x_display_list; else - return &one_mac_display_info; + error ("Mac native windows are not in use or not initialized"); } else if (STRINGP (frame)) - return x_display_info_for_name (frame); + dpyinfo = x_display_info_for_name (frame); else { - FRAME_PTR f; - - CHECK_LIVE_FRAME (frame); - f = XFRAME (frame); - if (! FRAME_MAC_P (f)) - error ("non-mac frame used"); - return FRAME_MAC_DISPLAY_INFO (f); + FRAME_PTR f = check_x_frame (frame); + dpyinfo = FRAME_MAC_DISPLAY_INFO (f); } + + return dpyinfo; } /* Return the Emacs frame-object corresponding to a mac window. @@ -1109,7 +1103,7 @@ BLOCK_INPUT; for (i = 0; i < sizeof (mac_color_map) / sizeof (mac_color_map[0]); i++) - if (stricmp (colorname, mac_color_map[i].name) == 0) + if (xstricmp (colorname, mac_color_map[i].name) == 0) { ret = make_number (mac_color_map[i].color); break; @@ -2059,13 +2053,49 @@ /* Subroutines of creating a frame. */ +static char * +mac_get_rdb_resource (rdb, resource) + char *rdb; + char *resource; +{ + char *value = rdb; + int len = strlen (resource); + + while (*value) + { + if ((strncmp (value, resource, len) == 0) && (value[len] == ':')) + return xstrdup (&value[len + 1]); + + value = strchr (value, '\0') + 1; + } + + return NULL; +} + +/* Retrieve the string resource specified by NAME with CLASS from + database RDB. */ + char * x_get_string_resource (rdb, name, class) XrmDatabase rdb; char *name, *class; { - /* MAC_TODO: implement resource strings */ + if (rdb) + { + char *resource; + + if (resource = mac_get_rdb_resource (rdb, name)) + return resource; + if (resource = mac_get_rdb_resource (rdb, class)) + return resource; + } + + /* MAC_TODO: implement resource strings. (Maybe Property Lists?) */ +#if 0 + return mac_get_string_resource (name, class); +#else return (char *)0; +#endif } /* Return the value of parameter PARAM. @@ -2229,36 +2259,38 @@ } -#if 0 /* MAC_TODO */ /* Create and set up the Mac window for frame F. */ +extern install_window_handler (WindowPtr); + static void -mac_window (f, window_prompting, minibuffer_only) +mac_window (f) struct frame *f; - long window_prompting; - int minibuffer_only; { Rect r; BLOCK_INPUT; - /* Use the resource name as the top-level window name - for looking up resources. Make a non-Lisp copy - for the window manager, so GC relocation won't bother it. - - Elsewhere we specify the window name for the window manager. */ - - { - char *str = (char *) SDATA (Vx_resource_name); - f->namebuf = (char *) xmalloc (strlen (str) + 1); - strcpy (f->namebuf, str); - } - SetRect (&r, f->left_pos, f->top_pos, f->left_pos + FRAME_PIXEL_WIDTH (f), f->top_pos + FRAME_PIXEL_HEIGHT (f)); +#if TARGET_API_MAC_CARBON + CreateNewWindow (kDocumentWindowClass, + kWindowStandardDocumentAttributes + /* | kWindowToolbarButtonAttribute */, + &r, &FRAME_MAC_WINDOW (f)); + if (FRAME_MAC_WINDOW (f)) + { + SetWRefCon (FRAME_MAC_WINDOW (f), (long) f->output_data.mac); + install_window_handler (FRAME_MAC_WINDOW (f)); + } +#else FRAME_MAC_WINDOW (f) - = NewCWindow (NULL, &r, "\p", 1, zoomDocProc, (WindowPtr) -1, 1, (long) f->output_data.mac); + = NewCWindow (NULL, &r, "\p", false, zoomDocProc, + (WindowPtr) -1, 1, (long) f->output_data.mac); +#endif + /* so that update events can find this mac_output struct */ + f->output_data.mac->mFP = f; /* point back to emacs frame */ validate_x_resource_name (); @@ -2276,17 +2308,11 @@ x_set_name (f, name, explicit); } - ShowWindow (FRAME_MAC_WINDOW (f)); - UNBLOCK_INPUT; - if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f)) - initialize_frame_menubar (f); - if (FRAME_MAC_WINDOW (f) == 0) error ("Unable to create window"); } -#endif /* MAC_TODO */ /* Handle the icon stuff for this window. Perhaps later we might want an x_set_icon_position which can be called interactively as @@ -2703,6 +2729,8 @@ "bufferPredicate", "BufferPredicate", RES_TYPE_SYMBOL); x_default_parameter (f, parms, Qtitle, Qnil, "title", "Title", RES_TYPE_STRING); + x_default_parameter (f, parms, Qfullscreen, Qnil, + "fullscreen", "Fullscreen", RES_TYPE_SYMBOL); f->output_data.mac->parent_desc = FRAME_MAC_DISPLAY_INFO (f)->root_window; @@ -2728,8 +2756,7 @@ tem = mac_get_arg (parms, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN); f->no_split = minibuffer_only || EQ (tem, Qt); - /* mac_window (f, window_prompting, minibuffer_only); */ - make_mac_frame (f); + mac_window (f); x_icon (f, parms); x_make_gc (f); @@ -2763,14 +2790,12 @@ FRAME_LINES (f) = 0; change_frame_size (f, height, width, 1, 0, 0); -#if 0 /* MAC_TODO: when we have window manager hints */ /* Tell the server what size and position, etc, we want, and how badly we want them. This should be done after we have the menu bar so that its size can be taken into account. */ BLOCK_INPUT; x_wm_set_size_hint (f, window_prompting, 0); UNBLOCK_INPUT; -#endif /* Make the window appear on the frame and enable display, unless the caller says not to. However, with explicit parent, Emacs @@ -3144,6 +3169,9 @@ CHECK_STRING (name); + if (! EQ (Vwindow_system, intern ("mac"))) + error ("Not using Mac native windows"); + for (dpyinfo = &one_mac_display_info, names = x_display_name_list; dpyinfo; dpyinfo = dpyinfo->next, names = XCDR (names)) @@ -3171,7 +3199,6 @@ return dpyinfo; } -#if 0 /* MAC_TODO: implement network support */ DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection, 1, 3, 0, doc: /* Open a connection to a server. @@ -3190,7 +3217,7 @@ CHECK_STRING (xrm_string); if (! EQ (Vwindow_system, intern ("mac"))) - error ("Not using Mac OS"); + error ("Not using Mac native windows"); if (! NILP (xrm_string)) xrm_option = (unsigned char *) SDATA (xrm_string); @@ -3238,11 +3265,9 @@ for (i = 0; i < dpyinfo->n_fonts; i++) if (dpyinfo->font_table[i].name) { - if (dpyinfo->font_table[i].name != dpyinfo->font_table[i].full_name) - xfree (dpyinfo->font_table[i].full_name); - xfree (dpyinfo->font_table[i].name); - x_unload_font (dpyinfo, dpyinfo->font_table[i].font); + mac_unload_font (dpyinfo, dpyinfo->font_table[i].font); } + x_destroy_all_bitmaps (dpyinfo); x_delete_display (dpyinfo); @@ -3250,7 +3275,6 @@ return Qnil; } -#endif /* 0 */ DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0, doc: /* Return the list of display names that Emacs has connections to. */) @@ -3813,18 +3837,23 @@ BLOCK_INPUT; SetRect (&r, 0, 0, 1, 1); +#if TARGET_API_MAC_CARBON if (CreateNewWindow (kHelpWindowClass, #ifdef MAC_OS_X_VERSION_10_2 kWindowIgnoreClicksAttribute | #endif + kWindowNoUpdatesAttribute | kWindowNoActivatesAttribute, &r, &tip_window) == noErr) +#else + if (tip_window = NewCWindow (NULL, &r, "\p", false, plainDBox, + NULL, false, 0L)) +#endif { FRAME_MAC_WINDOW (f) = tip_window; SetWRefCon (tip_window, (long) f->output_data.mac); /* so that update events can find this mac_output struct */ f->output_data.mac->mFP = f; - ShowWindow (tip_window); } UNBLOCK_INPUT; } @@ -4140,6 +4169,7 @@ BLOCK_INPUT; MoveWindow (FRAME_MAC_WINDOW (f), root_x, root_y, false); SizeWindow (FRAME_MAC_WINDOW (f), width, height, true); + ShowWindow (FRAME_MAC_WINDOW (f)); BringToFront (FRAME_MAC_WINDOW (f)); UNBLOCK_INPUT; @@ -4198,7 +4228,7 @@ -#ifdef TARGET_API_MAC_CARBON +#if TARGET_API_MAC_CARBON /*********************************************************************** File selection dialog ***********************************************************************/ @@ -4405,14 +4435,19 @@ x_set_fringe_width, x_set_fringe_width, 0, /* x_set_wait_for_wm, */ - 0, /* MAC_TODO: x_set_fullscreen, */ + x_set_fullscreen, }; void syms_of_macfns () { - /* Certainly running on Mac. */ +#ifdef MAC_OSX + /* This is zero if not using Mac native windows. */ + mac_in_use = 0; +#else + /* Certainly running on Mac native windows. */ mac_in_use = 1; +#endif /* The section below is built by the lisp expression at the top of the file, just above where these variables are declared. */ @@ -4536,10 +4571,8 @@ defsubr (&Sx_display_backing_store); defsubr (&Sx_display_save_under); defsubr (&Sx_create_frame); -#if 0 /* MAC_TODO: implement network support */ defsubr (&Sx_open_connection); defsubr (&Sx_close_connection); -#endif defsubr (&Sx_display_list); defsubr (&Sx_synchronize);
--- a/src/macgui.h Thu Dec 23 16:43:51 2004 +0000 +++ b/src/macgui.h Thu Jan 06 15:00:09 2005 +0000 @@ -62,18 +62,17 @@ #else #include <QuickDraw.h> /* for WindowPtr */ #include <QDOffscreen.h> /* for GWorldPtr */ -#include <Controls.h> /* for ControlHandle in xdisp.c */ +#include <Windows.h> #include <Gestalt.h> #endif +typedef WindowPtr Window; typedef GWorldPtr Pixmap; #if TARGET_API_MAC_CARBON -typedef struct OpaqueWindowPtr *Window; #define Cursor ThemeCursor #define No_Cursor (-1) #else -typedef WindowPtr Window; #define SetPortWindowPort(w) SetPort(w) #define Cursor CursHandle #define No_Cursor (0) @@ -198,6 +197,29 @@ #define XNegative 0x0010 #define YNegative 0x0020 +typedef struct { + long flags; /* marks which fields in this structure are defined */ +#if 0 + int x, y; /* obsolete for new window mgrs, but clients */ + int width, height; /* should set so old wm's don't mess up */ +#endif + int min_width, min_height; +#if 0 + int max_width, max_height; +#endif + int width_inc, height_inc; +#if 0 + struct { + int x; /* numerator */ + int y; /* denominator */ + } min_aspect, max_aspect; +#endif + int base_width, base_height; /* added by ICCCM version 1 */ +#if 0 + int win_gravity; /* added by ICCCM version 1 */ +#endif +} XSizeHints; + #define USPosition (1L << 0) /* user specified x, y */ #define USSize (1L << 1) /* user specified width, height */
--- a/src/macterm.c Thu Dec 23 16:43:51 2004 +0000 +++ b/src/macterm.c Thu Jan 06 15:00:09 2005 +0000 @@ -1178,7 +1178,17 @@ x_update_begin (f) struct frame *f; { - /* Nothing to do. */ +#if TARGET_API_MAC_CARBON + /* During update of a frame, availability of input events is + periodically checked with ReceiveNextEvent if + redisplay-dont-pause is nil. That normally flushes window buffer + changes for every check, and thus screen update looks waving even + if no input is available. So we disable screen updates during + update of a frame. */ + BLOCK_INPUT; + DisableScreenUpdates (); + UNBLOCK_INPUT; +#endif } @@ -1263,7 +1273,7 @@ make sure that the mouse-highlight is properly redrawn. W may be a menu bar pseudo-window in case we don't have X toolkit - support. Such windows don't have a cursor, so don't display it + support. Such windows don't have a cursor, so don't display it here. */ static void @@ -1327,6 +1337,9 @@ mac_set_backcolor (FRAME_BACKGROUND_PIXEL (f)); +#if TARGET_API_MAC_CARBON + EnableScreenUpdates (); +#endif XFlush (FRAME_MAC_DISPLAY (f)); UNBLOCK_INPUT; } @@ -1983,7 +1996,7 @@ } else #endif -#if 0 /* defined(MAC_OS8)*/ +#ifdef MAC_OS8 if (FONT_HEIGHT (s->font) < s->height - 2 * box_line_width || s->font_not_found_p || s->extends_to_end_of_line_p @@ -2041,7 +2054,7 @@ for (i = 0; i < s->nchars; ++i) char1b[i] = s->char2b[i].byte2; -#if 0 /* defined(MAC_OS8) */ +#ifdef MAC_OS8 /* Draw text with XDrawString if background has already been filled. Otherwise, use XDrawImageString. (Note that XDrawImageString is usually faster than XDrawString.) Always @@ -2059,7 +2072,7 @@ XDrawString (s->display, s->window, s->gc, x, s->ybase - boff, char1b, s->nchars); } -#if 0 /* defined(MAC_OS8)*/ +#ifdef MAC_OS8 else { if (s->two_byte_p) @@ -3652,6 +3665,7 @@ +#if 0 /* Mouse clicks and mouse movement. Rah. */ /* Prepare a mouse-event in *RESULT for placement in the input queue. @@ -3685,6 +3699,7 @@ result->arg = Qnil; return Qnil; } +#endif /* Function to report a mouse movement to the mainstream Emacs code. @@ -3754,8 +3769,6 @@ static struct scroll_bar *x_window_to_scroll_bar (); static void x_scroll_bar_report_motion (); -static void x_check_fullscreen P_ ((struct frame *)); -static void x_check_fullscreen_move P_ ((struct frame *)); static int glyph_rect P_ ((struct frame *f, int, int, Rect *)); @@ -4017,7 +4030,7 @@ r.right = left + width; r.bottom = disp_top + disp_height; -#ifdef TARGET_API_MAC_CARBON +#if TARGET_API_MAC_CARBON ch = NewControl (FRAME_MAC_WINDOW (f), &r, "\p", 1, 0, 0, 0, kControlScrollBarProc, 0L); #else @@ -4395,7 +4408,7 @@ while (! NILP (bar)) { ch = SCROLL_BAR_CONTROL_HANDLE (XSCROLL_BAR (bar)); -#ifdef TARGET_API_MAC_CARBON +#if 1 /* TARGET_API_MAC_CARBON */ ActivateControl (ch); #else SetControlMaximum (ch, @@ -4419,10 +4432,10 @@ while (! NILP (bar)) { ch = SCROLL_BAR_CONTROL_HANDLE (XSCROLL_BAR (bar)); -#ifdef TARGET_API_MAC_CARBON +#if 1 /* TARGET_API_MAC_CARBON */ DeactivateControl (ch); #else - SetControlMaximum (ch, XINT (-1)); + SetControlMaximum (ch, -1); #endif bar = XSCROLL_BAR (bar)->next; } @@ -4466,7 +4479,7 @@ case kControlPageDownPart: bufp->part = scroll_bar_below_handle; break; -#ifdef TARGET_API_MAC_CARBON +#if TARGET_API_MAC_CARBON default: #else case kControlIndicatorPart: @@ -4974,13 +4987,16 @@ XSetFont (FRAME_MAC_DISPLAY (f), f->output_data.mac->cursor_gc, FRAME_FONT (f)); + /* Don't change the size of a tip frame; there's no point in + doing it because it's done in Fx_show_tip, and it leads to + problems because the tip frame has no widget. */ if (NILP (tip_frame) || XFRAME (tip_frame) != f) x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f)); } return build_string (fontp->full_name); } - + /* Give frame F the fontset named FONTSETNAME as its default font, and return the full name of that fontset. FONTSETNAME may be a wildcard pattern; in that case, we choose some fontset that fits the pattern. @@ -5369,6 +5385,25 @@ f->output_data.mac->asked_for_visible = 1; +#if TARGET_API_MAC_CARBON + if (!(FRAME_SIZE_HINTS (f)->flags & (USPosition | PPosition))) + { + struct frame *sf = SELECTED_FRAME (); + if (!FRAME_MAC_P (sf)) + RepositionWindow (FRAME_MAC_WINDOW (f), NULL, + kWindowCenterOnMainScreen); + else + RepositionWindow (FRAME_MAC_WINDOW (f), + FRAME_MAC_WINDOW (sf), +#ifdef MAC_OS_X_VERSION_10_2 + kWindowCascadeStartAtParentWindowScreen +#else + kWindowCascadeOnParentWindowScreen +#endif + ); + x_real_positions (f, &f->left_pos, &f->top_pos); + } +#endif ShowWindow (FRAME_MAC_WINDOW (f)); } @@ -5496,6 +5531,9 @@ x_free_gcs (f); + if (FRAME_SIZE_HINTS (f)) + xfree (FRAME_SIZE_HINTS (f)); + xfree (f->output_data.mac); f->output_data.mac = NULL; @@ -5548,143 +5586,39 @@ long flags; int user_position; { -#if 0 /* MAC_TODO: connect this to the Appearance Manager */ - XSizeHints size_hints; - -#ifdef USE_X_TOOLKIT - Arg al[2]; - int ac = 0; - Dimension widget_width, widget_height; - Window window = XtWindow (f->output_data.x->widget); -#else /* not USE_X_TOOLKIT */ - Window window = FRAME_X_WINDOW (f); -#endif /* not USE_X_TOOLKIT */ - - /* Setting PMaxSize caused various problems. */ - size_hints.flags = PResizeInc | PMinSize /* | PMaxSize */; - - size_hints.x = f->left_pos; - size_hints.y = f->top_pos; - -#ifdef USE_X_TOOLKIT - XtSetArg (al[ac], XtNwidth, &widget_width); ac++; - XtSetArg (al[ac], XtNheight, &widget_height); ac++; - XtGetValues (f->output_data.x->widget, al, ac); - size_hints.height = widget_height; - size_hints.width = widget_width; -#else /* not USE_X_TOOLKIT */ - size_hints.height = FRAME_PIXEL_HEIGHT (f); - size_hints.width = FRAME_PIXEL_WIDTH (f); -#endif /* not USE_X_TOOLKIT */ - - size_hints.width_inc = FRAME_COLUMN_WIDTH (f); - size_hints.height_inc = FRAME_LINE_HEIGHT (f); - size_hints.max_width - = FRAME_X_DISPLAY_INFO (f)->width - FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, 0); - size_hints.max_height - = FRAME_X_DISPLAY_INFO (f)->height - FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, 0); - - /* Calculate the base and minimum sizes. - - (When we use the X toolkit, we don't do it here. - Instead we copy the values that the widgets are using, below.) */ -#ifndef USE_X_TOOLKIT - { - int base_width, base_height; - int min_rows = 0, min_cols = 0; - - base_width = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, 0); - base_height = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, 0); - - check_frame_size (f, &min_rows, &min_cols); - - /* The window manager uses the base width hints to calculate the - current number of rows and columns in the frame while - resizing; min_width and min_height aren't useful for this - purpose, since they might not give the dimensions for a - zero-row, zero-column frame. - - We use the base_width and base_height members if we have - them; otherwise, we set the min_width and min_height members - to the size for a zero x zero frame. */ - -#ifdef HAVE_X11R4 - size_hints.flags |= PBaseSize; - size_hints.base_width = base_width; - size_hints.base_height = base_height; - size_hints.min_width = base_width + min_cols * size_hints.width_inc; - size_hints.min_height = base_height + min_rows * size_hints.height_inc; -#else - size_hints.min_width = base_width; - size_hints.min_height = base_height; -#endif - } - - /* If we don't need the old flags, we don't need the old hint at all. */ + int base_width, base_height, width_inc, height_inc; + int min_rows = 0, min_cols = 0; + XSizeHints *size_hints; + + base_width = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, 0); + base_height = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, 0); + width_inc = FRAME_COLUMN_WIDTH (f); + height_inc = FRAME_LINE_HEIGHT (f); + + check_frame_size (f, &min_rows, &min_cols); + + size_hints = FRAME_SIZE_HINTS (f); + if (size_hints == NULL) + { + size_hints = FRAME_SIZE_HINTS (f) = xmalloc (sizeof (XSizeHints)); + bzero (size_hints, sizeof (XSizeHints)); + } + + size_hints->flags |= PResizeInc | PMinSize | PBaseSize ; + size_hints->width_inc = width_inc; + size_hints->height_inc = height_inc; + size_hints->min_width = base_width + min_cols * width_inc; + size_hints->min_height = base_height + min_rows * height_inc; + size_hints->base_width = base_width; + size_hints->base_height = base_height; + if (flags) - { - size_hints.flags |= flags; - goto no_read; - } -#endif /* not USE_X_TOOLKIT */ - - { - XSizeHints hints; /* Sometimes I hate X Windows... */ - long supplied_return; - int value; - -#ifdef HAVE_X11R4 - value = XGetWMNormalHints (FRAME_X_DISPLAY (f), window, &hints, - &supplied_return); -#else - value = XGetNormalHints (FRAME_X_DISPLAY (f), window, &hints); -#endif - -#ifdef USE_X_TOOLKIT - size_hints.base_height = hints.base_height; - size_hints.base_width = hints.base_width; - size_hints.min_height = hints.min_height; - size_hints.min_width = hints.min_width; -#endif - - if (flags) - size_hints.flags |= flags; - else - { - if (value == 0) - hints.flags = 0; - if (hints.flags & PSize) - size_hints.flags |= PSize; - if (hints.flags & PPosition) - size_hints.flags |= PPosition; - if (hints.flags & USPosition) - size_hints.flags |= USPosition; - if (hints.flags & USSize) - size_hints.flags |= USSize; - } - } - -#ifndef USE_X_TOOLKIT - no_read: -#endif - -#ifdef PWinGravity - size_hints.win_gravity = f->win_gravity; - size_hints.flags |= PWinGravity; - - if (user_position) - { - size_hints.flags &= ~ PPosition; - size_hints.flags |= USPosition; - } -#endif /* PWinGravity */ - -#ifdef HAVE_X11R4 - XSetWMNormalHints (FRAME_X_DISPLAY (f), window, &size_hints); -#else - XSetNormalHints (FRAME_X_DISPLAY (f), window, &size_hints); -#endif -#endif /* MAC_TODO */ + size_hints->flags = flags; + else if (user_position) + { + size_hints->flags &= ~ PPosition; + size_hints->flags |= USPosition; + } } #if 0 /* MAC_TODO: hide application instead of iconify? */ @@ -6120,7 +6054,7 @@ break; sc = GetTextEncodingBase (encoding); decode_mac_font_name (name, sizeof (name), sc); - + /* Point the instance iterator at the current font family. */ if (FMResetFontFamilyInstanceIterator (ff, &ffii) != noErr) break; @@ -6259,6 +6193,19 @@ } +void +mac_clear_font_name_table () +{ + int i; + + for (i = 0; i < font_name_count; i++) + xfree (font_name_table[i]); + xfree (font_name_table); + font_name_table = NULL; + font_name_table_size = font_name_count = 0; +} + + enum xlfd_scalable_field_index { XLFD_SCL_PIXEL_SIZE, @@ -6311,6 +6258,9 @@ char *longest_start, *cur_start, *nonspecial; int longest_len, cur_len, exact; + if (font_name_table == NULL) /* Initialize when first used. */ + init_font_name_table (); + for (i = 0; i < XLFD_SCL_LAST; i++) scl_val[i] = -1; @@ -6471,9 +6421,6 @@ Lisp_Object newlist = Qnil, tem, key; struct mac_display_info *dpyinfo = f ? FRAME_MAC_DISPLAY_INFO (f) : NULL; - if (font_name_table == NULL) /* Initialize when first used. */ - init_font_name_table (); - if (dpyinfo) { tem = XCDR (dpyinfo->name_list_element); @@ -6487,7 +6434,9 @@ } } + BLOCK_INPUT; newlist = mac_do_list_fonts (SDATA (pattern), maxnames); + UNBLOCK_INPUT; /* MAC_TODO: add code for matching outline fonts here */ @@ -6791,6 +6740,18 @@ } +void +mac_unload_font (dpyinfo, font) + struct mac_display_info *dpyinfo; + XFontStruct *font; +{ + xfree (font->fontname); + if (font->per_char) + xfree (font->per_char); + xfree (font); +} + + /* Load font named FONTNAME of the size SIZE for frame F, and return a pointer to the structure font_info while allocating it dynamically. If SIZE is 0, load any size of font. @@ -6841,7 +6802,9 @@ if (size > 0 && !NILP (font_names)) fontname = (char *) SDATA (XCAR (font_names)); + BLOCK_INPUT; font = (MacFontStruct *) XLoadQueryFont (FRAME_MAC_DISPLAY (f), fontname); + UNBLOCK_INPUT; if (!font) return NULL; @@ -7121,15 +7084,21 @@ static pascal OSErr do_ae_open_documents (AppleEvent *, AppleEvent *, long); static pascal OSErr do_ae_quit_application (AppleEvent *, AppleEvent *, long); +#if TARGET_API_MAC_CARBON /* Drag and Drop */ static OSErr init_mac_drag_n_drop (); static pascal OSErr mac_do_receive_drag (WindowPtr, void*, DragReference); +#endif #if USE_CARBON_EVENTS /* Preliminary Support for the OSX Services Menu */ static OSStatus mac_handle_service_event (EventHandlerCallRef,EventRef,void*); static void init_service_handler (); -#endif +/* Window Event Handler */ +static pascal OSStatus mac_handle_window_event (EventHandlerCallRef, + EventRef, void *); +#endif +void install_window_handler (WindowPtr); extern void init_emacs_passwd_dir (); extern int emacs_main (int, char **, char **); @@ -7336,12 +7305,11 @@ { struct frame *f = mac_window_to_frame (win); - if (win == tip_window) - /* The tooltip has been drawn already. Avoid the - SET_FRAME_GARBAGED below. */ - return; - - if (f) + BeginUpdate (win); + + /* The tooltip has been drawn already. Avoid the SET_FRAME_GARBAGED + below. */ + if (win != tip_window) { if (f->async_visible == 0) { @@ -7358,17 +7326,30 @@ } else { - BeginUpdate (win); + Rect r; + handling_window_update = 1; - XClearWindow (FRAME_MAC_DISPLAY (f), FRAME_MAC_WINDOW (f)); - - expose_frame (f, 0, 0, 0, 0); +#if TARGET_API_MAC_CARBON + { + RgnHandle region = NewRgn (); + + GetPortVisibleRegion (GetWindowPort (win), region); + UpdateControls (win, region); + GetRegionBounds (region, &r); + DisposeRgn (region); + } +#else + UpdateControls (win, win->visRgn); + r = (*win->visRgn)->rgnBBox; +#endif + expose_frame (f, r.left, r.top, r.right - r.left, r.bottom - r.top); handling_window_update = 0; - EndUpdate (win); } } + + EndUpdate (win); } static int @@ -7530,20 +7511,43 @@ static void do_grow_window (WindowPtr w, EventRecord *e) { - long grow_size; Rect limit_rect; - int rows, columns; + int rows, columns, width, height; struct frame *f = mac_window_to_frame (w); - - SetRect(&limit_rect, MIN_DOC_SIZE, MIN_DOC_SIZE, MAX_DOC_SIZE, MAX_DOC_SIZE); - + XSizeHints *size_hints = FRAME_SIZE_HINTS (f); + int min_width = MIN_DOC_SIZE, min_height = MIN_DOC_SIZE; +#if TARGET_API_MAC_CARBON + Rect new_rect; +#else + long grow_size; +#endif + + if (size_hints->flags & PMinSize) + { + min_width = size_hints->min_width; + min_height = size_hints->min_height; + } + SetRect (&limit_rect, min_width, min_height, MAX_DOC_SIZE, MAX_DOC_SIZE); + +#if TARGET_API_MAC_CARBON + if (!ResizeWindow (w, e->where, &limit_rect, &new_rect)) + return; + height = new_rect.bottom - new_rect.top; + width = new_rect.right - new_rect.left; +#else grow_size = GrowWindow (w, e->where, &limit_rect); - /* see if it really changed size */ - if (grow_size != 0) - { - rows = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, HiWord (grow_size)); - columns = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, LoWord (grow_size)); + if (grow_size == 0) + return; + height = HiWord (grow_size); + width = LoWord (grow_size); +#endif + + if (width != FRAME_PIXEL_WIDTH (f) + || height != FRAME_PIXEL_HEIGHT (f)) + { + rows = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, height); + columns = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, width); x_set_window_size (f, 0, columns, rows); } @@ -7561,7 +7565,7 @@ GrafPtr save_port; Rect zoom_rect, port_rect; Point top_left; - int w_title_height, columns, rows; + int w_title_height, columns, rows, width, height; struct frame *f = mac_window_to_frame (w); #if TARGET_API_MAC_CARBON @@ -7636,12 +7640,26 @@ #else port_rect = w->portRect; #endif - rows = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, port_rect.bottom - port_rect.top); - columns = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, port_rect.right - port_rect.left); - x_set_window_size (f, 0, columns, rows); + height = port_rect.bottom - port_rect.top; + width = port_rect.right - port_rect.left; + + if (width != FRAME_PIXEL_WIDTH (f) + || height != FRAME_PIXEL_HEIGHT (f)) + { + rows = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, height); + columns = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, width); + + change_frame_size (f, rows, columns, 0, 1, 0); + SET_FRAME_GARBAGED (f); + cancel_mouse_face (f); + + FRAME_PIXEL_WIDTH (f) = width; + FRAME_PIXEL_HEIGHT (f) = height; + } x_real_positions (f, &f->left_pos, &f->top_pos); } +#if TARGET_API_MAC_CARBON /* Initialize Drag And Drop to allow files to be dropped onto emacs frames */ static OSErr init_mac_drag_n_drop () @@ -7649,6 +7667,7 @@ OSErr result = InstallReceiveHandler (mac_do_receive_drag, 0L, NULL); return result; } +#endif /* Intialize AppleEvent dispatcher table for the required events. */ void @@ -7819,7 +7838,93 @@ } return err; } -#endif + + +static pascal OSStatus +mac_handle_window_event (next_handler, event, data) + EventHandlerCallRef next_handler; + EventRef event; + void *data; +{ + extern Lisp_Object Qcontrol; + + WindowPtr wp; + OSStatus result; + UInt32 attributes; + XSizeHints *size_hints; + + GetEventParameter (event, kEventParamDirectObject, typeWindowRef, + NULL, sizeof (WindowPtr), NULL, &wp); + + switch (GetEventKind (event)) + { + case kEventWindowBoundsChanging: + result = CallNextEventHandler (next_handler, event); + if (result != eventNotHandledErr) + return result; + + GetEventParameter (event, kEventParamAttributes, typeUInt32, + NULL, sizeof (UInt32), NULL, &attributes); + size_hints = FRAME_SIZE_HINTS (mac_window_to_frame (wp)); + if ((attributes & kWindowBoundsChangeUserResize) + && ((size_hints->flags & (PResizeInc | PBaseSize | PMinSize)) + == (PResizeInc | PBaseSize | PMinSize))) + { + Rect bounds; + int width, height; + + GetEventParameter (event, kEventParamCurrentBounds, + typeQDRectangle, + NULL, sizeof (Rect), NULL, &bounds); + width = bounds.right - bounds.left; + height = bounds.bottom - bounds.top; + + if (width < size_hints->min_width) + width = size_hints->min_width; + else + width = size_hints->base_width + + (int) ((width - size_hints->base_width) + / (float) size_hints->width_inc + .5) + * size_hints->width_inc; + + if (height < size_hints->min_height) + height = size_hints->min_height; + else + height = size_hints->base_height + + (int) ((height - size_hints->base_height) + / (float) size_hints->height_inc + .5) + * size_hints->height_inc; + + bounds.right = bounds.left + width; + bounds.bottom = bounds.top + height; + SetEventParameter (event, kEventParamCurrentBounds, + typeQDRectangle, sizeof (Rect), &bounds); + return noErr; + } + break; + } + + return eventNotHandledErr; +} +#endif /* USE_CARBON_EVENTS */ + + +void +install_window_handler (window) + WindowPtr window; +{ +#if USE_CARBON_EVENTS + EventTypeSpec specs[] = {{kEventClassWindow, kEventWindowBoundsChanging}}; + static EventHandlerUPP handle_window_event_UPP = NULL; + + if (handle_window_event_UPP == NULL) + handle_window_event_UPP = NewEventHandlerUPP (mac_handle_window_event); + + InstallWindowEventHandler (window, handle_window_event_UPP, + GetEventTypeCount (specs), specs, NULL, NULL); +#endif +} + /* Open Application Apple Event */ static pascal OSErr @@ -7915,6 +8020,7 @@ } +#if TARGET_API_MAC_CARBON static pascal OSErr mac_do_receive_drag (WindowPtr window, void *handlerRefCon, DragReference theDrag) @@ -7991,6 +8097,7 @@ } } } +#endif /* Print Document Apple Event */ @@ -8140,6 +8247,45 @@ return *xKeySym != 0; } +#if !USE_CARBON_EVENTS +static RgnHandle mouse_region = NULL; + +Boolean +mac_wait_next_event (er, sleep_time, dequeue) + EventRecord *er; + UInt32 sleep_time; + Boolean dequeue; +{ + static EventRecord er_buf = {nullEvent}; + UInt32 target_tick, current_tick; + EventMask event_mask; + + if (mouse_region == NULL) + mouse_region = NewRgn (); + + event_mask = everyEvent; + if (NILP (Fboundp (Qmac_ready_for_drag_n_drop))) + event_mask -= highLevelEventMask; + + current_tick = TickCount (); + target_tick = current_tick + sleep_time; + + if (er_buf.what == nullEvent) + while (!WaitNextEvent (event_mask, &er_buf, + target_tick - current_tick, mouse_region)) + { + current_tick = TickCount (); + if (target_tick <= current_tick) + return false; + } + + *er = er_buf; + if (dequeue) + er_buf.what = nullEvent; + return true; +} +#endif /* not USE_CARBON_EVENTS */ + /* Emacs calls this whenever it wants to read an input event from the user. */ int @@ -8151,9 +8297,7 @@ int count = 0; #if USE_CARBON_EVENTS EventRef eventRef; - EventTargetRef toolbox_dispatcher = GetEventDispatcherTarget (); -#else - EventMask event_mask; + EventTargetRef toolbox_dispatcher; #endif EventRecord er; struct mac_display_info *dpyinfo = &one_mac_display_info; @@ -8184,16 +8328,14 @@ if (terminate_flag) Fkill_emacs (make_number (1)); -#if !USE_CARBON_EVENTS - event_mask = everyEvent; - if (NILP (Fboundp (Qmac_ready_for_drag_n_drop))) - event_mask -= highLevelEventMask; - - while (WaitNextEvent (event_mask, &er, 0L, NULL)) -#else /* USE_CARBON_EVENTS */ +#if USE_CARBON_EVENTS + toolbox_dispatcher = GetEventDispatcherTarget (); + while (!ReceiveNextEvent (0, NULL, kEventDurationNoWait, kEventRemoveFromQueue, &eventRef)) -#endif /* USE_CARBON_EVENTS */ +#else /* !USE_CARBON_EVENTS */ + while (mac_wait_next_event (&er, 0, true)) +#endif /* !USE_CARBON_EVENTS */ { int do_help = 0; struct frame *f; @@ -8260,6 +8402,7 @@ SendEventToEventTarget (eventRef, toolbox_dispatcher); break; + default: /* Send the event to the appropriate receiver. */ SendEventToEventTarget (eventRef, toolbox_dispatcher); @@ -8497,6 +8640,10 @@ break; case mouseMovedMessage: +#if !USE_CARBON_EVENTS + SetRectRgn (mouse_region, er.where.h, er.where.v, + er.where.h + 1, er.where.v + 1); +#endif previous_help_echo_string = help_echo_string; help_echo_string = help_echo_object = help_echo_window = Qnil; help_echo_pos = -1; @@ -8697,21 +8844,21 @@ unsigned char ch = inev.code; ByteCount actual_input_length, actual_output_length; unsigned char outbuf[32]; - - convert_status = TECConvertText (converter, &ch, 1, - &actual_input_length, + + convert_status = TECConvertText (converter, &ch, 1, + &actual_input_length, outbuf, 1, - &actual_output_length); - if (convert_status == noErr - && actual_input_length == 1 - && actual_output_length == 1) + &actual_output_length); + if (convert_status == noErr + && actual_input_length == 1 + && actual_output_length == 1) inev.code = *outbuf; - + /* Reset internal states of the converter object. - If it fails, create another one. */ + If it fails, create another one. */ convert_status = TECFlushText (converter, outbuf, sizeof (outbuf), - &actual_output_length); + &actual_output_length); if (convert_status != noErr) { TECDisposeConverter (converter); @@ -8719,7 +8866,7 @@ kTextEncodingMacRoman, mac_keyboard_text_encoding); } - } + } } #if USE_CARBON_EVENTS @@ -8864,59 +9011,12 @@ } #endif - -/* Initialize the struct pointed to by MW to represent a new COLS x - ROWS Macintosh window, using font with name FONTNAME and size - FONTSIZE. */ -void -make_mac_frame (FRAME_PTR fp) -{ - mac_output *mwp; -#if TARGET_API_MAC_CARBON - static int making_terminal_window = 0; -#else - static int making_terminal_window = 1; -#endif - - mwp = fp->output_data.mac; - - BLOCK_INPUT; - if (making_terminal_window) - { - if (!(mwp->mWP = GetNewCWindow (TERM_WINDOW_RESOURCE, NULL, - (WindowPtr) -1))) - abort (); - making_terminal_window = 0; - } - else - { -#if TARGET_API_MAC_CARBON - Rect r; - - SetRect (&r, 0, 0, 1, 1); - if (CreateNewWindow (kDocumentWindowClass, - kWindowStandardDocumentAttributes - /* | kWindowToolbarButtonAttribute */, - &r, &mwp->mWP) != noErr) -#else - if (!(mwp->mWP = GetNewCWindow (WINDOW_RESOURCE, NULL, (WindowPtr) -1))) -#endif - abort (); - } - - SetWRefCon (mwp->mWP, (long) mwp); - /* so that update events can find this mac_output struct */ - mwp->mFP = fp; /* point back to emacs frame */ - - SizeWindow (mwp->mWP, FRAME_PIXEL_WIDTH (fp), FRAME_PIXEL_HEIGHT (fp), false); - UNBLOCK_INPUT; -} - - +#ifdef MAC_OS8 void make_mac_terminal_frame (struct frame *f) { Lisp_Object frame; + Rect r; XSETFRAME (frame, f); @@ -8940,10 +9040,17 @@ f->output_data.mac->mouse_pixel = 0xff00ff; f->output_data.mac->cursor_foreground_pixel = 0x0000ff; + f->output_data.mac->text_cursor = GetCursor (iBeamCursor); + f->output_data.mac->nontext_cursor = &arrow_cursor; + f->output_data.mac->modeline_cursor = &arrow_cursor; + f->output_data.mac->hand_cursor = &arrow_cursor; + f->output_data.mac->hourglass_cursor = GetCursor (watchCursor); + f->output_data.mac->horizontal_drag_cursor = &arrow_cursor; + FRAME_FONTSET (f) = -1; f->output_data.mac->explicit_parent = 0; - f->left_pos = 4; - f->top_pos = 4; + f->left_pos = 8; + f->top_pos = 32; f->border_width = 0; f->internal_border_width = 0; @@ -8954,7 +9061,20 @@ f->new_text_cols = 0; f->new_text_lines = 0; - make_mac_frame (f); + SetRect (&r, f->left_pos, f->top_pos, + f->left_pos + FRAME_PIXEL_WIDTH (f), + f->top_pos + FRAME_PIXEL_HEIGHT (f)); + + BLOCK_INPUT; + + if (!(FRAME_MAC_WINDOW (f) = + NewCWindow (NULL, &r, "\p", true, dBoxProc, + (WindowPtr) -1, 1, (long) f->output_data.mac))) + abort (); + /* so that update events can find this mac_output struct */ + f->output_data.mac->mFP = f; /* point back to emacs frame */ + + UNBLOCK_INPUT; x_make_gc (f); @@ -8970,9 +9090,8 @@ Fmodify_frame_parameters (frame, Fcons (Fcons (Qbackground_color, build_string ("white")), Qnil)); - - ShowWindow (f->output_data.mac->mWP); -} +} +#endif /*********************************************************************** @@ -8989,12 +9108,7 @@ bzero (dpyinfo, sizeof (*dpyinfo)); - /* Put it on x_display_name_list. */ - x_display_name_list = Fcons (Fcons (build_string ("Mac"), Qnil), - x_display_name_list); - dpyinfo->name_list_element = XCAR (x_display_name_list); - -#if 0 +#ifdef MAC_OSX dpyinfo->mac_id_name = (char *) xmalloc (SCHARS (Vinvocation_name) + SCHARS (Vsystem_name) @@ -9049,6 +9163,61 @@ dpyinfo->mouse_face_hidden = 0; } +/* Create an xrdb-style database of resources to supercede registry settings. + The database is just a concatenation of C strings, finished by an additional + \0. The string are submitted to some basic normalization, so + + [ *]option[ *]:[ *]value... + + becomes + + option:value... + + but any whitespace following value is not removed. */ + +static char * +mac_make_rdb (xrm_option) + char *xrm_option; +{ + char *buffer = xmalloc (strlen (xrm_option) + 2); + char *current = buffer; + char ch; + int in_option = 1; + int before_value = 0; + + do { + ch = *xrm_option++; + + if (ch == '\n') + { + *current++ = '\0'; + in_option = 1; + before_value = 0; + } + else if (ch != ' ') + { + *current++ = ch; + if (in_option && (ch == ':')) + { + in_option = 0; + before_value = 1; + } + else if (before_value) + { + before_value = 0; + } + } + else if (!(in_option || before_value)) + { + *current++ = ch; + } + } while (ch); + + *current = '\0'; + + return buffer; +} + struct mac_display_info * mac_term_init (display_name, xrm_option, resource_name) Lisp_Object display_name; @@ -9056,7 +9225,8 @@ char *resource_name; { struct mac_display_info *dpyinfo; - GDHandle main_device_handle; + + BLOCK_INPUT; if (!mac_initialized) { @@ -9064,17 +9234,90 @@ mac_initialized = 1; } - mac_initialize_display_info (display_name); + if (x_display_list) + error ("Sorry, this version can only handle one display"); + + mac_initialize_display_info (); dpyinfo = &one_mac_display_info; - main_device_handle = LMGetMainDevice(); - - dpyinfo->height = (**main_device_handle).gdRect.bottom; - dpyinfo->width = (**main_device_handle).gdRect.right; + dpyinfo->xrdb = xrm_option ? mac_make_rdb (xrm_option) : NULL; + + /* Put this display on the chain. */ + dpyinfo->next = x_display_list; + x_display_list = dpyinfo; + + /* Put it on x_display_name_list. */ + x_display_name_list = Fcons (Fcons (display_name, Qnil), + x_display_name_list); + dpyinfo->name_list_element = XCAR (x_display_name_list); + + UNBLOCK_INPUT; return dpyinfo; } +/* Get rid of display DPYINFO, assuming all frames are already gone. */ + +void +x_delete_display (dpyinfo) + struct mac_display_info *dpyinfo; +{ + int i; + + /* Discard this display from x_display_name_list and x_display_list. + We can't use Fdelq because that can quit. */ + if (! NILP (x_display_name_list) + && EQ (XCAR (x_display_name_list), dpyinfo->name_list_element)) + x_display_name_list = XCDR (x_display_name_list); + else + { + Lisp_Object tail; + + tail = x_display_name_list; + while (CONSP (tail) && CONSP (XCDR (tail))) + { + if (EQ (XCAR (XCDR (tail)), dpyinfo->name_list_element)) + { + XSETCDR (tail, XCDR (XCDR (tail))); + break; + } + tail = XCDR (tail); + } + } + + if (x_display_list == dpyinfo) + x_display_list = dpyinfo->next; + else + { + struct x_display_info *tail; + + for (tail = x_display_list; tail; tail = tail->next) + if (tail->next == dpyinfo) + tail->next = tail->next->next; + } + + /* Free the font names in the font table. */ + for (i = 0; i < dpyinfo->n_fonts; i++) + if (dpyinfo->font_table[i].name) + { + if (dpyinfo->font_table[i].name != dpyinfo->font_table[i].full_name) + xfree (dpyinfo->font_table[i].full_name); + xfree (dpyinfo->font_table[i].name); + } + + if (dpyinfo->font_table->font_encoder) + xfree (dpyinfo->font_table->font_encoder); + + xfree (dpyinfo->font_table); + xfree (dpyinfo->mac_id_name); + + if (x_display_list == 0) + { + mac_clear_font_name_table (); + bzero (dpyinfo, sizeof (*dpyinfo)); + } +} + #ifdef MAC_OSX void @@ -9334,7 +9577,6 @@ #endif BLOCK_INPUT; - mac_initialize_display_info (); #if TARGET_API_MAC_CARBON init_required_apple_events (); @@ -9372,7 +9614,9 @@ Qsuper = intern ("super"); Fput (Qsuper, Qmodifier_value, make_number (super_modifier)); +#ifdef MAC_OSX Fprovide (intern ("mac-carbon"), Qnil); +#endif staticpro (&Qreverse); Qreverse = intern ("reverse");
--- a/src/macterm.h Thu Dec 23 16:43:51 2004 +0000 +++ b/src/macterm.h Thu Jan 06 15:00:09 2005 +0000 @@ -218,6 +218,9 @@ struct image_cache *image_cache; }; +/* This checks to make sure we have a display. */ +extern void check_mac P_ ((void)); + #define x_display_info mac_display_info /* This is a chain of structures for all the X displays currently in use. */ @@ -388,6 +391,9 @@ /* The background for which the above relief GCs were set up. They are changed only when a different background is involved. */ unsigned long relief_background; + + /* Hints for the size and the position of a window. */ + XSizeHints *size_hints; }; typedef struct mac_output mac_output; @@ -404,6 +410,8 @@ #define FRAME_BASELINE_OFFSET(f) ((f)->output_data.mac->baseline_offset) +#define FRAME_SIZE_HINTS(f) ((f)->output_data.mac->size_hints) + /* This gives the w32_display_info structure for the display F is on. */ #define FRAME_MAC_DISPLAY_INFO(f) (&one_mac_display_info) #define FRAME_X_DISPLAY_INFO(f) (&one_mac_display_info) @@ -593,6 +601,7 @@ extern void XSetForeground P_ ((Display *, GC, unsigned long)); extern void mac_draw_line_to_pixmap P_ ((Display *, Pixmap, GC, int, int, int, int)); +extern void mac_unload_font P_ ((struct mac_display_info *, XFontStruct *)); #define FONT_TYPE_FOR_UNIBYTE(font, ch) 0 #define FONT_TYPE_FOR_MULTIBYTE(font, ch) 0
--- a/src/process.c Thu Dec 23 16:43:51 2004 +0000 +++ b/src/process.c Thu Jan 06 15:00:09 2005 +0000 @@ -1290,7 +1290,7 @@ XSETFASTINT (minspace, 1); set_buffer_internal (XBUFFER (Vstandard_output)); - Fbuffer_disable_undo (Vstandard_output); + current_buffer->undo_list = Qt; current_buffer->truncate_lines = Qt;
--- a/src/xdisp.c Thu Dec 23 16:43:51 2004 +0000 +++ b/src/xdisp.c Thu Jan 06 15:00:09 2005 +0000 @@ -810,7 +810,7 @@ static void setup_for_ellipsis P_ ((struct it *, int)); static void mark_window_display_accurate_1 P_ ((struct window *, int)); -static int single_display_prop_string_p P_ ((Lisp_Object, Lisp_Object)); +static int single_display_spec_string_p P_ ((Lisp_Object, Lisp_Object)); static int display_prop_string_p P_ ((Lisp_Object, Lisp_Object)); static int cursor_row_p P_ ((struct window *, struct glyph_row *)); static int redisplay_mode_lines P_ ((Lisp_Object, int)); @@ -832,7 +832,7 @@ static void x_consider_frame_title P_ ((Lisp_Object)); static void handle_stop P_ ((struct it *)); static int tool_bar_lines_needed P_ ((struct frame *)); -static int single_display_prop_intangible_p P_ ((Lisp_Object)); +static int single_display_spec_intangible_p P_ ((Lisp_Object)); static void ensure_echo_area_buffers P_ ((void)); static Lisp_Object unwind_with_echo_area_buffer P_ ((Lisp_Object)); static Lisp_Object with_echo_area_buffer_unwind_data P_ ((struct window *)); @@ -926,7 +926,7 @@ Lisp_Object)); static int face_before_or_after_it_pos P_ ((struct it *, int)); static int next_overlay_change P_ ((int)); -static int handle_single_display_prop P_ ((struct it *, Lisp_Object, +static int handle_single_display_spec P_ ((struct it *, Lisp_Object, Lisp_Object, struct text_pos *, int)); static int underlying_face_id P_ ((struct it *)); @@ -3275,7 +3275,10 @@ ***********************************************************************/ /* Set up iterator IT from `display' property at its current position. - Called from handle_stop. */ + Called from handle_stop. + We return HANDLED_RETURN if some part of the display property + overrides the display of the buffer text itself. + Otherwise we return HANDLED_NORMALLY. */ static enum prop_handled handle_display_prop (it) @@ -3283,6 +3286,7 @@ { Lisp_Object prop, object; struct text_pos *position; + /* Nonzero if some property replaces the display of the text itself. */ int display_replaced_p = 0; if (STRINGP (it->string)) @@ -3330,7 +3334,7 @@ { for (; CONSP (prop); prop = XCDR (prop)) { - if (handle_single_display_prop (it, XCAR (prop), object, + if (handle_single_display_spec (it, XCAR (prop), object, position, display_replaced_p)) display_replaced_p = 1; } @@ -3339,13 +3343,13 @@ { int i; for (i = 0; i < ASIZE (prop); ++i) - if (handle_single_display_prop (it, AREF (prop, i), object, + if (handle_single_display_spec (it, AREF (prop, i), object, position, display_replaced_p)) display_replaced_p = 1; } else { - if (handle_single_display_prop (it, prop, object, position, 0)) + if (handle_single_display_spec (it, prop, object, position, 0)) display_replaced_p = 1; } @@ -3377,42 +3381,44 @@ } -/* Set up IT from a single `display' sub-property value PROP. OBJECT +/* Set up IT from a single `display' specification PROP. OBJECT is the object in which the `display' property was found. *POSITION is the position at which it was found. DISPLAY_REPLACED_P non-zero - means that we previously saw a display sub-property which already + means that we previously saw a display specification which already replaced text display with something else, for example an image; - ignore such properties after the first one has been processed. - - If PROP is a `space' or `image' sub-property, set *POSITION to the - end position of the `display' property. + we ignore such properties after the first one has been processed. + + If PROP is a `space' or `image' specification, and in some other + cases too, set *POSITION to the position where the `display' + property ends. Value is non-zero if something was found which replaces the display of buffer or string text. */ static int -handle_single_display_prop (it, prop, object, position, +handle_single_display_spec (it, spec, object, position, display_replaced_before_p) struct it *it; - Lisp_Object prop; + Lisp_Object spec; Lisp_Object object; struct text_pos *position; int display_replaced_before_p; { - Lisp_Object value; - int replaces_text_display_p = 0; Lisp_Object form; - - /* If PROP is a list of the form `(when FORM . VALUE)', FORM is - evaluated. If the result is nil, VALUE is ignored. */ + Lisp_Object location, value; + struct text_pos start_pos; + int valid_p; + + /* If SPEC is a list of the form `(when FORM . VALUE)', evaluate FORM. + If the result is non-nil, use VALUE instead of SPEC. */ form = Qt; - if (CONSP (prop) && EQ (XCAR (prop), Qwhen)) - { - prop = XCDR (prop); - if (!CONSP (prop)) + if (CONSP (spec) && EQ (XCAR (spec), Qwhen)) + { + spec = XCDR (spec); + if (!CONSP (spec)) return 0; - form = XCAR (prop); - prop = XCDR (prop); + form = XCAR (spec); + spec = XCDR (spec); } if (!NILP (form) && !EQ (form, Qt)) @@ -3438,15 +3444,15 @@ if (NILP (form)) return 0; - if (CONSP (prop) - && EQ (XCAR (prop), Qheight) - && CONSP (XCDR (prop))) - { - if (FRAME_TERMCAP_P (it->f) || FRAME_MSDOS_P (it->f)) + /* Handle `(height HEIGHT)' specifications. */ + if (CONSP (spec) + && EQ (XCAR (spec), Qheight) + && CONSP (XCDR (spec))) + { + if (!FRAME_WINDOW_P (it->f)) return 0; - - /* `(height HEIGHT)'. */ - it->font_height = XCAR (XCDR (prop)); + + it->font_height = XCAR (XCDR (spec)); if (!NILP (it->font_height)) { struct face *face = FACE_FROM_ID (it->f, it->face_id); @@ -3487,7 +3493,6 @@ { /* Evaluate IT->font_height with `height' bound to the current specified height to get the new height. */ - Lisp_Object value; int count = SPECPDL_INDEX (); specbind (Qheight, face->lface[LFACE_HEIGHT_INDEX]); @@ -3501,29 +3506,35 @@ if (new_height > 0) it->face_id = face_with_height (it->f, it->face_id, new_height); } - } - else if (CONSP (prop) - && EQ (XCAR (prop), Qspace_width) - && CONSP (XCDR (prop))) - { - /* `(space_width WIDTH)'. */ - if (FRAME_TERMCAP_P (it->f) || FRAME_MSDOS_P (it->f)) + + return 0; + } + + /* Handle `(space_width WIDTH)'. */ + if (CONSP (spec) + && EQ (XCAR (spec), Qspace_width) + && CONSP (XCDR (spec))) + { + if (!FRAME_WINDOW_P (it->f)) return 0; - value = XCAR (XCDR (prop)); + value = XCAR (XCDR (spec)); if (NUMBERP (value) && XFLOATINT (value) > 0) it->space_width = value; - } - else if (CONSP (prop) - && EQ (XCAR (prop), Qslice)) - { - /* `(slice X Y WIDTH HEIGHT)'. */ + + return 0; + } + + /* Handle `(slice X Y WIDTH HEIGHT)'. */ + if (CONSP (spec) + && EQ (XCAR (spec), Qslice)) + { Lisp_Object tem; - if (FRAME_TERMCAP_P (it->f) || FRAME_MSDOS_P (it->f)) + if (!FRAME_WINDOW_P (it->f)) return 0; - if (tem = XCDR (prop), CONSP (tem)) + if (tem = XCDR (spec), CONSP (tem)) { it->slice.x = XCAR (tem); if (tem = XCDR (tem), CONSP (tem)) @@ -3537,17 +3548,20 @@ } } } - } - else if (CONSP (prop) - && EQ (XCAR (prop), Qraise) - && CONSP (XCDR (prop))) - { - /* `(raise FACTOR)'. */ + + return 0; + } + + /* Handle `(raise FACTOR)'. */ + if (CONSP (spec) + && EQ (XCAR (spec), Qraise) + && CONSP (XCDR (spec))) + { if (!FRAME_WINDOW_P (it->f)) return 0; #ifdef HAVE_WINDOW_SYSTEM - value = XCAR (XCDR (prop)); + value = XCAR (XCDR (spec)); if (NUMBERP (value)) { struct face *face = FACE_FROM_ID (it->f, it->face_id); @@ -3555,188 +3569,194 @@ * (FONT_HEIGHT (face->font))); } #endif /* HAVE_WINDOW_SYSTEM */ - } - else if (!it->string_from_display_prop_p) - { - /* `((margin left-margin) VALUE)' or `((margin right-margin) - VALUE) or `((margin nil) VALUE)' or VALUE. */ - Lisp_Object location, value; - struct text_pos start_pos; - int valid_p; - - /* Characters having this form of property are not displayed, so - we have to find the end of the property. */ - start_pos = *position; - *position = display_prop_end (it, object, start_pos); - value = Qnil; - - /* Let's stop at the new position and assume that all - text properties change there. */ - it->stop_charpos = position->charpos; - - if (CONSP (prop) - && (EQ (XCAR (prop), Qleft_fringe) - || EQ (XCAR (prop), Qright_fringe)) - && CONSP (XCDR (prop))) - { - int face_id = DEFAULT_FACE_ID; - int fringe_bitmap; - - /* Save current settings of IT so that we can restore them - when we are finished with the glyph property value. */ - - /* `(left-fringe BITMAP FACE)'. */ - if (!FRAME_WINDOW_P (it->f)) - return 0; + + return 0; + } + + /* Don't handle the other kinds of display specifications + inside a string that we got from a `display' property. */ + if (it->string_from_display_prop_p) + return 0; + + /* Characters having this form of property are not displayed, so + we have to find the end of the property. */ + start_pos = *position; + *position = display_prop_end (it, object, start_pos); + value = Qnil; + + /* Stop the scan at that end position--we assume that all + text properties change there. */ + it->stop_charpos = position->charpos; + + /* Handle `(left-fringe BITMAP [FACE])' + and `(right-fringe BITMAP [FACE])'. */ + if (CONSP (spec) + && (EQ (XCAR (spec), Qleft_fringe) + || EQ (XCAR (spec), Qright_fringe)) + && CONSP (XCDR (spec))) + { + int face_id = DEFAULT_FACE_ID; + int fringe_bitmap; + + if (!FRAME_WINDOW_P (it->f)) + /* If we return here, POSITION has been advanced + across the text with this property. */ + return 0; #ifdef HAVE_WINDOW_SYSTEM - value = XCAR (XCDR (prop)); - if (!SYMBOLP (value) - || !(fringe_bitmap = lookup_fringe_bitmap (value))) - return 0; - - if (CONSP (XCDR (XCDR (prop)))) - { - Lisp_Object face_name = XCAR (XCDR (XCDR (prop))); - int face_id2 = lookup_named_face (it->f, face_name, 'A', 0); - if (face_id2 >= 0) - face_id = face_id2; - } - - push_it (it); - - it->area = TEXT_AREA; + value = XCAR (XCDR (spec)); + if (!SYMBOLP (value) + || !(fringe_bitmap = lookup_fringe_bitmap (value))) + /* If we return here, POSITION has been advanced + across the text with this property. */ + return 0; + + if (CONSP (XCDR (XCDR (spec)))) + { + Lisp_Object face_name = XCAR (XCDR (XCDR (spec))); + int face_id2 = lookup_named_face (it->f, face_name, 'A', 0); + if (face_id2 >= 0) + face_id = face_id2; + } + + /* Save current settings of IT so that we can restore them + when we are finished with the glyph property value. */ + + push_it (it); + + it->area = TEXT_AREA; + it->what = IT_IMAGE; + it->image_id = -1; /* no image */ + it->position = start_pos; + it->object = NILP (object) ? it->w->buffer : object; + it->method = next_element_from_image; + it->face_id = face_id; + + /* Say that we haven't consumed the characters with + `display' property yet. The call to pop_it in + set_iterator_to_next will clean this up. */ + *position = start_pos; + + if (EQ (XCAR (spec), Qleft_fringe)) + { + it->left_user_fringe_bitmap = fringe_bitmap; + it->left_user_fringe_face_id = face_id; + } + else + { + it->right_user_fringe_bitmap = fringe_bitmap; + it->right_user_fringe_face_id = face_id; + } +#endif /* HAVE_WINDOW_SYSTEM */ + return 1; + } + + /* Prepare to handle `((margin left-margin) ...)', + `((margin right-margin) ...)' and `((margin nil) ...)' + prefixes for display specifications. */ + location = Qunbound; + if (CONSP (spec) && CONSP (XCAR (spec))) + { + Lisp_Object tem; + + value = XCDR (spec); + if (CONSP (value)) + value = XCAR (value); + + tem = XCAR (spec); + if (EQ (XCAR (tem), Qmargin) + && (tem = XCDR (tem), + tem = CONSP (tem) ? XCAR (tem) : Qnil, + (NILP (tem) + || EQ (tem, Qleft_margin) + || EQ (tem, Qright_margin)))) + location = tem; + } + + if (EQ (location, Qunbound)) + { + location = Qnil; + value = spec; + } + + /* After this point, VALUE is the property after any + margin prefix has been stripped. It must be a string, + an image specification, or `(space ...)'. + + LOCATION specifies where to display: `left-margin', + `right-margin' or nil. */ + + valid_p = (STRINGP (value) +#ifdef HAVE_WINDOW_SYSTEM + || (FRAME_WINDOW_P (it->f) && valid_image_p (value)) +#endif /* not HAVE_WINDOW_SYSTEM */ + || (CONSP (value) && EQ (XCAR (value), Qspace))); + + if (valid_p && !display_replaced_before_p) + { + /* Save current settings of IT so that we can restore them + when we are finished with the glyph property value. */ + push_it (it); + if (NILP (location)) + it->area = TEXT_AREA; + else if (EQ (location, Qleft_margin)) + it->area = LEFT_MARGIN_AREA; + else + it->area = RIGHT_MARGIN_AREA; + + if (STRINGP (value)) + { + it->string = value; + it->multibyte_p = STRING_MULTIBYTE (it->string); + it->current.overlay_string_index = -1; + IT_STRING_CHARPOS (*it) = IT_STRING_BYTEPOS (*it) = 0; + it->end_charpos = it->string_nchars = SCHARS (it->string); + it->method = next_element_from_string; + it->stop_charpos = 0; + it->string_from_display_prop_p = 1; + /* Say that we haven't consumed the characters with + `display' property yet. The call to pop_it in + set_iterator_to_next will clean this up. */ + *position = start_pos; + } + else if (CONSP (value) && EQ (XCAR (value), Qspace)) + { + it->method = next_element_from_stretch; + it->object = value; + it->current.pos = it->position = start_pos; + + } +#ifdef HAVE_WINDOW_SYSTEM + else + { it->what = IT_IMAGE; - it->image_id = -1; /* no image */ + it->image_id = lookup_image (it->f, value); it->position = start_pos; it->object = NILP (object) ? it->w->buffer : object; it->method = next_element_from_image; - it->face_id = face_id; /* Say that we haven't consumed the characters with `display' property yet. The call to pop_it in set_iterator_to_next will clean this up. */ *position = start_pos; - - if (EQ (XCAR (prop), Qleft_fringe)) - { - it->left_user_fringe_bitmap = fringe_bitmap; - it->left_user_fringe_face_id = face_id; - } - else - { - it->right_user_fringe_bitmap = fringe_bitmap; - it->right_user_fringe_face_id = face_id; - } + } #endif /* HAVE_WINDOW_SYSTEM */ - return 1; - } - - location = Qunbound; - if (CONSP (prop) && CONSP (XCAR (prop))) - { - Lisp_Object tem; - - value = XCDR (prop); - if (CONSP (value)) - value = XCAR (value); - - tem = XCAR (prop); - if (EQ (XCAR (tem), Qmargin) - && (tem = XCDR (tem), - tem = CONSP (tem) ? XCAR (tem) : Qnil, - (NILP (tem) - || EQ (tem, Qleft_margin) - || EQ (tem, Qright_margin)))) - location = tem; - } - - if (EQ (location, Qunbound)) - { - location = Qnil; - value = prop; - } - - valid_p = (STRINGP (value) -#ifdef HAVE_WINDOW_SYSTEM - || (FRAME_WINDOW_P (it->f) && valid_image_p (value)) -#endif /* not HAVE_WINDOW_SYSTEM */ - || (CONSP (value) && EQ (XCAR (value), Qspace))); - - if ((EQ (location, Qleft_margin) - || EQ (location, Qright_margin) - || NILP (location)) - && valid_p - && !display_replaced_before_p) - { - replaces_text_display_p = 1; - - /* Save current settings of IT so that we can restore them - when we are finished with the glyph property value. */ - push_it (it); - - if (NILP (location)) - it->area = TEXT_AREA; - else if (EQ (location, Qleft_margin)) - it->area = LEFT_MARGIN_AREA; - else - it->area = RIGHT_MARGIN_AREA; - - if (STRINGP (value)) - { - it->string = value; - it->multibyte_p = STRING_MULTIBYTE (it->string); - it->current.overlay_string_index = -1; - IT_STRING_CHARPOS (*it) = IT_STRING_BYTEPOS (*it) = 0; - it->end_charpos = it->string_nchars = SCHARS (it->string); - it->method = next_element_from_string; - it->stop_charpos = 0; - it->string_from_display_prop_p = 1; - /* Say that we haven't consumed the characters with - `display' property yet. The call to pop_it in - set_iterator_to_next will clean this up. */ - *position = start_pos; - } - else if (CONSP (value) && EQ (XCAR (value), Qspace)) - { - it->method = next_element_from_stretch; - it->object = value; - it->current.pos = it->position = start_pos; - } -#ifdef HAVE_WINDOW_SYSTEM - else - { - if (FRAME_WINDOW_P (it->f)) - { - it->what = IT_IMAGE; - it->image_id = lookup_image (it->f, value); - it->position = start_pos; - it->object = NILP (object) ? it->w->buffer : object; - it->method = next_element_from_image; - } - - /* Say that we haven't consumed the characters with - `display' property yet. The call to pop_it in - set_iterator_to_next will clean this up. */ - *position = start_pos; - } -#endif /* HAVE_WINDOW_SYSTEM */ - } - else - /* Invalid property or property not supported. Restore - the position to what it was before. */ - *position = start_pos; - } - - return replaces_text_display_p; -} - - -/* Check if PROP is a display sub-property value whose text should be + + return 1; + } + + /* Invalid property or property not supported. Restore + POSITION to what it was before. */ + *position = start_pos; + return 0; +} + + +/* Check if SPEC is a display sub-property value whose text should be treated as intangible. */ static int -single_display_prop_intangible_p (prop) +single_display_spec_intangible_p (prop) Lisp_Object prop; { /* Skip over `when FORM'. */ @@ -3789,7 +3809,7 @@ /* A list of sub-properties. */ while (CONSP (prop)) { - if (single_display_prop_intangible_p (XCAR (prop))) + if (single_display_spec_intangible_p (XCAR (prop))) return 1; prop = XCDR (prop); } @@ -3799,11 +3819,11 @@ /* A vector of sub-properties. */ int i; for (i = 0; i < ASIZE (prop); ++i) - if (single_display_prop_intangible_p (AREF (prop, i))) + if (single_display_spec_intangible_p (AREF (prop, i))) return 1; } else - return single_display_prop_intangible_p (prop); + return single_display_spec_intangible_p (prop); return 0; } @@ -3812,7 +3832,7 @@ /* Return 1 if PROP is a display sub-property value containing STRING. */ static int -single_display_prop_string_p (prop, string) +single_display_spec_string_p (prop, string) Lisp_Object prop, string; { if (EQ (string, prop)) @@ -3857,7 +3877,7 @@ /* A list of sub-properties. */ while (CONSP (prop)) { - if (single_display_prop_string_p (XCAR (prop), string)) + if (single_display_spec_string_p (XCAR (prop), string)) return 1; prop = XCDR (prop); } @@ -3867,11 +3887,11 @@ /* A vector of sub-properties. */ int i; for (i = 0; i < ASIZE (prop); ++i) - if (single_display_prop_string_p (AREF (prop, i), string)) + if (single_display_spec_string_p (AREF (prop, i), string)) return 1; } else - return single_display_prop_string_p (prop, string); + return single_display_spec_string_p (prop, string); return 0; } @@ -6624,7 +6644,7 @@ } return 0; } - + /* Display an echo area message M with a specified length of NBYTES bytes. The string may include null characters. If M is 0, clear @@ -21890,20 +21910,6 @@ } } -#ifdef HAVE_CARBON - /* Display scroll bar for this window. */ - if (!NILP (w->vertical_scroll_bar)) - { - /* ++KFS: - If this doesn't work here (maybe some header files are missing), - make a function in macterm.c and call it to do the job! */ - ControlHandle ch - = SCROLL_BAR_CONTROL_HANDLE (XSCROLL_BAR (w->vertical_scroll_bar)); - - Draw1Control (ch); - } -#endif - return mouse_face_overwritten_p; } @@ -21962,16 +21968,6 @@ return; } -#ifdef HAVE_CARBON - /* MAC_TODO: this is a kludge, but if scroll bars are not activated - or deactivated here, for unknown reasons, activated scroll bars - are shown in deactivated frames in some instances. */ - if (f == FRAME_MAC_DISPLAY_INFO (f)->x_focus_frame) - activate_scroll_bars (f); - else - deactivate_scroll_bars (f); -#endif - /* If basic faces haven't been realized yet, there is no point in trying to redraw anything. This can happen when we get an expose event while Emacs is starting, e.g. by moving another window. */
--- a/src/xfaces.c Thu Dec 23 16:43:51 2004 +0000 +++ b/src/xfaces.c Thu Jan 06 15:00:09 2005 +0000 @@ -1075,6 +1075,9 @@ #ifdef WINDOWSNT w32_unload_font (dpyinfo, font_info->font); #endif +#ifdef MAC_OS + mac_unload_font (dpyinfo, font_info->font); +#endif UNBLOCK_INPUT; /* Mark font table slot free. */
--- a/src/xfns.c Thu Dec 23 16:43:51 2004 +0000 +++ b/src/xfns.c Thu Jan 06 15:00:09 2005 +0000 @@ -5278,6 +5278,16 @@ XEvent event; x_menu_wait_for_event (0); XtAppNextEvent (Xt_app_con, &event); + if (event.type == KeyPress + && FRAME_X_DISPLAY (f) == event.xkey.display) + { + KeySym keysym = XLookupKeysym (&event.xkey, 0); + + /* Pop down on C-g. */ + if (keysym == XK_g && (event.xkey.state & ControlMask) != 0) + XtUnmanageChild (dialog); + } + (void) x_dispatch_event (&event, FRAME_X_DISPLAY (f)); }
--- a/src/xmenu.c Thu Dec 23 16:43:51 2004 +0000 +++ b/src/xmenu.c Thu Jan 06 15:00:09 2005 +0000 @@ -116,7 +116,7 @@ static Lisp_Object xdialog_show P_ ((FRAME_PTR, int, Lisp_Object, char **)); static void popup_get_selection P_ ((XEvent *, struct x_display_info *, - LWLIB_ID, int, int)); + LWLIB_ID, int)); /* Define HAVE_BOXES if menus can handle radio and toggle buttons. */ @@ -1186,24 +1186,21 @@ popped down (deactivated). This is used for x-popup-menu and x-popup-dialog; it is not used for the menu bar. - If DOWN_ON_KEYPRESS is nonzero, pop down if a key is pressed. - NOTE: All calls to popup_get_selection should be protected with BLOCK_INPUT, UNBLOCK_INPUT wrappers. */ static void -popup_get_selection (initial_event, dpyinfo, id, do_timers, down_on_keypress) +popup_get_selection (initial_event, dpyinfo, id, do_timers) XEvent *initial_event; struct x_display_info *dpyinfo; LWLIB_ID id; int do_timers; - int down_on_keypress; { XEvent event; while (popup_activated_flag) { - if (initial_event) + if (initial_event) { event = *initial_event; initial_event = 0; @@ -1232,20 +1229,15 @@ event.xbutton.state = 0; #endif } - /* If the user presses a key that doesn't go to the menu, - deactivate the menu. - The user is likely to do that if we get wedged. - All toolkits now pop down menus on ESC. - For dialogs however, the focus may not be on the dialog, so - in that case, we pop down. */ + /* Pop down on C-g and Escape. */ else if (event.type == KeyPress - && down_on_keypress && dpyinfo->display == event.xbutton.display) { KeySym keysym = XLookupKeysym (&event.xkey, 0); - if (!IsModifierKey (keysym) - && x_any_window_to_frame (dpyinfo, event.xany.window) != NULL) - popup_activated_flag = 0; + + if ((keysym == XK_g && (event.xkey.state & ControlMask) != 0) + || keysym == XK_Escape) /* Any escape, ignore modifiers. */ + popup_activated_flag = 0; } x_dispatch_event (&event, event.xany.display); @@ -2226,6 +2218,9 @@ } else { + char menuOverride[] = "Ctrl<KeyPress>g: MenuGadgetEscape()"; + XtTranslations override = XtParseTranslationTable (menuOverride); + menubar_widget = lw_create_widget ("menubar", "menubar", id, first_wv, f->output_data.x->column_widget, 0, @@ -2234,6 +2229,9 @@ popup_deactivate_callback, menu_highlight_callback); f->output_data.x->menubar_widget = menubar_widget; + + /* Make menu pop down on C-g. */ + XtOverrideTranslations (menubar_widget, override); } { @@ -2597,7 +2595,7 @@ make_number (menu_id & ~(-1 << (fact))))); /* Process events that apply to the menu. */ - popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), menu_id, 1, 0); + popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), menu_id, 1); unbind_to (specpdl_count, Qnil); } @@ -2975,7 +2973,7 @@ make_number (dialog_id & ~(-1 << (fact))))); popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), - dialog_id, 1, 1); + dialog_id, 1); unbind_to (count, Qnil); } @@ -3155,6 +3153,9 @@ } } } + else + /* Make "Cancel" equivalent to C-g. */ + Fsignal (Qquit, Qnil); return Qnil; } @@ -3500,7 +3501,13 @@ case XM_FAILURE: *error = "Can't activate menu"; case XM_IA_SELECT: + entry = Qnil; + break; case XM_NO_SELECT: + /* Make "Cancel" equivalent to C-g unless this menu was popped up by + a mouse press. */ + if (! for_click) + Fsignal (Qquit, Qnil); entry = Qnil; break; }