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

merge trunk

Browse Source
This commit is contained in:
Kenichi Handa 2013-07-20 20:51:53 +09:00
commit 7e67809332
36 changed files with 566 additions and 321 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
doc/lispref/ChangeLog
View File

@ -1,3 +1,7 @@
2013-07-19 Xue Fuqiao <xfq.free@gmail.com>
* windows.texi (Display Action Functions): Mention next-window.
2013-07-16 Xue Fuqiao <xfq.free@gmail.com>
* windows.texi (Selecting Windows): Fix the introduction of

4
doc/lispref/windows.texi
View File

@ -1924,6 +1924,10 @@ frames to search for a reusable window:
A frame means consider windows on that frame only.
@end itemize
Note that these meanings differ slightly from those of the
@var{all-frames} argument to @code{next-window} (@pxref{Cyclic Window
Ordering}).
If @var{alist} contains no @code{reusable-frames} entry, this function
normally searches just the selected frame; however, if the variable
@code{pop-up-frames} is non-@code{nil}, it searches all frames on the

4
doc/misc/ChangeLog
View File

@ -1,3 +1,7 @@
2013-07-19 Geoff Kuenning <geoff@cs.hmc.edu> (tiny change)
* gnus.texi (Customizing Articles): Document function predicates.
2013-07-08 Tassilo Horn <tsdh@gnu.org>
* gnus.texi (lines): Correct description of

5
doc/misc/gnus.texi
View File

@ -11858,6 +11858,11 @@ predicate. The following predicates are recognized: @code{or},
(typep "text/x-vcard"))
@end lisp
@item
A function: the function is called with no arguments and should return
@code{nil} or non-@code{nil}. The current article is available in the
buffer named by @code{gnus-article-buffer}.
@end enumerate
You may have noticed that the word @dfn{part} is used here. This refers

3
etc/NEWS
View File

@ -561,6 +561,9 @@ The few hooks that used with-wrapper-hook are replaced as follows:
*** `completion-in-region-function' obsoletes `completion-in-region-functions'.
*** `filter-buffer-substring-function' obsoletes `filter-buffer-substring-functions'.
** `split-string' now takes an optional argument TRIM.
The value, if non-nil, is a regexp that specifies what to trim from
the start and end of each substring.
** `get-upcase-table' is obsoleted by the new `case-table-get-table'.

35
lisp/ChangeLog
View File

@ -3,15 +3,38 @@
* international/mule.el (coding-system-iso-2022-flags): Add
`8-bit-level-4'. (Bug#8522)
2013-07-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
* net/shr.el (shr-mouse-browse-url): New command and keystroke
(bug#14815).
* net/eww.el (eww-process-text-input): Allow inputting when the
point is at the start of the line, as the properties aren't
front-sticky.
* net/shr.el (shr-make-table-1): Ensure that we don't infloop on
degenerate widths.
2013-07-19 Richard Stallman <rms@gnu.org>
* epa.el (epa-popup-info-window): Doc fix.
* subr.el (split-string): New arg TRIM.
2013-07-18 Juanma Barranquero <lekktu@gmail.com>
* frame.el (blink-cursor-timer-function, blink-cursor-suspend):
Add check for W32 (followup to 2013-07-16T11:41:06Z!jan.h.d@swipnet.se).
2013-07-18 Michael Albinus <michael.albinus@gmx.de>
* filenotify.el (file-notify--library): Renamed from
* filenotify.el (file-notify--library): Rename from
`file-notify-support'. Do not autoload. Adapt all uses.
(file-notify-supported-p): New defun.
* autorevert.el (auto-revert-use-notify): Use
`file-notify-supported-p' instead of `file-notify-support'. Adapt
docstring.
* autorevert.el (auto-revert-use-notify):
Use `file-notify-supported-p' instead of `file-notify-support'.
Adapt docstring.
(auto-revert-notify-add-watch): Use `file-notify-supported-p'.
* net/tramp.el (tramp-file-name-for-operation):
@ -3572,8 +3595,8 @@
(prolog-char-quote-workaround):
* progmodes/cperl-mode.el (cperl-under-as-char):
* progmodes/vhdl-mode.el (vhdl-underscore-is-part-of-word):
Mark as obsolete.
(vhdl-mode-syntax-table, vhdl-mode-ext-syntax-table): Initialize in
Mark as obsolete.
(vhdl-mode-syntax-table, vhdl-mode-ext-syntax-table): Initialize in
their declaration.
(vhdl-mode-syntax-table-init): Remove.

3
lisp/epa.el
View File

@ -34,8 +34,7 @@
:group 'epg)
(defcustom epa-popup-info-window t
"If non-nil, status information from epa commands is displayed on
the separate window."
"If non-nil, display status information from epa commands in another window."
:type 'boolean
:group 'epa)

6
lisp/frame.el
View File

@ -1709,7 +1709,7 @@ command starts, by installing a pre-command hook."
"Timer function of timer `blink-cursor-timer'."
(internal-show-cursor nil (not (internal-show-cursor-p)))
;; Each blink is two calls to this function.
(when (memq window-system '(x ns))
(when (memq window-system '(x ns w32))
(setq blink-cursor-blinks-done (1+ blink-cursor-blinks-done))
(when (and (> blink-cursor-blinks 0)
(<= (* 2 blink-cursor-blinks) blink-cursor-blinks-done))
@ -1729,11 +1729,11 @@ itself as a pre-command hook."
(setq blink-cursor-timer nil)))
(defun blink-cursor-suspend ()
"Suspend cursor blinking on NS and X.
"Suspend cursor blinking on NS, X and W32.
This is called when no frame has focus and timers can be suspended.
Timers are restarted by `blink-cursor-check', which is called when a
frame receives focus."
(when (memq window-system '(x ns))
(when (memq window-system '(x ns w32))
(blink-cursor-end)
(when blink-cursor-idle-timer
(cancel-timer blink-cursor-idle-timer)

10
lisp/gnus/ChangeLog
View File

@ -1,3 +1,13 @@
2013-07-19 Geoff Kuenning <geoff@cs.hmc.edu> (tiny change)
* gnus-art.el (gnus-treat-predicate): Allow functions as predicates
(bug#13384).
2013-07-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus-start.el (gnus-clean-old-newsrc): Remove the newsrc cleanups
that were only relevant in a development version a long time ago.
2013-07-18 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-art.el (gnus-shr-put-image): Make it work as well for shr.el's

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

@ -8419,6 +8419,8 @@ For example:
(not (gnus-treat-predicate (car val))))
((eq pred 'typep)
(equal (car val) gnus-treat-type))
((functionp pred)
(funcall pred))
(t
(error "%S is not a valid predicate" pred)))))
((eq val t)

20
lisp/gnus/gnus-start.el
View File

@ -2305,24 +2305,8 @@ If FORCE is non-nil, the .newsrc file is read."
(gnus-clean-old-newsrc))))
(defun gnus-clean-old-newsrc (&optional force)
(when gnus-newsrc-file-version
;; Remove totally bogus `unexists' entries. The name is
;; `unexist'.
(dolist (info (cdr gnus-newsrc-alist))
(let ((exist (assoc 'unexists (gnus-info-marks info))))
(when exist
(gnus-info-set-marks
info (delete exist (gnus-info-marks info))))))
(when (or force
(not (string= gnus-newsrc-file-version gnus-version)))
(message (concat "Removing unexist marks because newsrc "
"version does not match Gnus version."))
;; Remove old `exist' marks from old nnimap groups.
(dolist (info (cdr gnus-newsrc-alist))
(let ((exist (assoc 'unexist (gnus-info-marks info))))
(when exist
(gnus-info-set-marks
info (delete exist (gnus-info-marks info)))))))))
;; Currently no cleanups.
)
(defun gnus-convert-old-newsrc ()
"Convert old newsrc formats into the current format, if needed."

4
lisp/mail/mailalias.el
View File

@ -209,7 +209,9 @@ removed from alias expansions."
(if (re-search-forward "[ \t]*[\n,][ \t]*" end1 t)
(setq epos (match-beginning 0)
seplen (- (point) epos))
(setq epos (marker-position end1) seplen 0))
;; Handle the last name in this header field.
;; We already moved END1 back across whitespace after it.
(setq epos (marker-position end1) seplen 0))
(let ((string (buffer-substring-no-properties pos epos))
translation)
(if (and (not (assoc string disabled-aliases))

2
lisp/net/eww.el
View File

@ -603,7 +603,7 @@ appears in a <link> or <a> tag."
(insert " ")))
(defun eww-process-text-input (beg end length)
(let* ((form (get-text-property end 'eww-form))
(let* ((form (get-text-property (min (1+ end) (point-max)) 'eww-form))
(properties (text-properties-at end))
(type (plist-get form :type)))
(when (and form

14
lisp/net/shr.el
View File

@ -143,6 +143,7 @@ cid: URL as the argument.")
(define-key map [tab] 'shr-next-link)
(define-key map [backtab] 'shr-previous-link)
(define-key map [follow-link] 'mouse-face)
(define-key map [mouse-2] 'shr-mouse-browse-url)
(define-key map "I" 'shr-insert-image)
(define-key map "w" 'shr-copy-url)
(define-key map "u" 'shr-copy-url)
@ -657,6 +658,12 @@ size, and full-buffer size."
(forward-line 1)
(goto-char end))))))
(defun shr-mouse-browse-url (ev)
"Browse the URL under the mouse cursor."
(interactive "e")
(mouse-set-point ev)
(shr-browse-url))
(defun shr-browse-url (&optional external)
"Browse the URL under point.
If EXTERNAL, browse the URL using `shr-external-browser'."
@ -1476,9 +1483,6 @@ ones, in case fg and bg are nil."
(if column
(aref widths width-column)
10))
;; Sanity check for degenerate tables.
(when (zerop width)
(setq width 10))
(when (and fill
(setq colspan (cdr (assq :colspan (cdr column)))))
(setq colspan (string-to-number colspan))
@ -1491,6 +1495,9 @@ ones, in case fg and bg are nil."
(setq width-column (+ width-column (1- colspan))))
(when (or column
(not fill))
;; Sanity check for degenerate tables.
(when (zerop width)
(setq width 10))
(push (shr-render-td (cdr column) width fill)
tds))
(setq i (1+ i)
@ -1499,6 +1506,7 @@ ones, in case fg and bg are nil."
(nreverse trs)))
(defun shr-render-td (cont width fill)
(when (= width 0) (debug))
(with-temp-buffer
(let ((bgcolor (cdr (assq :bgcolor cont)))
(fgcolor (cdr (assq :fgcolor cont)))

63
lisp/subr.el
View File

@ -3529,7 +3529,7 @@ likely to have undesired semantics.")
;; defaulted, OMIT-NULLS should be treated as t. Simplifying the logical
;; expression leads to the equivalent implementation that if SEPARATORS
;; is defaulted, OMIT-NULLS is treated as t.
(defun split-string (string &optional separators omit-nulls)
(defun split-string (string &optional separators omit-nulls trim)
"Split STRING into substrings bounded by matches for SEPARATORS.
The beginning and end of STRING, and each match for SEPARATORS, are
@ -3547,17 +3547,50 @@ that for the default value of SEPARATORS leading and trailing whitespace
are effectively trimmed). If nil, all zero-length substrings are retained,
which correctly parses CSV format, for example.
If TRIM is non-nil, it should be a regular expression to match
text to trim from the beginning and end of each substring. If trimming
makes the substring empty, it is treated as null.
If you want to trim whitespace from the substrings, the reliably correct
way is using TRIM. Making SEPARATORS match that whitespace gives incorrect
results when there is whitespace at the start or end of STRING. If you
see such calls to `split-string', please fix them.
Note that the effect of `(split-string STRING)' is the same as
`(split-string STRING split-string-default-separators t)'. In the rare
case that you wish to retain zero-length substrings when splitting on
whitespace, use `(split-string STRING split-string-default-separators)'.
Modifies the match data; use `save-match-data' if necessary."
(let ((keep-nulls (not (if separators omit-nulls t)))
(rexp (or separators split-string-default-separators))
(start 0)
notfirst
(list nil))
(let* ((keep-nulls (not (if separators omit-nulls t)))
(rexp (or separators split-string-default-separators))
(start 0)
this-start this-end
notfirst
(list nil)
(push-one
;; Push the substring in range THIS-START to THIS-END
;; onto LIST, trimming it and perhaps discarding it.
(lambda ()
(when trim
;; Discard the trim from start of this substring.
(let ((tem (string-match trim string this-start)))
(and (eq tem this-start)
(setq this-start (match-end 0)))))
(when (or keep-nulls (< this-start this-end))
(let ((this (substring string this-start this-end)))
;; Discard the trim from end of this substring.
(when trim
(let ((tem (string-match (concat trim "\\'") this 0)))
(and tem (< tem (length this))
(setq this (substring this 0 tem)))))
;; Trimming could make it empty; check again.
(when (or keep-nulls (> (length this) 0))
(push this list)))))))
(while (and (string-match rexp string
(if (and notfirst
(= start (match-beginning 0))
@ -3565,15 +3598,15 @@ Modifies the match data; use `save-match-data' if necessary."
(1+ start) start))
(< start (length string)))
(setq notfirst t)
(if (or keep-nulls (< start (match-beginning 0)))
(setq list
(cons (substring string start (match-beginning 0))
list)))
(setq start (match-end 0)))
(if (or keep-nulls (< start (length string)))
(setq list
(cons (substring string start)
list)))
(setq this-start start this-end (match-beginning 0)
start (match-end 0))
(funcall push-one))
;; Handle the substring at the end of STRING.
(setq this-start start this-end (length string))
(funcall push-one)
(nreverse list)))
(defun combine-and-quote-strings (strings &optional separator)

78
src/ChangeLog
View File

@ -3,6 +3,84 @@
* coding.c (CODING_ISO_FLAG_LEVEL_4): New macro.
(decode_coding_iso_2022): Check the single-shift area. (Bug#8522)
2013-07-20 Andreas Schwab <schwab@linux-m68k.org>
* lread.c (Fload): Avoid uninitialized warning.
2013-07-19 Paul Eggert <eggert@cs.ucla.edu>
Fix some minor file descriptor leaks and related glitches.
* filelock.c (create_lock_file) [!O_CLOEXEC]: Use fcntl with FD_CLOEXEC.
(create_lock_file): Use write, not emacs_write.
* image.c (slurp_file, png_load_body):
* process.c (Fnetwork_interface_list, Fnetwork_interface_info)
(server_accept_connection):
Don't leak an fd on memory allocation failure.
* image.c (slurp_file): Add a cheap heuristic for growing files.
* xfaces.c (Fx_load_color_file): Block input around the fopen too,
as that's what the other routines do. Maybe input need not be
blocked at all, but it's better to be consistent.
Avoid undefined behavior when strlen is zero.
* alloc.c (staticpro): Avoid buffer overrun on repeated calls.
(NSTATICS): Now a constant; doesn't need to be a macro.
2013-07-19 Richard Stallman <rms@gnu.org>
* coding.c (decode_coding_utf_8): Add simple loop for fast
processing of ASCII characters.
2013-07-19 Paul Eggert <eggert@cs.ucla.edu>
* conf_post.h (RE_TRANSLATE_P) [emacs]: Remove obsolete optimization.
2013-07-19 Eli Zaretskii <eliz@gnu.org>
* keyboard.c (kbd_buffer_get_event): Use Display_Info instead of
unportable 'struct x_display_info'.
(DISPLAY_LIST_INFO): Delete macro: not needed, since Display_Info
is a portable type.
2013-07-19 Paul Eggert <eggert@cs.ucla.edu>
* sysdep.c [GNU_LINUX]: Fix fd and memory leaks and similar issues.
(procfs_ttyname): Don't use uninitialized storage if emacs_fopen
or fscanf fails.
(system_process_attributes): Prefer plain char to unsigned char
when either will do. Clean up properly if interrupted or if
memory allocations fail. Don't assume sscanf succeeds. Remove
no-longer-needed workaround to stop GCC from whining. Read
command-line once, instead of multiple times. Check read status a
bit more carefully.
Fix obscure porting bug with varargs functions.
The code assumed that int is treated like ptrdiff_t in a vararg
function, which is not a portable assumption. There was a similar
-- though these days less likely -- porting problem with various
assumptions that pointers of different types all smell the same as
far as vararg functions is conserved. To make this problem less
likely in the future, redo the API to use varargs functions.
* alloc.c (make_save_value): Remove this vararg function.
All uses changed to ...
(make_save_int_int_int, make_save_obj_obj_obj_obj)
(make_save_ptr_int, make_save_funcptr_ptr_obj, make_save_memory):
New functions.
(make_save_ptr): Rename from make_save_pointer, for consistency with
the above. Define only on platforms that need it. All uses changed.
2013-07-18 Paul Eggert <eggert@cs.ucla.edu>
* keyboard.c: Try to fix typos in previous change.
(DISPLAY_LIST_INFO): New macro.
(kbd_buffer_get_event): Do not access members that are not present
in X11. Revert inadvertent change of "!=" to "=".
2013-07-18 Juanma Barranquero <lekktu@gmail.com>
* keyboard.c (kbd_buffer_get_event):
* w32term.c (x_focus_changed): Port FOCUS_(IN|OUT)_EVENT changes to W32.
Followup to 2013-07-16T11:41:06Z!jan.h.d@swipnet.se.
2013-07-18 Paul Eggert <eggert@cs.ucla.edu>
* filelock.c: Fix unlikely file descriptor leaks.

109
src/alloc.c
View File

@ -341,7 +341,7 @@ struct gcpro *gcprolist;
/* Addresses of staticpro'd variables. Initialize it to a nonzero
value; otherwise some compilers put it into BSS. */
#define NSTATICS 0x800
enum { NSTATICS = 2048 };
static Lisp_Object *staticvec[NSTATICS] = {&Vpurify_flag};
/* Index of next unused slot in staticvec. */
@ -3342,62 +3342,81 @@ verify (((SAVE_INTEGER | SAVE_POINTER | SAVE_FUNCPOINTER | SAVE_OBJECT)
>> SAVE_SLOT_BITS)
== 0);
/* Return a Lisp_Save_Value object with the data saved according to
DATA_TYPE. DATA_TYPE should be one of SAVE_TYPE_INT_INT, etc. */
/* Return Lisp_Save_Value objects for the various combinations
that callers need. */
Lisp_Object
make_save_value (enum Lisp_Save_Type save_type, ...)
make_save_int_int_int (ptrdiff_t a, ptrdiff_t b, ptrdiff_t c)
{
va_list ap;
int i;
Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
struct Lisp_Save_Value *p = XSAVE_VALUE (val);
eassert (0 < save_type
&& (save_type < 1 << (SAVE_TYPE_BITS - 1)
|| save_type == SAVE_TYPE_MEMORY));
p->save_type = save_type;
va_start (ap, save_type);
save_type &= ~ (1 << (SAVE_TYPE_BITS - 1));
for (i = 0; save_type; i++, save_type >>= SAVE_SLOT_BITS)
switch (save_type & ((1 << SAVE_SLOT_BITS) - 1))
{
case SAVE_POINTER:
p->data[i].pointer = va_arg (ap, void *);
break;
case SAVE_FUNCPOINTER:
p->data[i].funcpointer = va_arg (ap, voidfuncptr);
break;
case SAVE_INTEGER:
p->data[i].integer = va_arg (ap, ptrdiff_t);
break;
case SAVE_OBJECT:
p->data[i].object = va_arg (ap, Lisp_Object);
break;
default:
emacs_abort ();
}
va_end (ap);
p->save_type = SAVE_TYPE_INT_INT_INT;
p->data[0].integer = a;
p->data[1].integer = b;
p->data[2].integer = c;
return val;
}
/* Save just one C pointer. record_unwind_protect_ptr is simpler and
faster than combining this with record_unwind_protect, but
occasionally this function is useful for other reasons. */
Lisp_Object
make_save_pointer (void *pointer)
make_save_obj_obj_obj_obj (Lisp_Object a, Lisp_Object b, Lisp_Object c,
Lisp_Object d)
{
Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
struct Lisp_Save_Value *p = XSAVE_VALUE (val);
p->save_type = SAVE_TYPE_OBJ_OBJ_OBJ_OBJ;
p->data[0].object = a;
p->data[1].object = b;
p->data[2].object = c;
p->data[3].object = d;
return val;
}
#if defined HAVE_NS || defined DOS_NT
Lisp_Object
make_save_ptr (void *a)
{
Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
struct Lisp_Save_Value *p = XSAVE_VALUE (val);
p->save_type = SAVE_POINTER;
p->data[0].pointer = pointer;
p->data[0].pointer = a;
return val;
}
#endif
Lisp_Object
make_save_ptr_int (void *a, ptrdiff_t b)
{
Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
struct Lisp_Save_Value *p = XSAVE_VALUE (val);
p->save_type = SAVE_TYPE_PTR_INT;
p->data[0].pointer = a;
p->data[1].integer = b;
return val;
}
Lisp_Object
make_save_funcptr_ptr_obj (void (*a) (void), void *b, Lisp_Object c)
{
Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
struct Lisp_Save_Value *p = XSAVE_VALUE (val);
p->save_type = SAVE_TYPE_FUNCPTR_PTR_OBJ;
p->data[0].funcpointer = a;
p->data[1].pointer = b;
p->data[2].object = c;
return val;
}
/* Return a Lisp_Save_Value object that represents an array A
of N Lisp objects. */
Lisp_Object
make_save_memory (Lisp_Object *a, ptrdiff_t n)
{
Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
struct Lisp_Save_Value *p = XSAVE_VALUE (val);
p->save_type = SAVE_TYPE_MEMORY;
p->data[0].pointer = a;
p->data[1].integer = n;
return val;
}
@ -5117,9 +5136,9 @@ Does not copy symbols. Copies strings without text properties. */)
void
staticpro (Lisp_Object *varaddress)
{
staticvec[staticidx++] = varaddress;
if (staticidx >= NSTATICS)
fatal ("NSTATICS too small; try increasing and recompiling Emacs.");
staticvec[staticidx++] = varaddress;
}

39
src/coding.c
View File

@ -1365,6 +1365,45 @@ decode_coding_utf_8 (struct coding_system *coding)
break;
}
/* In the simple case, rapidly handle ordinary characters */
if (multibytep && ! eol_dos
&& charbuf < charbuf_end - 6 && src < src_end - 6)
{
while (charbuf < charbuf_end - 6 && src < src_end - 6)
{
c1 = *src;
if (c1 & 0x80)
break;
src++;
consumed_chars++;
*charbuf++ = c1;
c1 = *src;
if (c1 & 0x80)
break;
src++;
consumed_chars++;
*charbuf++ = c1;
c1 = *src;
if (c1 & 0x80)
break;
src++;
consumed_chars++;
*charbuf++ = c1;
c1 = *src;
if (c1 & 0x80)
break;
src++;
consumed_chars++;
*charbuf++ = c1;
}
/* If we handled at least one character, restart the main loop. */
if (src != src_base)
continue;
}
if (byte_after_cr >= 0)
c1 = byte_after_cr, byte_after_cr = -1;
else

6
src/conf_post.h
View File

@ -160,13 +160,7 @@ extern void _DebPrint (const char *fmt, ...);
/* Tell regex.c to use a type compatible with Emacs. */
#define RE_TRANSLATE_TYPE Lisp_Object
#define RE_TRANSLATE(TBL, C) char_table_translate (TBL, C)
#ifdef make_number
/* If make_number is a macro, use it. */
#define RE_TRANSLATE_P(TBL) (!EQ (TBL, make_number (0)))
#else
/* If make_number is a function, avoid it. */
#define RE_TRANSLATE_P(TBL) (!(INTEGERP (TBL) && XINT (TBL) == 0))
#endif
#endif
#include <string.h>

5
src/editfns.c
View File

@ -838,9 +838,8 @@ This function does not move point. */)
Lisp_Object
save_excursion_save (void)
{
return make_save_value
(SAVE_TYPE_OBJ_OBJ_OBJ_OBJ,
Fpoint_marker (),
return make_save_obj_obj_obj_obj
(Fpoint_marker (),
/* Do not copy the mark if it points to nowhere. */
(XMARKER (BVAR (current_buffer, mark))->buffer
? Fcopy_marker (BVAR (current_buffer, mark), Qnil)

3
src/fileio.c
View File

@ -4215,8 +4215,7 @@ by calling `format-decode', which see. */)
to be signaled after decoding the text we read. */
nbytes = internal_condition_case_1
(read_non_regular,
make_save_value (SAVE_TYPE_INT_INT_INT, (ptrdiff_t) fd,
inserted, trytry),
make_save_int_int_int (fd, inserted, trytry),
Qerror, read_non_regular_quit);
if (NILP (nbytes))

6
src/filelock.c
View File

@ -430,12 +430,14 @@ create_lock_file (char *lfname, char *lock_info_str, bool force)
else
{
ptrdiff_t lock_info_len;
#if ! HAVE_MKOSTEMP
#if ! (HAVE_MKOSTEMP && O_CLOEXEC)
fcntl (fd, F_SETFD, FD_CLOEXEC);
#endif
lock_info_len = strlen (lock_info_str);
err = 0;
if (emacs_write (fd, lock_info_str, lock_info_len) != lock_info_len
/* Use 'write', not 'emacs_write', as garbage collection
might signal an error, which would leak FD. */
if (write (fd, lock_info_str, lock_info_len) != lock_info_len
|| fchmod (fd, S_IRUSR | S_IRGRP | S_IROTH) != 0)
err = errno;
/* There is no need to call fsync here, as the contents of

2
src/font.c
View File

@ -1861,7 +1861,7 @@ otf_open (Lisp_Object file)
else
{
otf = STRINGP (file) ? OTF_open (SSDATA (file)) : NULL;
val = make_save_pointer (otf);
val = make_save_ptr (otf);
otf_list = Fcons (Fcons (file, val), otf_list);
}
return otf;

2
src/ftfont.c
View File

@ -393,7 +393,7 @@ ftfont_lookup_cache (Lisp_Object key, enum ftfont_cache_for cache_for)
cache_data = xmalloc (sizeof *cache_data);
cache_data->ft_face = NULL;
cache_data->fc_charset = NULL;
val = make_save_value (SAVE_TYPE_PTR_INT, cache_data, 0);
val = make_save_ptr_int (cache_data, 0);
cache = Fcons (Qnil, val);
Fputhash (key, cache, ft_face_cache);
}

35
src/image.c
View File

@ -2276,23 +2276,28 @@ slurp_file (char *file, ptrdiff_t *size)
unsigned char *buf = NULL;
struct stat st;
if (fp && fstat (fileno (fp), &st) == 0
&& 0 <= st.st_size && st.st_size <= min (PTRDIFF_MAX, SIZE_MAX)
&& (buf = xmalloc (st.st_size),
fread (buf, 1, st.st_size, fp) == st.st_size))
if (fp)
{
*size = st.st_size;
fclose (fp);
}
else
{
if (fp)
fclose (fp);
if (buf)
ptrdiff_t count = SPECPDL_INDEX ();
record_unwind_protect_ptr (fclose_unwind, fp);
if (fstat (fileno (fp), &st) == 0
&& 0 <= st.st_size && st.st_size < min (PTRDIFF_MAX, SIZE_MAX))
{
xfree (buf);
buf = NULL;
/* Report an error if we read past the purported EOF.
This can happen if the file grows as we read it. */
ptrdiff_t buflen = st.st_size;
buf = xmalloc (buflen + 1);
if (fread (buf, 1, buflen + 1, fp) == buflen)
*size = buflen;
else
{
xfree (buf);
buf = NULL;
}
}
unbind_to (count, Qnil);
}
return buf;
@ -5732,8 +5737,8 @@ png_load_body (struct frame *f, struct image *img, struct png_load_context *c)
if (fread (sig, 1, sizeof sig, fp) != sizeof sig
|| fn_png_sig_cmp (sig, 0, sizeof sig))
{
image_error ("Not a PNG file: `%s'", file, Qnil);
fclose (fp);
image_error ("Not a PNG file: `%s'", file, Qnil);
return 0;
}
}

14
src/keyboard.c
View File

@ -4066,21 +4066,19 @@ kbd_buffer_get_event (KBOARD **kbp,
}
else if (event->kind == FOCUS_OUT_EVENT)
{
#if defined(HAVE_NS) || defined (HAVE_X11)
#ifdef HAVE_WINDOW_SYSTEM
#ifdef HAVE_NS
struct ns_display_info *di;
#else
struct x_display_info *di;
#endif
Display_Info *di;
Lisp_Object frame = event->frame_or_window;
bool focused = false;
for (di = x_display_list; di && ! focused; di = di->next)
focused = di->x_highlight_frame != 0;
if (! focused) obj = make_lispy_focus_out (frame);
#endif /* HAVE_NS || HAVE_X11 */
if (!focused)
obj = make_lispy_focus_out (frame);
#endif /* HAVE_WINDOW_SYSTEM */
kbd_fetch_ptr = event + 1;
}

4
src/keymap.c
View File

@ -617,8 +617,8 @@ map_keymap_internal (Lisp_Object map,
}
else if (CHAR_TABLE_P (binding))
map_char_table (map_keymap_char_table_item, Qnil, binding,
make_save_value (SAVE_TYPE_FUNCPTR_PTR_OBJ,
(voidfuncptr) fun, data, args));
make_save_funcptr_ptr_obj ((voidfuncptr) fun, data,
args));
}
UNGCPRO;
return tail;

43
src/lisp.h
View File

@ -441,8 +441,7 @@ enum Lisp_Fwd_Type
displayed to users. These are Lisp_Save_Value, a Lisp_Misc
subtype; and PVEC_OTHER, a kind of vectorlike object. The former
is suitable for temporarily stashing away pointers and integers in
a Lisp object (see the existing uses of make_save_value and
XSAVE_VALUE). The latter is useful for vector-like Lisp objects
a Lisp object. The latter is useful for vector-like Lisp objects
that need to be used as part of other objects, but which are never
shown to users or Lisp code (search for PVEC_OTHER in xterm.c for
an example).
@ -1815,30 +1814,26 @@ enum Lisp_Save_Type
This is mostly used to package C integers and pointers to call
record_unwind_protect when two or more values need to be saved.
make_save_value lets you pack up to SAVE_VALUE_SLOTS integers, pointers,
function pointers or Lisp_Objects and conveniently get them back
with XSAVE_INTEGER, XSAVE_POINTER, XSAVE_FUNCPOINTER, and
XSAVE_OBJECT macros:
For example:
...
struct my_data *md = get_my_data ();
Lisp_Object my_object = get_my_object ();
record_unwind_protect
(my_unwind, make_save_value (SAVE_TYPE_PTR_OBJ, md, my_object));
ptrdiff_t mi = get_my_integer ();
record_unwind_protect (my_unwind, make_save_ptr_int (md, mi));
...
Lisp_Object my_unwind (Lisp_Object arg)
{
struct my_data *md = XSAVE_POINTER (arg, 0);
Lisp_Object my_object = XSAVE_OBJECT (arg, 1);
ptrdiff_t mi = XSAVE_INTEGER (arg, 1);
...
}
If ENABLE_CHECKING is in effect, XSAVE_xxx macros do type checking of the
saved objects and raise eassert if type of the saved object doesn't match
the type which is extracted. In the example above, XSAVE_INTEGER (arg, 2)
or XSAVE_OBJECT (arg, 0) are wrong because nothing was saved in slot 2 and
Lisp_Object was saved in slot 1 of ARG. */
and XSAVE_OBJECT (arg, 0) are wrong because nothing was saved in slot 2 and
slot 0 is a pointer. */
typedef void (*voidfuncptr) (void);
@ -1848,12 +1843,13 @@ struct Lisp_Save_Value
unsigned gcmarkbit : 1;
int spacer : 32 - (16 + 1 + SAVE_TYPE_BITS);
/* DATA[N] may hold up to SAVE_VALUE_SLOTS entries. The type of
V's Ith entry is given by save_type (V, I). E.g., if save_type
(V, 3) == SAVE_INTEGER, V->data[3].integer is in use.
/* V->data may hold up to SAVE_VALUE_SLOTS entries. The type of
V's data entries are determined by V->save_type. E.g., if
V->save_type == SAVE_TYPE_PTR_OBJ, V->data[0] is a pointer,
V->data[1] is an integer, and V's other data entries are unused.
If SAVE_TYPE == SAVE_TYPE_MEMORY, DATA[0].pointer is the address of
a memory area containing DATA[1].integer potential Lisp_Objects. */
If V->save_type == SAVE_TYPE_MEMORY, V->data[0].pointer is the address of
a memory area containing V->data[1].integer potential Lisp_Objects. */
ENUM_BF (Lisp_Save_Type) save_type : SAVE_TYPE_BITS;
union {
void *pointer;
@ -3580,8 +3576,15 @@ extern bool abort_on_gc;
extern Lisp_Object make_float (double);
extern void display_malloc_warning (void);
extern ptrdiff_t inhibit_garbage_collection (void);
extern Lisp_Object make_save_value (enum Lisp_Save_Type, ...);
extern Lisp_Object make_save_pointer (void *);
extern Lisp_Object make_save_int_int_int (ptrdiff_t, ptrdiff_t, ptrdiff_t);
extern Lisp_Object make_save_obj_obj_obj_obj (Lisp_Object, Lisp_Object,
Lisp_Object, Lisp_Object);
extern Lisp_Object make_save_ptr (void *);
extern Lisp_Object make_save_ptr_int (void *, ptrdiff_t);
extern Lisp_Object make_save_ptr_ptr (void *, void *);
extern Lisp_Object make_save_funcptr_ptr_obj (void (*) (void), void *,
Lisp_Object);
extern Lisp_Object make_save_memory (Lisp_Object *, ptrdiff_t);
extern void free_save_value (Lisp_Object);
extern Lisp_Object build_overlay (Lisp_Object, Lisp_Object, Lisp_Object);
extern void free_marker (Lisp_Object);
@ -4314,7 +4317,7 @@ extern void *record_xmalloc (size_t);
{ \
Lisp_Object arg_; \
buf = xmalloc ((nelt) * word_size); \
arg_ = make_save_value (SAVE_TYPE_MEMORY, buf, nelt); \
arg_ = make_save_memory (buf, nelt); \
sa_must_free = 1; \
record_unwind_protect (free_save_value, arg_); \
} \

4
src/lread.c
View File

@ -1044,7 +1044,7 @@ Return t if the file exists and loads successfully. */)
{
FILE *stream;
int fd;
int fd_index;
int fd_index = 0;
ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3;
Lisp_Object found, efound, hist_file_name;
@ -1175,7 +1175,7 @@ Return t if the file exists and loads successfully. */)
#endif
}
if (0 <= fd)
if (fd >= 0)
{
fd_index = SPECPDL_INDEX ();
record_unwind_protect_int (close_file_unwind, fd);

2
src/nsterm.m
View File

@ -3777,7 +3777,7 @@ overwriting cursor (usually when cursor on a tab) */
}
bar = [[EmacsScroller alloc] initFrame: r window: win];
wset_vertical_scroll_bar (window, make_save_pointer (bar));
wset_vertical_scroll_bar (window, make_save_ptr (bar));
}
else
{

22
src/process.c
View File

@ -3526,10 +3526,13 @@ format; see the description of ADDRESS in `make-network-process'. */)
ptrdiff_t buf_size = 512;
int s;
Lisp_Object res;
ptrdiff_t count;
s = socket (AF_INET, SOCK_STREAM | SOCK_CLOEXEC, 0);
if (s < 0)
return Qnil;
count = SPECPDL_INDEX ();
record_unwind_protect_int (close_file_unwind, s);
do
{
@ -3545,9 +3548,7 @@ format; see the description of ADDRESS in `make-network-process'. */)
}
while (ifconf.ifc_len == buf_size);
emacs_close (s);
res = Qnil;
res = unbind_to (count, Qnil);
ifreq = ifconf.ifc_req;
while ((char *) ifreq < (char *) ifconf.ifc_req + ifconf.ifc_len)
{
@ -3672,6 +3673,7 @@ FLAGS is the current flags of the interface. */)
Lisp_Object elt;
int s;
bool any = 0;
ptrdiff_t count;
#if (! (defined SIOCGIFHWADDR && defined HAVE_STRUCT_IFREQ_IFR_HWADDR) \
&& defined HAVE_GETIFADDRS && defined LLADDR)
struct ifaddrs *ifap;
@ -3686,6 +3688,8 @@ FLAGS is the current flags of the interface. */)
s = socket (AF_INET, SOCK_STREAM | SOCK_CLOEXEC, 0);
if (s < 0)
return Qnil;
count = SPECPDL_INDEX ();
record_unwind_protect_int (close_file_unwind, s);
elt = Qnil;
#if defined (SIOCGIFFLAGS) && defined (HAVE_STRUCT_IFREQ_IFR_FLAGS)
@ -3802,9 +3806,7 @@ FLAGS is the current flags of the interface. */)
#endif
res = Fcons (elt, res);
emacs_close (s);
return any ? res : Qnil;
return unbind_to (count, any ? res : Qnil);
}
#endif
#endif /* defined (HAVE_NET_IF_H) */
@ -3978,6 +3980,7 @@ server_accept_connection (Lisp_Object server, int channel)
#endif
} saddr;
socklen_t len = sizeof saddr;
ptrdiff_t count;
s = accept4 (channel, &saddr.sa, &len, SOCK_CLOEXEC);
@ -4000,6 +4003,9 @@ server_accept_connection (Lisp_Object server, int channel)
return;
}
count = SPECPDL_INDEX ();
record_unwind_protect_int (close_file_unwind, s);
connect_counter++;
/* Setup a new process to handle the connection. */
@ -4116,6 +4122,10 @@ server_accept_connection (Lisp_Object server, int channel)
pset_filter (p, ps->filter);
pset_command (p, Qnil);
p->pid = 0;
/* Discard the unwind protect for closing S. */
specpdl_ptr = specpdl + count;
p->infd = s;
p->outfd = s;
pset_status (p, Qrun);

294
src/sysdep.c
View File

@ -2807,11 +2807,12 @@ get_up_time (void)
static Lisp_Object
procfs_ttyname (int rdev)
{
FILE *fdev = NULL;
FILE *fdev;
char name[PATH_MAX];
block_input ();
fdev = emacs_fopen ("/proc/tty/drivers", "r");
name[0] = 0;
if (fdev)
{
@ -2820,7 +2821,7 @@ procfs_ttyname (int rdev)
char minor[25]; /* 2 32-bit numbers + dash */
char *endp;
while (!feof (fdev) && !ferror (fdev))
for (; !feof (fdev) && !ferror (fdev); name[0] = 0)
{
if (fscanf (fdev, "%*s %s %u %s %*s\n", name, &major, minor) >= 3
&& major == MAJOR (rdev))
@ -2849,7 +2850,7 @@ procfs_ttyname (int rdev)
static unsigned long
procfs_get_total_memory (void)
{
FILE *fmem = NULL;
FILE *fmem;
unsigned long retval = 2 * 1024 * 1024; /* default: 2GB */
block_input ();
@ -2892,7 +2893,7 @@ system_process_attributes (Lisp_Object pid)
int cmdsize = sizeof default_cmd - 1;
char *cmdline = NULL;
ptrdiff_t cmdline_size;
unsigned char c;
char c;
printmax_t proc_id;
int ppid, pgrp, sess, tty, tpgid, thcount;
uid_t uid;
@ -2903,7 +2904,8 @@ system_process_attributes (Lisp_Object pid)
EMACS_TIME tnow, tstart, tboot, telapsed, us_time;
double pcpu, pmem;
Lisp_Object attrs = Qnil;
Lisp_Object cmd_str, decoded_cmd, tem;
Lisp_Object cmd_str, decoded_cmd;
ptrdiff_t count;
struct gcpro gcpro1, gcpro2;
CHECK_NUMBER_OR_FLOAT (pid);
@ -2931,11 +2933,19 @@ system_process_attributes (Lisp_Object pid)
if (gr)
attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs);
count = SPECPDL_INDEX ();
strcpy (fn, procfn);
procfn_end = fn + strlen (fn);
strcpy (procfn_end, "/stat");
fd = emacs_open (fn, O_RDONLY, 0);
if (fd >= 0 && (nread = emacs_read (fd, procbuf, sizeof (procbuf) - 1)) > 0)
if (fd < 0)
nread = 0;
else
{
record_unwind_protect_int (close_file_unwind, fd);
nread = emacs_read (fd, procbuf, sizeof procbuf - 1);
}
if (0 < nread)
{
procbuf[nread] = '\0';
p = procbuf;
@ -2959,39 +2969,32 @@ system_process_attributes (Lisp_Object pid)
Vlocale_coding_system, 0);
attrs = Fcons (Fcons (Qcomm, decoded_cmd), attrs);
if (q)
/* state ppid pgrp sess tty tpgid . minflt cminflt majflt cmajflt
utime stime cutime cstime priority nice thcount . start vsize rss */
if (q
&& (sscanf (q + 2, ("%c %d %d %d %d %d %*u %lu %lu %lu %lu "
"%Lu %Lu %Lu %Lu %ld %ld %d %*d %Lu %lu %ld"),
&c, &ppid, &pgrp, &sess, &tty, &tpgid,
&minflt, &cminflt, &majflt, &cmajflt,
&u_time, &s_time, &cutime, &cstime,
&priority, &niceness, &thcount, &start, &vsize, &rss)
== 20))
{
EMACS_INT ppid_eint, pgrp_eint, sess_eint, tpgid_eint, thcount_eint;
p = q + 2;
/* state ppid pgrp sess tty tpgid . minflt cminflt majflt cmajflt utime stime cutime cstime priority nice thcount . start vsize rss */
sscanf (p, "%c %d %d %d %d %d %*u %lu %lu %lu %lu %Lu %Lu %Lu %Lu %ld %ld %d %*d %Lu %lu %ld",
&c, &ppid, &pgrp, &sess, &tty, &tpgid,
&minflt, &cminflt, &majflt, &cmajflt,
&u_time, &s_time, &cutime, &cstime,
&priority, &niceness, &thcount, &start, &vsize, &rss);
{
char state_str[2];
state_str[0] = c;
state_str[1] = '\0';
tem = build_string (state_str);
attrs = Fcons (Fcons (Qstate, tem), attrs);
}
/* Stops GCC whining about limited range of data type. */
ppid_eint = ppid;
pgrp_eint = pgrp;
sess_eint = sess;
tpgid_eint = tpgid;
thcount_eint = thcount;
attrs = Fcons (Fcons (Qppid, make_fixnum_or_float (ppid_eint)), attrs);
attrs = Fcons (Fcons (Qpgrp, make_fixnum_or_float (pgrp_eint)), attrs);
attrs = Fcons (Fcons (Qsess, make_fixnum_or_float (sess_eint)), attrs);
char state_str[2];
state_str[0] = c;
state_str[1] = '\0';
attrs = Fcons (Fcons (Qstate, build_string (state_str)), attrs);
attrs = Fcons (Fcons (Qppid, make_fixnum_or_float (ppid)), attrs);
attrs = Fcons (Fcons (Qpgrp, make_fixnum_or_float (pgrp)), attrs);
attrs = Fcons (Fcons (Qsess, make_fixnum_or_float (sess)), attrs);
attrs = Fcons (Fcons (Qttname, procfs_ttyname (tty)), attrs);
attrs = Fcons (Fcons (Qtpgid, make_fixnum_or_float (tpgid_eint)), attrs);
attrs = Fcons (Fcons (Qtpgid, make_fixnum_or_float (tpgid)), attrs);
attrs = Fcons (Fcons (Qminflt, make_fixnum_or_float (minflt)), attrs);
attrs = Fcons (Fcons (Qmajflt, make_fixnum_or_float (majflt)), attrs);
attrs = Fcons (Fcons (Qcminflt, make_fixnum_or_float (cminflt)), attrs);
attrs = Fcons (Fcons (Qcmajflt, make_fixnum_or_float (cmajflt)), attrs);
attrs = Fcons (Fcons (Qcminflt, make_fixnum_or_float (cminflt)),
attrs);
attrs = Fcons (Fcons (Qcmajflt, make_fixnum_or_float (cmajflt)),
attrs);
clocks_per_sec = sysconf (_SC_CLK_TCK);
if (clocks_per_sec < 0)
clocks_per_sec = 100;
@ -3012,19 +3015,22 @@ system_process_attributes (Lisp_Object pid)
ltime_from_jiffies (cstime, clocks_per_sec)),
attrs);
attrs = Fcons (Fcons (Qctime,
ltime_from_jiffies (cstime+cutime, clocks_per_sec)),
ltime_from_jiffies (cstime + cutime,
clocks_per_sec)),
attrs);
attrs = Fcons (Fcons (Qpri, make_number (priority)), attrs);
attrs = Fcons (Fcons (Qnice, make_number (niceness)), attrs);
attrs = Fcons (Fcons (Qthcount, make_fixnum_or_float (thcount_eint)), attrs);
attrs = Fcons (Fcons (Qthcount, make_fixnum_or_float (thcount)),
attrs);
tnow = current_emacs_time ();
telapsed = get_up_time ();
tboot = sub_emacs_time (tnow, telapsed);
tstart = time_from_jiffies (start, clocks_per_sec);
tstart = add_emacs_time (tboot, tstart);
attrs = Fcons (Fcons (Qstart, make_lisp_time (tstart)), attrs);
attrs = Fcons (Fcons (Qvsize, make_fixnum_or_float (vsize/1024)), attrs);
attrs = Fcons (Fcons (Qrss, make_fixnum_or_float (4*rss)), attrs);
attrs = Fcons (Fcons (Qvsize, make_fixnum_or_float (vsize / 1024)),
attrs);
attrs = Fcons (Fcons (Qrss, make_fixnum_or_float (4 * rss)), attrs);
telapsed = sub_emacs_time (tnow, tstart);
attrs = Fcons (Fcons (Qetime, make_lisp_time (telapsed)), attrs);
us_time = time_from_jiffies (u_time + s_time, clocks_per_sec);
@ -3039,67 +3045,63 @@ system_process_attributes (Lisp_Object pid)
attrs = Fcons (Fcons (Qpmem, make_float (pmem)), attrs);
}
}
if (fd >= 0)
emacs_close (fd);
unbind_to (count, Qnil);
/* args */
strcpy (procfn_end, "/cmdline");
fd = emacs_open (fn, O_RDONLY, 0);
if (fd >= 0)
{
char ch;
for (cmdline_size = 0; cmdline_size < STRING_BYTES_BOUND; cmdline_size++)
ptrdiff_t readsize, nread_incr;
record_unwind_protect_int (close_file_unwind, fd);
record_unwind_protect_nothing ();
nread = cmdline_size = 0;
do
{
if (emacs_read (fd, &ch, 1) != 1)
break;
c = ch;
if (c_isspace (c) || c == '\\')
cmdline_size++; /* for later quoting, see below */
cmdline = xpalloc (cmdline, &cmdline_size, 2, STRING_BYTES_BOUND, 1);
set_unwind_protect_ptr (count + 1, xfree, cmdline);
/* Leave room even if every byte needs escaping below. */
readsize = (cmdline_size >> 1) - nread;
nread_incr = emacs_read (fd, cmdline + nread, readsize);
nread += max (0, nread_incr);
}
if (cmdline_size)
while (nread_incr == readsize);
if (nread)
{
cmdline = xmalloc (cmdline_size + 1);
lseek (fd, 0L, SEEK_SET);
cmdline[0] = '\0';
if ((nread = read (fd, cmdline, cmdline_size)) >= 0)
cmdline[nread++] = '\0';
else
{
/* Assigning zero to `nread' makes us skip the following
two loops, assign zero to cmdline_size, and enter the
following `if' clause that handles unknown command
lines. */
nread = 0;
}
/* We don't want trailing null characters. */
for (p = cmdline + nread; p > cmdline + 1 && !p[-1]; p--)
nread--;
for (p = cmdline; p < cmdline + nread; p++)
for (p = cmdline + nread; cmdline < p && !p[-1]; p--)
continue;
/* Escape-quote whitespace and backslashes. */
q = cmdline + cmdline_size;
while (cmdline < p)
{
/* Escape-quote whitespace and backslashes. */
if (c_isspace (*p) || *p == '\\')
{
memmove (p + 1, p, nread - (p - cmdline));
nread++;
*p++ = '\\';
}
else if (*p == '\0')
*p = ' ';
char c = *--p;
*--q = c ? c : ' ';
if (c_isspace (c) || c == '\\')
*--q = '\\';
}
cmdline_size = nread;
nread = cmdline + cmdline_size - q;
}
if (!cmdline_size)
if (!nread)
{
cmdline_size = cmdsize + 2;
cmdline = xmalloc (cmdline_size + 1);
nread = cmdsize + 2;
cmdline_size = nread + 1;
q = cmdline = xrealloc (cmdline, cmdline_size);
set_unwind_protect_ptr (count + 1, xfree, cmdline);
sprintf (cmdline, "[%.*s]", cmdsize, cmd);
}
emacs_close (fd);
/* Command line is encoded in locale-coding-system; decode it. */
cmd_str = make_unibyte_string (cmdline, cmdline_size);
cmd_str = make_unibyte_string (q, nread);
decoded_cmd = code_convert_string_norecord (cmd_str,
Vlocale_coding_system, 0);
xfree (cmdline);
unbind_to (count, Qnil);
attrs = Fcons (Fcons (Qargs, decoded_cmd), attrs);
}
@ -3141,8 +3143,9 @@ system_process_attributes (Lisp_Object pid)
uid_t uid;
gid_t gid;
Lisp_Object attrs = Qnil;
Lisp_Object decoded_cmd, tem;
Lisp_Object decoded_cmd;
struct gcpro gcpro1, gcpro2;
ptrdiff_t count;
CHECK_NUMBER_OR_FLOAT (pid);
CONS_TO_INTEGER (pid, pid_t, proc_id);
@ -3169,72 +3172,83 @@ system_process_attributes (Lisp_Object pid)
if (gr)
attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs);
count = SPECPDL_INDEX ();
strcpy (fn, procfn);
procfn_end = fn + strlen (fn);
strcpy (procfn_end, "/psinfo");
fd = emacs_open (fn, O_RDONLY, 0);
if (fd >= 0
&& (nread = read (fd, (char*)&pinfo, sizeof (struct psinfo)) > 0))
if (fd < 0)
nread = 0;
else
{
attrs = Fcons (Fcons (Qppid, make_fixnum_or_float (pinfo.pr_ppid)), attrs);
attrs = Fcons (Fcons (Qpgrp, make_fixnum_or_float (pinfo.pr_pgid)), attrs);
attrs = Fcons (Fcons (Qsess, make_fixnum_or_float (pinfo.pr_sid)), attrs);
{
char state_str[2];
state_str[0] = pinfo.pr_lwp.pr_sname;
state_str[1] = '\0';
tem = build_string (state_str);
attrs = Fcons (Fcons (Qstate, tem), attrs);
}
/* FIXME: missing Qttyname. psinfo.pr_ttydev is a dev_t,
need to get a string from it. */
/* FIXME: missing: Qtpgid */
/* FIXME: missing:
Qminflt
Qmajflt
Qcminflt
Qcmajflt
Qutime
Qcutime
Qstime
Qcstime
Are they available? */
attrs = Fcons (Fcons (Qtime, make_lisp_time (pinfo.pr_time)), attrs);
attrs = Fcons (Fcons (Qctime, make_lisp_time (pinfo.pr_ctime)), attrs);
attrs = Fcons (Fcons (Qpri, make_number (pinfo.pr_lwp.pr_pri)), attrs);
attrs = Fcons (Fcons (Qnice, make_number (pinfo.pr_lwp.pr_nice)), attrs);
attrs = Fcons (Fcons (Qthcount, make_fixnum_or_float (pinfo.pr_nlwp)), attrs);
attrs = Fcons (Fcons (Qstart, make_lisp_time (pinfo.pr_start)), attrs);
attrs = Fcons (Fcons (Qvsize, make_fixnum_or_float (pinfo.pr_size)), attrs);
attrs = Fcons (Fcons (Qrss, make_fixnum_or_float (pinfo.pr_rssize)), attrs);
/* pr_pctcpu and pr_pctmem are unsigned integers in the
range 0 .. 2**15, representing 0.0 .. 1.0. */
attrs = Fcons (Fcons (Qpcpu, make_float (100.0 / 0x8000 * pinfo.pr_pctcpu)), attrs);
attrs = Fcons (Fcons (Qpmem, make_float (100.0 / 0x8000 * pinfo.pr_pctmem)), attrs);
decoded_cmd
= code_convert_string_norecord (make_unibyte_string (pinfo.pr_fname,
strlen (pinfo.pr_fname)),
Vlocale_coding_system, 0);
attrs = Fcons (Fcons (Qcomm, decoded_cmd), attrs);
decoded_cmd
= code_convert_string_norecord (make_unibyte_string (pinfo.pr_psargs,
strlen (pinfo.pr_psargs)),
Vlocale_coding_system, 0);
attrs = Fcons (Fcons (Qargs, decoded_cmd), attrs);
record_unwind_protect (close_file_unwind, fd);
nread = emacs_read (fd, &pinfo, sizeof pinfo);
}
if (fd >= 0)
emacs_close (fd);
if (nread == sizeof pinfo)
{
attrs = Fcons (Fcons (Qppid, make_fixnum_or_float (pinfo.pr_ppid)), attrs);
attrs = Fcons (Fcons (Qpgrp, make_fixnum_or_float (pinfo.pr_pgid)), attrs);
attrs = Fcons (Fcons (Qsess, make_fixnum_or_float (pinfo.pr_sid)), attrs);
{
char state_str[2];
state_str[0] = pinfo.pr_lwp.pr_sname;
state_str[1] = '\0';
attrs = Fcons (Fcons (Qstate, build_string (state_str)), attrs);
}
/* FIXME: missing Qttyname. psinfo.pr_ttydev is a dev_t,
need to get a string from it. */
/* FIXME: missing: Qtpgid */
/* FIXME: missing:
Qminflt
Qmajflt
Qcminflt
Qcmajflt
Qutime
Qcutime
Qstime
Qcstime
Are they available? */
attrs = Fcons (Fcons (Qtime, make_lisp_time (pinfo.pr_time)), attrs);
attrs = Fcons (Fcons (Qctime, make_lisp_time (pinfo.pr_ctime)), attrs);
attrs = Fcons (Fcons (Qpri, make_number (pinfo.pr_lwp.pr_pri)), attrs);
attrs = Fcons (Fcons (Qnice, make_number (pinfo.pr_lwp.pr_nice)), attrs);
attrs = Fcons (Fcons (Qthcount, make_fixnum_or_float (pinfo.pr_nlwp)),
attrs);
attrs = Fcons (Fcons (Qstart, make_lisp_time (pinfo.pr_start)), attrs);
attrs = Fcons (Fcons (Qvsize, make_fixnum_or_float (pinfo.pr_size)),
attrs);
attrs = Fcons (Fcons (Qrss, make_fixnum_or_float (pinfo.pr_rssize)),
attrs);
/* pr_pctcpu and pr_pctmem are unsigned integers in the
range 0 .. 2**15, representing 0.0 .. 1.0. */
attrs = Fcons (Fcons (Qpcpu,
make_float (100.0 / 0x8000 * pinfo.pr_pctcpu)),
attrs);
attrs = Fcons (Fcons (Qpmem,
make_float (100.0 / 0x8000 * pinfo.pr_pctmem)),
attrs);
decoded_cmd = (code_convert_string_norecord
(make_unibyte_string (pinfo.pr_fname,
strlen (pinfo.pr_fname)),
Vlocale_coding_system, 0));
attrs = Fcons (Fcons (Qcomm, decoded_cmd), attrs);
decoded_cmd = (code_convert_string_norecord
(make_unibyte_string (pinfo.pr_psargs,
strlen (pinfo.pr_psargs)),
Vlocale_coding_system, 0));
attrs = Fcons (Fcons (Qargs, decoded_cmd), attrs);
}
unbind_to (count, Qnil);
UNGCPRO;
return attrs;
}

2
src/w32fns.c
View File

@ -4916,7 +4916,7 @@ w32_monitor_enum (HMONITOR monitor, HDC hdc, RECT *rcMonitor, LPARAM dwData)
{
Lisp_Object *monitor_list = (Lisp_Object *) dwData;
*monitor_list = Fcons (make_save_pointer (monitor), *monitor_list);
*monitor_list = Fcons (make_save_ptr (monitor), *monitor_list);
return TRUE;
}

15
src/w32term.c
View File

@ -2912,9 +2912,15 @@ x_focus_changed (int type, int state, struct w32_display_info *dpyinfo,
&& CONSP (Vframe_list)
&& !NILP (XCDR (Vframe_list)))
{
bufp->kind = FOCUS_IN_EVENT;
XSETFRAME (bufp->frame_or_window, frame);
bufp->arg = Qt;
}
else
{
bufp->arg = Qnil;
}
bufp->kind = FOCUS_IN_EVENT;
XSETFRAME (bufp->frame_or_window, frame);
}
frame->output_data.x->focus_state |= state;
@ -2929,7 +2935,10 @@ x_focus_changed (int type, int state, struct w32_display_info *dpyinfo,
{
dpyinfo->w32_focus_event_frame = 0;
x_new_focus_frame (dpyinfo, 0);
}
bufp->kind = FOCUS_OUT_EVENT;
XSETFRAME (bufp->frame_or_window, frame);
}
/* TODO: IME focus? */
}

20
src/xfaces.c
View File

@ -6283,6 +6283,7 @@ where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */)
CHECK_STRING (filename);
abspath = Fexpand_file_name (filename, Qnil);
block_input ();
fp = emacs_fopen (SSDATA (abspath), "rt");
if (fp)
{
@ -6290,29 +6291,24 @@ where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */)
int red, green, blue;
int num;
block_input ();
while (fgets (buf, sizeof (buf), fp) != NULL) {
if (sscanf (buf, "%u %u %u %n", &red, &green, &blue, &num) == 3)
{
char *name = buf + num;
num = strlen (name) - 1;
if (num >= 0 && name[num] == '\n')
name[num] = 0;
cmap = Fcons (Fcons (build_string (name),
#ifdef HAVE_NTGUI
make_number (RGB (red, green, blue))),
int color = RGB (red, green, blue);
#else
make_number ((red << 16) | (green << 8) | blue)),
int color = (red << 16) | (green << 8) | blue;
#endif
char *name = buf + num;
ptrdiff_t len = strlen (name);
len -= 0 < len && name[len - 1] == '\n';
cmap = Fcons (Fcons (make_string (name, len), make_number (color)),
cmap);
}
}
fclose (fp);
unblock_input ();
}
unblock_input ();
return cmap;
}
#endif

3
src/xmenu.c
View File

@ -2465,8 +2465,7 @@ xmenu_show (FRAME_PTR f, int x, int y, bool for_click, bool keymaps,
XMenuActivateSetWaitFunction (x_menu_wait_for_event, FRAME_X_DISPLAY (f));
#endif
record_unwind_protect (pop_down_menu,
make_save_value (SAVE_TYPE_PTR_PTR, f, menu));
record_unwind_protect (pop_down_menu, make_save_ptr_ptr (f, menu));
/* Help display under X won't work because XMenuActivate contains
a loop that doesn't give Emacs a chance to process it. */