mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-23 07:19:15 +00:00
Code Issues Releases Activity

Merged in changes from CVS trunk.

Browse Source 
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
This commit is contained in:
Karoly Lorentey 2005-01-06 15:00:09 +00:00
commit 0feecea9fb
93 changed files with 3578 additions and 1855 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
etc/NEWS
View File

@ -98,6 +98,11 @@ types any more. Add -DUSE_LISP_UNION_TYPE if you want union types.
* 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
@ -980,6 +985,9 @@ be navigated with the arrow keys (like Gtk+, Mac and W32).
** Dialogs for Lucid/Athena and Lesstif/Motif now pops down when pressing
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
@ -2143,6 +2151,11 @@ anyone has committed to the repository since you last executed
"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 @@ configuration files.
* 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.
@ -3099,6 +3121,10 @@ be inserted is translated through it.
which means FUNNAME was previously defined as an autoload (before the
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

2
etc/TODO
View File

@ -15,6 +15,8 @@ to the FSF.
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.

5
lib-src/ChangeLog
View File

@ -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

2
lib-src/make-docfile.c
View File

@ -43,11 +43,11 @@ Boston, MA 02111-1307, USA. */
#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 */

179
lisp/ChangeLog
View File

@ -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>

46
lisp/ansi-color.el
View File

@ -220,23 +220,6 @@ This is a good function to put in `comint-output-filter-functions'."
;; 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 @@ A possible way to install this would be:
\(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

20
lisp/battery.el
View File

@ -73,12 +73,13 @@ string are substituted as defined by the current value of the variable
(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 @@ seconds."
(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))

2
lisp/bookmark.el
View File

@ -1049,6 +1049,8 @@ of the old one in the permanent bookmark record."
(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

6
lisp/buff-menu.el
View File

@ -198,11 +198,15 @@ Letters do not insert themselves; instead, they are commands.
(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)

16
lisp/calc/calc-store.el
View File

@ -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")

2
lisp/emacs-lisp/debug.el
View File

@ -352,7 +352,7 @@ That buffer should be current already."
(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

5
lisp/emacs-lisp/find-func.el
View File

@ -242,7 +242,7 @@ in `load-path'."
(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 @@ The library where VARIABLE is defined is searched for in FILE or
`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

2
lisp/eshell/esh-cmd.el
View File

@ -1285,7 +1285,7 @@ COMMAND may result in an alias being executed, or a plain command."
(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

2
lisp/eshell/esh-test.el
View File

@ -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))

6
lisp/faces.el
View File

@ -1813,7 +1813,7 @@ created."
(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 @@ created."
(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"))

2
lisp/ffap.el
View File

@ -962,7 +962,7 @@ If t, `ffap-tex-init' will initialize this when needed.")
;; * 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:

162
lisp/files.el
View File

@ -1200,7 +1200,8 @@ name to this list as a string."
"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 @@ This requires the external program `diff' to be in your `exec-path'."
"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 @@ See `save-some-buffers-action-alist' if you want to
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 @@ change the additional actions you can take on files."
(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 @@ program specified by `directory-free-space-program' if that is non-nil."
(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 @@ normally equivalent short `-D' option is just passed on to
(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 @@ normally equivalent short `-D' option is just passed on to
(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 @@ normally equivalent short `-D' option is just passed on to
(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.

29
lisp/gnus/ChangeLog
View File

@ -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.

2
lisp/gnus/gnus-agent.el
View File

@ -891,7 +891,7 @@ next enabled. Depends upon the caller to determine whether group deletion is sup
(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)

2
lisp/gnus/gnus-cache.el
View File

@ -754,7 +754,7 @@ next enabled. Depends upon the caller to determine whether group renaming is sup
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

22
lisp/gnus/gnus-spec.el
View File

@ -275,21 +275,15 @@ Return a list of updated types."
(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."

17
lisp/gnus/gnus-util.el
View File

@ -708,6 +708,23 @@ Bind `print-quoted' and `print-readably' to t, and `print-length' and
(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)

85
lisp/gnus/mm-util.el
View File

@ -576,6 +576,83 @@ This affects whether coding conversion should be attempted generally."
(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 @@ charset, and a longer list means no appropriate charset."
(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

15
lisp/gnus/rfc2231.el
View File

@ -88,7 +88,6 @@ The list will be on the form
(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 @@ The list will be on the form
(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)))))))

4
lisp/help-fns.el
View File

@ -355,7 +355,7 @@ face (according to `face-differs-from-default-p')."
(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 @@ it is displayed along with the global value."
;; 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

23
lisp/hexl.el
View File

@ -111,11 +111,19 @@ Quoting cannot be used, so the arguments cannot themselves contain spaces."
(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 @@ You can use \\[hexl-find-file] to visit a file in Hexl mode.
(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 @@ With arg, don't unhexlify buffer."
(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 @@ This discards the buffer's undo information."
(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))))

33
lisp/international/mule.el
View File

@ -1878,13 +1878,27 @@ or a function symbol which, when called, returns such a cons cell."
(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 @@ of the function `insert-file-contents'."
(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.

44
lisp/international/utf-8.el
View File

@ -305,26 +305,30 @@ use either \\[customize] or the function
;; 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

3
lisp/loadup.el
View File

@ -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")

2
lisp/mail/rmail.el
View File

@ -3435,6 +3435,8 @@ typically for purposes of moderating a list."
(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

2
lisp/mail/smtpmail.el
View File

@ -523,7 +523,7 @@ This is relative to `smtpmail-queue-dir'.")
(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))

3
lisp/mouse.el
View File

@ -754,7 +754,8 @@ remains active. Otherwise, it remains until the next input event.
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

2
lisp/net/goto-addr.el
View File

@ -100,7 +100,7 @@ A value of t means there is no limit--fontify regardless of the size."
(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

4
lisp/progmodes/compile.el
View File

@ -1463,8 +1463,8 @@ Use this command in a compilation log buffer. Sets the mark at point there."
;; 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)

13
lisp/progmodes/cperl-mode.el
View File

@ -6026,7 +6026,8 @@ Currently it is tuned to C and Perl syntax."
(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 @@ Delay of auto-help controlled by `cperl-lazy-help-time'."
;;; 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)

269
lisp/progmodes/hideshow.el
View File

@ -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 @@ This has effect iff `search-invisible' is set to `open'."
'((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 @@ a block), `hs-hide-all', `hs-hide-block' and `hs-hide-level'.")
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 @@ Note that `mode-line-format' is buffer-local.")
;;---------------------------------------------------------------------------
;; 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 @@ Note that `mode-line-format' is buffer-local.")
"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 @@ OV is shown.
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 @@ Original match data is restored upon return."
(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 @@ and then further adjusted to be at the end of the line."
(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 @@ as cdr."
(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 @@ as cdr."
(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 @@ Return point, or nil if original point was not in a block."
(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 @@ Return point, or nil if original point was not in a block."
(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 @@ and `case-fold-search' are both t."
(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 @@ If `hs-hide-comments-when-hiding-all' is non-nil, also hide the comments."
(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 @@ If `hs-hide-comments-when-hiding-all' is non-nil, also hide the comments."
(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 @@ If `hs-hide-comments-when-hiding-all' is non-nil, also hide the comments."
(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 @@ See documentation for functions `hs-hide-block' and `run-hooks'."
(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 @@ See documentation for functions `hs-hide-block' and `run-hooks'."
(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 @@ Key bindings:
(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 @@ Key bindings:
)))))
;; 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

134
lisp/simple.el
View File

@ -124,70 +124,87 @@ to navigate in it.")
(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-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)
(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 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 @@ makes the search case-sensitive."
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 @@ Return 0 if current buffer is not a mini-buffer."
(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 @@ as an argument limits undo to changes within the current region."
;; 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 @@ as an argument limits undo to changes within the current region."
(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 @@ is not *inside* the region START...END."
;; 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))

32
lisp/subr.el
View File

@ -823,7 +823,7 @@ is converted into a string by expressing it in decimal."
(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 @@ is converted into a string by expressing it in decimal."
(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 @@ other hooks, such as major mode hooks, can do the job."
;;; 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)))

1518
lisp/term/mac-win.el
View File

File diff suppressed because it is too large Load Diff

1
lisp/textmodes/texinfmt.el
View File

@ -378,6 +378,7 @@ if large. You can use Info-split to do this manually."
(find-file outfile)
(texinfo-mode)
(erase-buffer)
(buffer-disable-undo)
(message "Formatting Info file: %s" outfile)
(setq texinfo-format-filename

33
lisp/type-break.el
View File

@ -399,10 +399,6 @@ problems."
(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 @@ problems."
(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 @@ variable of the same name."
(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

1
lisp/uniquify.el
View File

@ -188,7 +188,6 @@ If `uniquify-min-dir-content' > 0, always pulls that many
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)))

2
lisp/wid-edit.el
View File

@ -3059,7 +3059,7 @@ It will read a directory name from the minibuffer when invoked."
(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)

15
lispref/ChangeLog
View File

@ -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.

2
lispref/Makefile.in
View File

@ -31,7 +31,7 @@ infodir = $(srcdir)/../info
TEXI2DVI = texi2dvi
SHELL = /bin/sh
INSTALL_INFO = install-info
MAKEINFO = makeinfo
MAKEINFO = makeinfo --force
# The name of the manual:
VERSION=2.9

7
lispref/buffers.texi
View File

@ -1041,6 +1041,13 @@ save that buffer, just as they offer to save file-visiting buffers.
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.

54
lispref/display.texi
View File

@ -1533,23 +1533,26 @@ or by adding additional vertical space below one or all lines.
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 @@ the line to achieve the total height @var{line-height}. Otherwise,
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 @@ property that controls the height of the display line ending with that
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}.
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.
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.
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 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
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

8
lispref/elisp.texi
View File

@ -420,9 +420,15 @@ Macros
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.
* Named Features:: Loading a library if it isn't already loaded.
* 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.
Byte Compilation

109
lispref/loading.texi
View File

@ -36,15 +36,16 @@ Similarly, a ``Lisp library directory'' is a directory of files
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 @@ with a call to @code{provide}. The order of the elements in the
@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 @@ ignored and you can unload any library.
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.

4
lispref/modes.texi
View File

@ -1736,7 +1736,7 @@ It is normally @code{nil}, so that ordinary buffers have no header line.
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 argument @var{window} defaults to the selected window.
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

12
lwlib/ChangeLog
View File

@ -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)

2
lwlib/Makefile.in
View File

@ -57,7 +57,7 @@ lwlib-Xm.o: lwlib-Xm.c lwlib-Xm.h lwlib.h lwlib-int.h lwlib-utils.h
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

2
lwlib/lwlib-Xaw.c
View File

@ -279,7 +279,7 @@ static char overrideTrans[] =
"<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}

1
lwlib/xlwmenu.c
View File

@ -211,6 +211,7 @@ xlwMenuActionsList [] =
{"right", Right},
{"select", Select},
{"key", Key},
{"MenuGadgetEscape", Key}, /* Compatibility with Lesstif/Motif. */
{"nothing", Nothing},
};

21
mac/ChangeLog
View File

@ -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

9
mac/inc/config.h
View File

@ -261,7 +261,7 @@ Boston, MA 02111-1307, USA. */
/* #undef CRAY_STACKSEG_END */
/* #undef UNEXEC_SRC unexelf.c
/* #undef UNEXEC_SRC */
/* #undef HAVE_LIBXBSD */
/* #undef HAVE_XRMSETDATABASE */
@ -366,6 +366,13 @@ Boston, MA 02111-1307, USA. */
/* Define to make ftello visible on some hosts (e.g. glibc 2.1.3). */
/* #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 */

5
mac/inc/epaths.h
View File

@ -46,7 +46,7 @@ Boston, MA 02111-1307, USA. */
/* 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 @@ Boston, MA 02111-1307, USA. */
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" */

5
mac/inc/m-mac.h
View File

@ -87,8 +87,11 @@ Boston, MA 02111-1307, USA. */
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

14
mac/inc/s-mac.h
View File

@ -255,6 +255,10 @@ void read_input_waiting ();
#include <unistd.h>
#endif
#ifndef X_OK
#define X_OK 01
#endif
#undef unlink
#define unlink sys_unlink
#undef read
@ -319,5 +323,15 @@ extern double atof (const char *);
#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) */

45
mac/makefile.MPW
View File

@ -44,7 +44,7 @@ OptOption = # -opt speed # alternatively set to -opt off or -opt size
# 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 @@ BLOCKINPUT_H_GROUP = "{Src}blockinput.h" "{Src}atimer.h" "{Src}systime.h"
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 @@ EmacsObjects =
"{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 @@ EmacsObjects =
"{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 @@ Emacs
"{SharedLibraries}AppleScriptLib" ¶
"{SharedLibraries}TextEncodingConverter" ¶
"{SharedLibraries}AppearanceLib" ¶
"{SharedLibraries}QuickTimeLib" ¶
"{PPCLibraries}StdCRuntime.o" ¶
"{PPCLibraries}PPCCRuntime.o" ¶
"{PPCLibraries}PPCToolLibs.o" ¶
@ -495,10 +498,33 @@ Emacs
"{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 @@ Emacs
"{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 @@ DistClean
EmacsSource = ¶
"{Src}abbrev.c" ¶
"{Src}alloc.c" ¶
"{Src}alloca.c" ¶
"{Src}atimer.c" ¶
"{Src}buffer.c" ¶
"{Src}bytecode.c" ¶
@ -964,12 +992,15 @@ EmacsSource =
"{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 @@ LispSource =
{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 @@ LispSource =
{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 @@ LispSource =
{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 ¶

19
man/ChangeLog
View File

@ -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.

3
man/Makefile.in
View File

@ -31,7 +31,8 @@ VPATH=@srcdir@
# 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 \

34
man/basic.texi
View File

@ -171,7 +171,7 @@ them). Others do more sophisticated things.
@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 @@ them). Others do more sophisticated things.
@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 @@ mark ring (@pxref{Mark Ring}).
@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

51
man/calc.texi
View File

@ -11712,21 +11712,23 @@ calculator, and a variable in a programming language. (In fact, a Calc
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 @@ mode is the same as @samp{a_i} in Normal mode. Assignments
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 @@ the corresponding generalized time zone (like @code{PGT}).
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 @@ to variables use the @kbd{s} prefix key.
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 @@ you change the value of one of these variables, or of one of the other
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 @@ value of one variable to another. It differs from a simple @kbd{s r}
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 @@ by hand. (@xref{General Mode Commands}, for a way to tell Calc to
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 @@ explicitly naming them in an @kbd{s p} command.)
@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}

2
man/frames.texi
View File

@ -913,7 +913,7 @@ of dialogs. This option has no effect if you have suppressed all dialog
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.

14
oldXMenu/Activate.c
View File

@ -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 @@ XMenuActivate(display, menu, p_num, s_num, x_pos, y_pos, event_mask, data,
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 @@ XMenuActivate(display, menu, p_num, s_num, x_pos, y_pos, event_mask, data,
}
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.

5
oldXMenu/ChangeLog
View File

@ -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.

200
src/ChangeLog
View File

@ -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.

37
src/alloc.c
View File

@ -602,6 +602,27 @@ static char xmalloc_overrun_check_trailer[XMALLOC_OVERRUN_CHECK_SIZE] =
((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 @@ overrun_check_malloc (size)
size_t size;
{
register unsigned char *val;
size_t overhead = ++check_depth == 1 ? XMALLOC_OVERRUN_CHECK_SIZE*2 : 0;
val = (unsigned char *) malloc (size + XMALLOC_OVERRUN_CHECK_SIZE*2);
if (val)
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 @@ overrun_check_realloc (block, size)
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 @@ overrun_check_realloc (block, size)
bzero (val, XMALLOC_OVERRUN_CHECK_SIZE);
}
val = (unsigned char *) realloc ((POINTER_TYPE *)val, size + XMALLOC_OVERRUN_CHECK_SIZE*2);
val = (unsigned char *) realloc ((POINTER_TYPE *)val, size + overhead);
if (val)
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 @@ overrun_check_free (block)
{
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 @@ overrun_check_free (block)
}
free (val);
--check_depth;
}
#undef malloc

31
src/buffer.c
View File

@ -1251,29 +1251,6 @@ If BUFFER is omitted or nil, some interesting buffer is returned. */)
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 @@ A value of nil means to use the scroll bar width from the window's frame. */);
DEFVAR_PER_BUFFER ("vertical-scroll-bar", &current_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",
&current_buffer->indicate_empty_lines, Qnil,
@ -5951,7 +5929,6 @@ to the default frame line height. */);
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);

4
src/coding.c
View File

@ -5877,7 +5877,6 @@ code_convert_region (from, from_byte, to, to_byte, coding, encodep, replace)
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 @@ code_convert_region (from, from_byte, to, to_byte, coding, encodep, replace)
}
else
{
ratio = (coding->produced - coding->consumed) / coding->consumed;
float ratio = coding->produced - coding->consumed;
ratio /= coding->consumed;
require = len_byte * ratio;
}
first = 0;

2
src/data.c
View File

@ -723,7 +723,7 @@ determined by DEFINITION. */)
&& 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;

4
src/dispextern.h
View File

@ -62,7 +62,7 @@ typedef XImage *XImagePtr;
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 @@ struct glyph_string
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)

4
src/emacs.c
View File

@ -1307,7 +1307,7 @@ main (argc, argv
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 @@ main (argc, argv
syms_of_search ();
syms_of_frame ();
mac_initialize ();
mac_term_init (build_string ("Mac"), NULL, NULL);
init_keyboard ();
#endif

15
src/eval.c
View File

@ -88,7 +88,7 @@ struct catchtag *catchlist;
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 @@ usage: (defun NAME ARGLIST [DOCSTRING] BODY...) */)
&& 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 @@ usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...) */)
&& 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 @@ The return value is ALIASED. */)
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 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
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 @@ usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */)
tem = Fpurecopy (tem);
Fput (sym, Qvariable_documentation, tem);
}
LOADHIST_ATTACH (Fcons (Qdefvar, sym));
LOADHIST_ATTACH (sym);
return sym;
}
@ -3376,9 +3376,6 @@ before making `inhibit-quit' nil. */);
Qdefun = intern ("defun");
staticpro (&Qdefun);
Qdefvar = intern ("defvar");
staticpro (&Qdefvar);
Qand_rest = intern ("&rest");
staticpro (&Qand_rest);

4
src/fileio.c
View File

@ -6190,7 +6190,7 @@ The return value is only relevant for a call to `read-file-name' that happens
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 @@ and `read-file-name-function'. */)
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. */

4
src/fns.c
View File

@ -26,8 +26,8 @@ Boston, MA 02111-1307, USA. */
#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. */

12
src/frame.c
View File

@ -3052,8 +3052,6 @@ x_set_frame_parameters (f, alist)
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 @@ x_set_frame_parameters (f, alist)
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 @@ x_report_frame_params (f, alistptr)
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 @@ x_set_fullscreen (f, new_value, old_value)
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 @@ x_set_fullscreen (f, new_value, old_value)
f->want_fullscreen = FULLSCREEN_WIDTH;
else if (EQ (new_value, Qfullheight))
f->want_fullscreen = FULLSCREEN_HEIGHT;
#endif
}
@ -3378,7 +3370,7 @@ x_set_border_width (f, arg, oldval)
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 @@ Setting this variable does not affect existing frames, only new ones. */);
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

42
src/gtkutil.c
View File

@ -3356,12 +3356,37 @@ update_frame_tool_bar (f)
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 @@ update_frame_tool_bar (f)
{
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 @@ update_frame_tool_bar (f)
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 @@ free_frame_tool_bar (f)
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 @@ xg_initialize ()
"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 */

11
src/image.c
View File

@ -83,16 +83,19 @@ typedef struct w32_bitmap_record Bitmap_Record;
#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 @@ jpeg_image_p (object)
#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>

10
src/keyboard.c
View File

@ -6910,14 +6910,16 @@ input_available_signal (signo)
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

8
src/lisp.h
View File

@ -1671,8 +1671,16 @@ extern void defvar_kboard P_ ((char *, int));
#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 *)(&current_kboard->vname) \

6
src/lread.c
View File

@ -3847,10 +3847,10 @@ when the corresponding call to `provide' is made. */);
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;

344
src/mac.c
View File

@ -845,6 +845,8 @@ check_alarm ()
}
extern Boolean mac_wait_next_event (EventRecord *, UInt32, Boolean);
int
select (n, rfds, wfds, efds, timeout)
int n;
@ -853,49 +855,24 @@ select (n, rfds, wfds, efds, timeout)
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 @@ run_mac_command (argv, workdir, infn, outfn, errfn)
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 @@ run_mac_command (argv, workdir, infn, outfn, errfn)
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 @@ and t is the same as `SECONDARY'. */)
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 @@ sys_select (n, rfds, wfds, efds, timeout)
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);
}
FD_CLR (0, rfds);
do
{
EMACS_TIME select_timeout;
SELECT_TYPE orfds = *rfds;
int r;
/* 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;
EMACS_SET_SECS_USECS (select_timeout, 0, 20000);
*rfds = orfds;
if (timeout && EMACS_TIME_LT (remaining_time, select_timeout))
select_timeout = remaining_time;
#ifdef SELECT_USE_CFSOCKET
if (timeout_sec > 0 && timeout_sec <= SELECT_TIMEOUT_THRESHOLD_RUNLOOP)
goto poll_periodically;
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)
{
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))
{
FD_SET (0, rfds);
r++;
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++;
}
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);
}
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 */
}
while (!timeout || EMACS_TIME_LT (now, end_time));
return 0;
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;
*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 @@ syms_of_mac ()
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);

157
src/macfns.c
View File

@ -158,9 +158,7 @@ Lisp_Object Qshift;
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 @@ stricmp (const char *s, const char *t)
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 @@ void
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 @@ struct mac_display_info *
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 @@ mac_color_map_lookup (colorname)
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 @@ x_set_scroll_bar_default_width (f)
/* 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 @@ XParseGeometry (string, x, y, width, height)
}
#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 @@ mac_window (f, window_prompting, minibuffer_only)
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 @@ This function is an internal primitive--use `make-frame' instead. */)
"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 @@ This function is an internal primitive--use `make-frame' instead. */)
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 @@ This function is an internal primitive--use `make-frame' instead. */)
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 @@ x_display_info_for_name (name)
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 @@ x_display_info_for_name (name)
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 @@ terminate Emacs if we can't open the connection. */)
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 @@ If DISPLAY is nil, that stands for the selected frame's display. */)
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 @@ If DISPLAY is nil, that stands for the selected frame's display. */)
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 @@ x_create_tip_frame (dpyinfo, parms, text)
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 @@ Text larger than the specified size is clipped. */)
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 @@ Value is t if tooltip was open, nil otherwise. */)
#ifdef TARGET_API_MAC_CARBON
#if TARGET_API_MAC_CARBON
/***********************************************************************
File selection dialog
***********************************************************************/
@ -4405,14 +4435,19 @@ frame_parm_handler mac_frame_parm_handlers[] =
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 @@ Chinese, Japanese, and Korean. */);
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);

28
src/macgui.h
View File

@ -62,18 +62,17 @@ typedef unsigned long Time;
#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 @@ XCreateGC (void *, Window, unsigned long, XGCValues *);
#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 */

756
src/macterm.c
View File

File diff suppressed because it is too large Load Diff

9
src/macterm.h
View File

@ -218,6 +218,9 @@ struct mac_display_info
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 @@ struct mac_output {
/* 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 @@ typedef struct mac_output mac_output;
#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 XFreePixmap P_ ((Display *, Pixmap));
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

2
src/process.c
View File

@ -1290,7 +1290,7 @@ list_processes_1 (query_only)
XSETFASTINT (minspace, 1);
set_buffer_internal (XBUFFER (Vstandard_output));
Fbuffer_disable_undo (Vstandard_output);
current_buffer->undo_list = Qt;
current_buffer->truncate_lines = Qt;

464
src/xdisp.c
View File

@ -810,7 +810,7 @@ static struct glyph_slice null_glyph_slice = { 0, 0, 0, 0 };
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 int store_frame_title P_ ((const unsigned char *, int, int));
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 @@ static void compute_string_pos P_ ((struct text_pos *, struct text_pos,
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 @@ setup_for_ellipsis (it, len)
***********************************************************************/
/* 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 @@ handle_display_prop (it)
{
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 @@ handle_display_prop (it)
{
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 @@ handle_display_prop (it)
{
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 @@ display_prop_end (it, object, start_pos)
}
/* 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.
we 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.
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;
Lisp_Object location, value;
struct text_pos start_pos;
int valid_p;
/* If PROP is a list of the form `(when FORM . VALUE)', FORM is
evaluated. If the result is nil, VALUE is ignored. */
/* 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))
if (CONSP (spec) && EQ (XCAR (spec), Qwhen))
{
prop = XCDR (prop);
if (!CONSP (prop))
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 @@ handle_single_display_prop (it, prop, object, position,
if (NILP (form))
return 0;
if (CONSP (prop)
&& EQ (XCAR (prop), Qheight)
&& CONSP (XCDR (prop)))
/* Handle `(height HEIGHT)' specifications. */
if (CONSP (spec)
&& EQ (XCAR (spec), Qheight)
&& CONSP (XCDR (spec)))
{
if (FRAME_TERMCAP_P (it->f) || FRAME_MSDOS_P (it->f))
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 @@ handle_single_display_prop (it, prop, object, position,
{
/* 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 @@ handle_single_display_prop (it, prop, object, position,
if (new_height > 0)
it->face_id = face_with_height (it->f, it->face_id, new_height);
}
return 0;
}
else if (CONSP (prop)
&& EQ (XCAR (prop), Qspace_width)
&& CONSP (XCDR (prop)))
/* Handle `(space_width WIDTH)'. */
if (CONSP (spec)
&& EQ (XCAR (spec), Qspace_width)
&& CONSP (XCDR (spec)))
{
/* `(space_width WIDTH)'. */
if (FRAME_TERMCAP_P (it->f) || FRAME_MSDOS_P (it->f))
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;
return 0;
}
else if (CONSP (prop)
&& EQ (XCAR (prop), Qslice))
/* Handle `(slice X Y WIDTH HEIGHT)'. */
if (CONSP (spec)
&& EQ (XCAR (spec), Qslice))
{
/* `(slice X Y WIDTH HEIGHT)'. */
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 @@ handle_single_display_prop (it, prop, object, position,
}
}
}
return 0;
}
else if (CONSP (prop)
&& EQ (XCAR (prop), Qraise)
&& CONSP (XCDR (prop)))
/* Handle `(raise FACTOR)'. */
if (CONSP (spec)
&& EQ (XCAR (spec), Qraise)
&& CONSP (XCDR (spec)))
{
/* `(raise FACTOR)'. */
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 @@ handle_single_display_prop (it, prop, object, position,
* (FONT_HEIGHT (face->font)));
}
#endif /* HAVE_WINDOW_SYSTEM */
return 0;
}
else if (!it->string_from_display_prop_p)
/* 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)))
{
/* `((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;
int face_id = DEFAULT_FACE_ID;
int fringe_bitmap;
/* 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;
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;
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 (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;
}
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;
}
push_it (it);
/* Save current settings of IT so that we can restore them
when we are finished with the glyph property value. */
it->area = TEXT_AREA;
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 1;
}
return replaces_text_display_p;
/* Invalid property or property not supported. Restore
POSITION to what it was before. */
*position = start_pos;
return 0;
}
/* Check if PROP is a display sub-property value whose text should be
/* 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 @@ display_prop_intangible_p (prop)
/* 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 @@ display_prop_intangible_p (prop)
/* 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 @@ display_prop_intangible_p (prop)
/* 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 @@ display_prop_string_p (prop, string)
/* 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 @@ display_prop_string_p (prop, string)
/* 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 @@ message_log_check_duplicate (prev_bol, prev_bol_byte, this_bol, this_bol_byte)
}
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 @@ expose_window (w, fr)
}
}
#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 @@ expose_frame (f, x, y, w, h)
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. */

3
src/xfaces.c
View File

@ -1074,6 +1074,9 @@ clear_font_table (dpyinfo)
#endif
#ifdef WINDOWSNT
w32_unload_font (dpyinfo, font_info->font);
#endif
#ifdef MAC_OS
mac_unload_font (dpyinfo, font_info->font);
#endif
UNBLOCK_INPUT;

10
src/xfns.c
View File

@ -5278,6 +5278,16 @@ or directory must exist. ONLY-DIR-P is ignored." */)
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));
}

43
src/xmenu.c
View File

@ -116,7 +116,7 @@ extern XtAppContext Xt_app_con;
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 @@ x_menu_wait_for_event (void *data)
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 @@ popup_get_selection (initial_event, dpyinfo, id, do_timers, down_on_keypress)
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 @@ set_frame_menubar (f, first_time, deep_p)
}
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 @@ set_frame_menubar (f, first_time, deep_p)
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 @@ create_and_show_popup_menu (f, first_wv, x, y, for_click)
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 @@ create_and_show_dialog (f, first_wv)
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 @@ xdialog_show (f, keymaps, title, error)
}
}
}
else
/* Make "Cancel" equivalent to C-g. */
Fsignal (Qquit, Qnil);
return Qnil;
}
@ -3500,7 +3501,13 @@ xmenu_show (f, x, y, for_click, keymaps, title, error)
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;
}